R: thêm trục đã hiệu chỉnh vào PCA biplot trong ggplot2

Question

Tôi đang làm việc trên một gói phối hợp sử dụng ggplot2. Ngay bây giờ tôi đang xây dựng biplots theo cách truyền thống, với tải trọng được đại diện với mũi tên. Tôi cũng sẽ được quan tâm mặc dù sử dụng các trục được hiệu chuẩn và đại diện cho các trục tải như các đường thẳng qua gốc, và với các nhãn tải được hiển thị bên ngoài khu vực ô. Trong cơ sở R này được thực hiện trong

library(OpenRepGrid) 
biplot2d(boeker) 

nhưng tôi đang tìm kiếm một giải pháp ggplot2. Có ai có bất kỳ suy nghĩ làm thế nào để đạt được một cái gì đó như thế này trong ggplot2? Việc thêm các tên biến ngoài vùng biểu đồ có thể được thực hiện like here Tôi cho rằng, nhưng làm thế nào các đoạn đường bên ngoài vùng biểu đồ được vẽ?

Hiện nay những gì tôi có là

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

Các tải trọng là trong 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 

Làm thế nào tôi có thể thêm những dòng qua gốc, các ve bên ngoài và các nhãn bên ngoài vùng trục (có thể bao gồm cả sự rung lên mát mẻ được áp dụng ở trên cho các nhãn chồng lên nhau)?

NB Tôi không muốn tắt clipping, vì một số yếu tố cốt truyện của tôi đôi khi có thể đi ra ngoài các ranh giới hộp

EDIT: Someone else apparently asked a similar question before, mặc dù câu hỏi là vẫn không có câu trả lời. Nó chỉ ra rằng để làm một cái gì đó như thế này trong cơ sở R (mặc dù trong một cách xấu xí) người ta có thể làm ví dụ

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 dụ hoàn toàn khả thi trong ggplot2 sẽ

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

nhưng như bạn có thể thấy không có may mắn với các nhãn, và tôi đang tìm kiếm một giải pháp mà không yêu cầu một để tắt cắt.

EDIT2: bit của câu hỏi có liên quan là cách tôi có thể thêm dấu ngắt tùy chỉnh/dấu tick và nhãn, nói màu đỏ, ở trên cùng của trục X và bên phải của trục Y, để hiển thị hệ tọa độ của hệ số tải? (trong trường hợp tôi sẽ mở rộng tỷ lệ tương ứng với điểm số yếu tố để làm cho các mũi tên rõ ràng hơn, thường được kết hợp với một vòng tròn đơn vị)

Answer 1

Có thể thay thế, bạn có thể loại bỏ toàn bộ hộp và trục màn hình và vẽ một hình chữ nhật nhỏ hơn trong khu vực cốt truyện thay thế. Cắt bớt các dòng không đụng độ với các nhãn văn bản là một chút khó khăn, nhưng điều này có thể làm việc.

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

gì về điều này:

sử dụng đoạn mã sau. Nếu bạn muốn các nhãn cũng trên đỉnh và bên phải có một cái nhìn tại địa chỉ: 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())