R: kalibrierte Achsen zum PCA-Biplot hinzufügen in ggplot2

Question

Ich arbeite an einem Ordinationspaket mit ggplot2. Im Moment baue ich Biblots auf traditionelle Weise, wobei Ladungen mit Pfeilen dargestellt werden. Ich wäre auch daran interessiert, kalibrierte Achsen zu verwenden und die Ladeachsen als Linien durch den Ursprung darzustellen, wobei Ladeetiketten außerhalb des Diagrammbereichs gezeigt werden. In Basis R wird diese

library(OpenRepGrid) 
biplot2d(boeker) 

in

implementiert, aber ich bin auf der Suche nach einer ggplot2 Lösung. Würde jemand irgendwelche Gedanken haben, wie man so etwas in ggplot2 erreichen kann? Das Hinzufügen der Variablennamen außerhalb der Plot-Region könnte getan werden like here Ich nehme an, aber wie könnten die Liniensegmente außerhalb der Plot-Region geplottet werden?

Zeit, was ich habe, ist

install.packages("devtools") 
library(devtools) 
install_github("fawda123/ggord") 
library(ggord) 
data(iris) 
ord <- prcomp(iris[,1:4],scale=TRUE) 
ggord(ord, iris$Species) 

Die Ladungen sind in ord$rotation

    PC1   PC2  PC3  PC4 
Sepal.Length 0.5210659 -0.37741762 0.7195664 0.2612863 
Sepal.Width -0.2693474 -0.92329566 -0.2443818 -0.1235096 
Petal.Length 0.5804131 -0.02449161 -0.1421264 -0.8014492 
Petal.Width 0.5648565 -0.06694199 -0.6342727 0.5235971 

Wie kann ich die Linien durch den Ursprung, die außerhalb Zecken und die Etiketten außen hinzufügen die Achsenregion (möglicherweise einschließlich des kühlen Zitterns, das oben für überlappende Etiketten angewendet wird)?

NB Ich will nicht Clipping auszuschalten, da einige meiner Handlungselemente manchmal außerhalb des Begrenzungsrahmens gehen könnte

EDIT: Someone else apparently asked a similar question before, obwohl die Frage noch unbeantwortet ist. Es weist darauf hin, dass, um so etwas in der Basis R zu tun (wenn auch auf eine hässliche Art), kann man z.B.

plot(-1:1, -1:1, asp = 1, type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "") 
abline(a = 0, b = -0.75) 
abline(a = 0, b = 0.25) 
abline(a = 0, b = 2) 
mtext("V1", side = 4, at = -0.75*par("usr")[2]) 
mtext("V2", side = 2, at = 0.25*par("usr")[1]) 
mtext("V3", side = 3, at = par("usr")[4]/2) 

Minimal bearbeitbar Beispiel in ggplot2 würde

library(ggplot2) 
df <- data.frame(x = -1:1, y = -1:1) 
dfLabs <- data.frame(x = c(1, -1, 1/2), y = c(-0.75, -0.25, 1), labels = paste0("V", 1:3)) 
p <- ggplot(data = df, aes(x = x, y = y)) + geom_blank() + 
    geom_abline(intercept = rep(0, 3), slope = c(-0.75, 0.25, 2)) + 
    theme_bw() + coord_cartesian(xlim = c(-1, 1), ylim = c(-1, 1)) + 
    theme(axis.title = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(), 
     panel.grid = element_blank()) 
p + geom_text(data = dfLabs, mapping = aes(label = labels)) 

sein, aber wie Sie kein Glück mit den Etiketten sehen, und ich bin auf der Suche nach einer Lösung, Es ist nicht erforderlich, dass die Übersteuerung deaktiviert wird.

EDIT2: Bit einer verwandten Frage ist, wie ich benutzerdefinierte Brüche/Teilstriche und Beschriftungen, sagen wir in rot, am oberen Rand der X-Achse und rechts von der Y-Achse hinzufügen könnte, um das Koordinatensystem des Faktors anzuzeigen Ladungen? (Wenn ich es relativ zu den Faktor-Scores skalieren würde, um die Pfeile klarer zu machen, typischerweise kombiniert mit einem Einheitskreis)

Answer 1

Vielleicht könnten Sie als Alternative das Standard-Panel und die Achsen komplett entfernen und ein kleineres Rechteck zeichnen stattdessen in der Plot-Region. Die Zeilen zu schneiden, um nicht mit den Textbezeichnungen zu kollidieren, ist ein bisschen schwierig, aber das könnte funktionieren.

df <- data.frame(x = -1:1, y = -1:1) 
dfLabs <- data.frame(x = c(1, -1, 1/2), y = c(-0.75, -0.25, 1), 
        labels = paste0("V", 1:3)) 
p <- ggplot(data = df, aes(x = x, y = y)) + 
    geom_blank() + 
    geom_blank(data=dfLabs, aes(x = x, y = y)) + 
    geom_text(data = dfLabs, mapping = aes(label = labels)) + 
    geom_abline(intercept = rep(0, 3), slope = c(-0.75, 0.25, 2)) + 
    theme_grey() + 
    theme(axis.title = element_blank(), 
     axis.text = element_blank(), 
     axis.ticks = element_blank(), 
     panel.grid = element_blank()) + 
    theme() 

library(grid) 
element_grob.element_custom <- function(element, ...) { 
    rectGrob(0.5,0.5, 0.8, 0.8, gp=gpar(fill="grey95")) 
} 

panel_custom <- function(...){ # dummy wrapper 
    structure(
    list(...), 
    class = c("element_custom","element_blank", "element") 
) 

} 

p <- p + theme(panel.background=panel_custom()) 


clip_layer <- function(g, layer="segment", width=1, height=1){ 
    id <- grep(layer, names(g$grobs[[4]][["children"]])) 
    newvp <- viewport(width=unit(width, "npc"), 
        height=unit(height, "npc"), clip=TRUE) 
    g$grobs[[4]][["children"]][[id]][["vp"]] <- newvp 

    g 
} 

g <- ggplotGrob(p) 
g <- clip_layer(g, "segment", 0.85, 0.85) 
grid.newpage() 
grid.draw(g) 

Answer 2

Was dazu:

den folgenden Code verwenden. Wenn Sie die Etiketten auch auf die Oberseite und auf der rechten Seite wollen einen Blick auf: http://rpubs.com/kohske/dual_axis_in_ggplot2

require(ggplot2) 

data(iris) 
ord <- prcomp(iris[,1:4],scale=TRUE) 

slope <- ord$rotation[,2]/ord$rotation[,1] 

p <- ggplot() + 
    geom_point(data = as.data.frame(ord$x), aes(x = PC1, y = PC2)) + 
    geom_abline(data = as.data.frame(slope), aes(slope=slope)) 

info <- ggplot_build(p) 

x <- info$panel$ranges[[1]]$x.range[1] 
y <- info$panel$ranges[[1]]$y.range[1] 

p + 
    scale_x_continuous(breaks=y/slope, labels=names(slope)) + 
    scale_y_continuous(breaks=x*slope, labels=names(slope)) + 
    theme(axis.text.x = element_text(angle=90, vjust=0.5), 
     panel.grid.major = element_blank(), 
     panel.grid.minor = element_blank(), 
     axis.title.x=element_blank(), 
     axis.title.y=element_blank())