使用ggplot2重现以下基本图形 [英] Reproducing the following base graph with ggplot2

问题描述

我想用ggplot2重现以下基本图。

关注

  set.seed（12345）
是生成此图的 R 代码。数据<  - 矩阵（数据=标准（n = 30，平均= 0，sd = 1），nrow = 6，ncol = 5）
 dimnames（Data）< 1：nrow（Data），sep =），paste（E，1：ncol（Data），sep =））
 SVD <-svd（Data）
 D < ;  -  diag（SVD $ d [1：min（dim（Data））]）
 G <-SVD $ u％*％sqrt（D）
 E <-SVD $ v％* ％数据（D）
 
 dimnames（G）<  -  list（rownames（Data））
 dimnames（E）<  -  list（colnames（Data））
 $ （1：长度（SVD.Values））
 PC.SS< -SVD.Values< ^ 2 $ b（sVD.Values）<  -  SVD $ d 
 PC.No< $ b PC.Percent.SS<  -  PC.SS / sum（PC.SS）* 100 
 
 
 library（grDevices）
 con.hull.pos<  - chull（G）
 con.hull<  -  rbind（G [con.hull.pos，]，G [con.hull.pos [1]，]）
 
 getPerpPoints< - 函数（mat）{
x<  -  mat [，1] 
y<  -  mat [，2] 
 out <  - 矩阵（0，nrow = 2，ncol = 2）
 if（diff（x）== 0）{
 xnew < -  x [1] 
} $ b $ （x（y）/ diff（x））* x [1] -y [1] 
 xnew <-xnew /（diff（y）/ diff （x）/ diff（x）/ diff（y））
} 
 y new < -   - （diff（x）/ diff（y））* xnew 
 out [2，]< ;  -  c（xnew，ynew）
 return（out = out）
} 
 
