R: ggplot2'de PCA biplot'a kalibre edilmiş eksenleri ekleyin

Question

ggplot2 kullanarak bir koordinasyon paketi üzerinde çalışıyorum. Şu anda, oklarla temsil edilen yükler ile geleneksel yollarda bipler yapıyorum. Aynı zamanda kalibre edilmiş eksenleri kullanmak ve yükleme eksenlerini başlangıç ​​noktasından çizgilerle temsil etmek ve arsa bölgesi dışında yükleme etiketleri ile ilgilenmek isterim. Baz Ar bu

library(OpenRepGrid) 
biplot2d(boeker) 

uygulanan ama ggplot2 çözüm arıyorum. ggplot2'da böyle bir şeye nasıl ulaşılacağını düşünen var mı? Değişken adlarını arsa bölgesi dışında eklemek, like here sanırım, ama arsa bölgesi dışındaki çizgi parçaları nasıl çizilebilir?

Şu anda ne var yüklemeleri ben, başlangıç ​​noktasından dış kene ve dış etiket satırları ekleyin nasıl olabilir 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 

içindedir

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

olduğunu eksen bölgesi (üst üste binen etiketler için yukarıda uygulanan serin bir titreme dahil)? sorusu bir cevap vermeden hala olsa, Someone else apparently asked a similar question before:

NB benim arsa öğelerinden bazılarını bazen sınırlayıcı kutunun

DÜZENLEME dışına çıkabileceğini beri kesilmesini, kapatmak istemiyoruz. Bu, R ortamında (böyle çirkin bir şekilde olsa da) böyle bir şey yapmanın, örn. ggplot2 yılında

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 çalışılabilir örnek

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

olurdu ama etiketlerle hiç şans gördüğünüz gibi, ben bir çözüm arıyorum o kırpmayı kapatmak için bir tane gerektirmez.

EDIT2: ilgili sorgunun bir kısmı, faktörün koordinat sistemini göstermek için, X ekseninin en üstünde ve Y ekseninin sağında, kırmızı renkte, özel kırılma/onay işaretleri ve etiketler ekleyebileceğim şekildedir. yüklemeleri? (Bu durumda, okları daha net yapmak için faktör puanlarına göre ölçeklendirirdim, tipik olarak bir ünite dairesiyle birleştirilir)

Answer 1

Belki de alternatif panel kutusunu ve eksenlerini kaldırabilir ve daha küçük bir dikdörtgen çizebilirsiniz. Bunun yerine arsa bölgesinde. Metin etiketleri ile çatışmamak için hatları kırpmak biraz zor, ama bu işe yarayabilir.Bu konuda

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

Ne:

aşağıdaki kodu kullanabilirsiniz. Belki `geom_path()` repliğini almak için kullandığınız 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())