R: dodaj skalibrowane osie do biplot PCA w ggplot2

Question

Pracuję nad pakietem koordynacji przy użyciu ggplot2. W tej chwili konstruuję biploty w tradycyjny sposób, a ładunki są reprezentowane strzałkami. Chciałbym jednak również zainteresować się skalibrowanymi osiami i reprezentować osie ładowania jako linie przez punkt początkowy, a etykiety ładujące są wyświetlane poza obszarem wykresu. W podstawowej R ten jest realizowany w

library(OpenRepGrid) 
biplot2d(boeker) 

ale szukam rozwiązania ggplot2. Czy ktokolwiek miałby myśli, jak osiągnąć coś takiego w ggplot2? Dodawanie nazw zmiennych poza obszarem działki mogłoby być wykonane like here Przypuszczam, ale w jaki sposób można wykreślić segmenty linii poza obszarem działki?

Obecnie co mam jest

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

Obciążenia są w 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 

Jak mogę dodać linie przez początek układu współrzędnych, na zewnątrz kleszcze i etykiet na zewnątrz region osi (prawdopodobnie zawierający fajne fluktuacje, które są stosowane powyżej dla zachodzących na siebie etykiet)?

NB Nie chcę, aby wyłączyć obcinanie, ponieważ niektóre z moich elementów fabuły mogłaby czasami wyjść na zewnątrz obwiedni

EDIT: Someone else apparently asked a similar question before, chociaż kwestia jest nadal bez odpowiedzi. Podkreśla, że ​​aby zrobić coś takiego w bazie R (choć w brzydki sposób) można zrobić np.

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 wykonalne przykład w ggplot2 byłoby

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)) 

ale jak widać nie ma szczęścia z etykietami i szukam rozwiązania, które nie wymaga wyłączania obcinania.

EDIT2: trochę pokrewnego pytania, w jaki sposób mogę dodać niestandardowe znaki podziałów/znaczników i etykiet, powiedzmy na czerwono, na górze osi X i na prawo od osi Y, aby wyświetlić układ współrzędnych współczynnika ładunki? (w przypadku, gdy skalowałbym ją względem wyników czynników, aby strzałki były wyraźniejsze, zazwyczaj w połączeniu z kołem jednostki).

Answer 1

Całkiem możliwe, że można całkowicie usunąć domyślne okno i osie paneli i narysować mniejszy prostokąt w regionie działki zamiast tego. Przycinanie linii, aby nie kolidować z etykietami tekstowymi, jest nieco trudne, ale to może zadziałać.

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

Co o tym:

użyć następującego kodu. Jeśli chcesz etykiety także na górze i po prawej rzucić okiem na: 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())