r < -  0.08 
 plot（x = G [，1]，y （c [E [，1]，G [，1]））+范围（c（E [，1]，G [，1]））= G [，2]，type =p * r，
 ylim = range（c（E [，2]，G [，2]））+ range（c（E [，2]，G [，2]））* r，
 blab =粘贴（粘贴（PC1（，round（PC.Percent.SS [1]，1），sep =），％），sep =），
 ylab =粘贴（粘贴（PC2（，round（PC.Percent.SS [2]，1），sep =），％），sep =），
 xaxs =r，yaxs =r，
 pch = 19，cex = 1，panel.first = grid（col =gray，lty =dotted），
 main =）
 text （x = G [，1]，y = G [，2]，labels = row.names（G），pos = 1，col =blue）
 points（x = E [，1]， y = E [，2]，type =n，col =blue，lwd = 5 ）
 text（x = E [，1]，y = E [，2]，labels = row.names（E），pos = 1，col =red）#c（-0.2,0.4） 
 abline（h = 0，v = 0，lty = 2.5，col =green，lwd = 2）
s <-seq（length（E [，1]））
箭头（x0 = 0，y0 = 0，x1 = E [，1] [s]，y1 = E [，2] [s]，col =brown，lwd = 1.8，length = 0.1，code = 2） 
 lines（con.hull）
 for（i in 1：（nrow（con.hull）-1））{
 lines（getPerpPoints（con.hull [i：（i + 1 ），]），lty =solid）
} 
  

我使用下面的代码使用ggplot2制作这个图表

  library（ggplot2）
 G < -  as.data.frame（G） 
 colnames（G）< -  c（paste（PC，1：min（dim（Data）），sep =））
 G $ ID < - G
 G $ Name < -  rownames（G）
 E < -  as.data.frame（E）
 colnames（E）< -  c（paste（PC，1：min （dim（Data）），sep =））
 E $ ID<  - E
 E $ Name<  -  rownames（E）
 
 GE< ; rbind（G [，c（PC1，PC2，ID，Name）]，E [，c（PC1，PC2，ID，Name 
 
p <-qplot（x = PC1，y = PC2， data = GE，color = ID，label = Name，geom =text，size = 1，
 xlab =粘贴（粘贴（PC1（，round（PC.Percent.SS [1]，1） ，（sep =），％），sep =），
 ylab =粘贴（粘贴（PC2（，round（PC.Percent.SS [2]，1），sep = ），％），sep =），
 main =）+ opts（legend.position =none）
p < -  p + geom_hline（aes（0）， size = 0.2）+ geom_vline（aes（0），size = 0.2）
p <-p + geom_segment（data = E，aes（x = 0，y = 0，xend = PC1，yend = PC2 ），arrow =箭头（长度=单位（0.1，cm）），alpha = 1，color =red）
p 
  

以及我尝试的图表是

现在我很难在该图上绘制凸包，并减少箭头的大小。

任何帮助将不胜感激。

解决方案

  library（ggplot2）
p< -  ggplot（data = as.data.frame（G），aes（V1，V2））+ 
 geom_vline（xintercept = 0，color =green，linetype = 2，size = 1）+ 
 geom_hline（yintercept = 0，color =green，linetype = 2，size = 1）+ 
 geom_point（）+ 
 geom_text（aes（label = row.names（G）），vjust = 1.25，color =blue）+ 
 geom_path（data = as.data.frame（con.hull），aes（V1，V2））+ 
 geom_segment（data = as.data.frame E），
 aes（xend = V1，yend = V2），x = 0，y = 0，
 color =brown，arrow =箭头（长度=单位（0.5，cm）） ））+ 
 geom_text（data = as.data.frame（E），aes（label = row.names（E）），
 vjust = 1.35，color =red）+ $ b $ （x = sprintf（PC1（％.1f %%），PC.Percent.SS [1]），
y = sprintf（PC2（％.1f %%），PC。 Percent.SS [2]）））+ 
 xli m（范围（c（E [，1]，G [，1]））*（1 + r））+ 
 ylim *（1 + r））
 
 tmp <-t（sapply（1：（nrow（con.hull）-1）），
 function（i）getPerpPoints（con.hull [ i：（i + 1），]）[2，]））
p <-p + geom_segment（data = as.data.frame（tmp），
 aes（xend = V1，yend = V2），x = 0，y = 0）
 
 print（p）
  

I'd like to reproduce the following base graph with ggplot2.

Following is the R code to produce this graph.

set.seed(12345)
Data <- matrix(data = rnorm(n = 30, mean = 0, sd = 1), nrow = 6, ncol = 5)
dimnames(Data) <- list(paste("G", 1:nrow(Data), sep = ""), paste("E", 1:ncol(Data), sep     = ""))
SVD <- svd(Data)
D <- diag(SVD$d[1:min(dim(Data))])
G <- SVD$u%*%sqrt(D)
E <- SVD$v%*%sqrt(D)

dimnames(G) <- list(rownames(Data))
dimnames(E) <- list(colnames(Data))

SVD.Values <- SVD$d
PC.No <- c(1:length(SVD.Values))
PC.SS <- SVD.Values^2
PC.Percent.SS <- PC.SS/sum(PC.SS)*100


library(grDevices)
con.hull.pos <- chull(G)
con.hull <- rbind(G[con.hull.pos, ], G[con.hull.pos[1], ])

getPerpPoints <- function(mat) {
x <- mat[,1]
y <- mat[,2]
out <- matrix(0, nrow = 2, ncol = 2)
if(diff(x) == 0) {
xnew <- x[1]
  }
  else {
xnew <- (diff(y) / diff(x)) * x[1] - y[1]
xnew <- xnew / (diff(y) / diff(x) + diff(x) / diff(y))
  }
  ynew <- -(diff(x) / diff(y)) * xnew
  out[2,] <- c(xnew, ynew)
  return(out = out)
}

r <- 0.08
plot(x = G[ ,1], y = G[ ,2], type = "p", xlim = range(c(E[,1], G[,1])) + range(c(E[,1],     G[,1])) * r,
    ylim = range(c(E[,2], G[,2])) + range(c(E[,2], G[,2])) * r,
    xlab = paste(paste("PC1 (", round(PC.Percent.SS[1], 1), sep = ""), "%)", sep = ""),
    ylab = paste(paste("PC2 (", round(PC.Percent.SS[2], 1), sep = ""), "%)", sep = ""),
    xaxs = "r", yaxs = "r",
    pch = 19, cex = 1, panel.first = grid(col="gray", lty="dotted"),
    main = "")
text(x = G[,1], y = G[,2], labels = row.names(G), pos = 1, col = "blue")
points(x = E[,1], y = E[,2], type = "n", col = "blue", lwd = 5)
text(x = E[,1], y = E[,2], labels = row.names(E), pos = 1, col = "red") #c(-0.2, 0.4)
abline(h = 0, v = 0, lty = 2.5, col = "green", lwd = 2)
s <- seq(length(E[, 1]))
arrows(x0 = 0, y0 = 0, x1 = E[, 1][s], y1 = E[, 2][s], col = "brown", lwd = 1.8, length     = 0.1, code = 2)
lines(con.hull)
for(i in 1:(nrow(con.hull)-1)) {
  lines(getPerpPoints(con.hull[i:(i+1),]), lty =  "solid")
}

I used the following code to make this graph with ggplot2

library(ggplot2)
G <- as.data.frame(G)
colnames(G) <- c(paste("PC", 1:min(dim(Data)), sep = ""))
G$ID <- "G"
G$Name <- rownames(G)
E <- as.data.frame(E)
colnames(E) <- c(paste("PC", 1:min(dim(Data)), sep = ""))
E$ID <- "E"
E$Name <- rownames(E)

GE <- rbind(G[, c("PC1", "PC2", "ID", "Name")], E[, c("PC1", "PC2", "ID", "Name")])

p <- qplot(x = PC1, y = PC2, data = GE, colour = ID, label = Name, geom = "text", size     = 1,
           xlab = paste(paste("PC1 (", round(PC.Percent.SS[1], 1), sep = ""), "%)", sep     = ""),
           ylab = paste(paste("PC2 (", round(PC.Percent.SS[2], 1), sep = ""), "%)", sep     = ""),
           main = "") + opts(legend.position = "none")
p <- p + geom_hline(aes(0), size=.2) + geom_vline(aes(0), size=.2)
p <- p + geom_segment(data = E, aes(x = 0, y = 0, xend = PC1, yend = PC2), arrow =     arrow(length = unit(0.1, "cm")), alpha = 1, color = "red")
p

and my attempted graph is

Now I have difficulty to map the convex hull on this graph and in reducing the size of the arrows.

Any help will be highly appreciated. Thanks in advance.

解决方案

library("ggplot2")
p <- ggplot(data=as.data.frame(G), aes(V1, V2)) +
            geom_vline(xintercept=0, colour="green", linetype=2, size=1) +
            geom_hline(yintercept=0, colour="green", linetype=2, size=1) +
            geom_point() +
            geom_text(aes(label=row.names(G)), vjust=1.25, colour="blue") +
            geom_path(data=as.data.frame(con.hull), aes(V1, V2)) +
            geom_segment(data=as.data.frame(E),
                         aes(xend=V1, yend=V2), x=0, y=0,
                         colour="brown", arrow=arrow(length=unit(0.5 ,"cm"))) +
            geom_text(data=as.data.frame(E), aes(label=row.names(E)),
                      vjust=1.35, colour="red") +
            labs(list(x=sprintf("PC1 (%.1f%%)", PC.Percent.SS[1]),
                      y=sprintf("PC2 (%.1f%%)", PC.Percent.SS[2]))) +
            xlim(range(c(E[,1], G[,1]))*(1+r)) +
            ylim(range(c(E[,2], G[,2]))*(1+r))

tmp <- t(sapply(1:(nrow(con.hull)-1),
         function(i) getPerpPoints(con.hull[i:(i+1),])[2, ]))
p <- p + geom_segment(data=as.data.frame(tmp),
                      aes(xend=V1, yend=V2), x=0, y=0)    

print(p)

这篇关于使用ggplot2重现以下基本图形的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！