使用 ggplot2 重现以下基本图

Posted 2023-02-19

【中文标题】使用 ggplot2 重现以下基本图

【英文标题】：Reproducing the following base graph with ggplot2

【发布时间】：2011-10-01 00:18:40

【问题描述】：

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

以下是生成此图的R代码。

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

我用下面的代码用 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

我尝试的图表是

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

任何帮助将不胜感激。提前致谢。

【参考方案1】：

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)

【讨论】：

感谢您的精彩尝试。如果您还可以在凸包的侧面添加垂线，我将不胜感激。谢谢

如果您能帮我用这段代码编写一个函数，我将不胜感激。我试过了，但我遇到了一些问题stats.stackexchange.com/questions/14603/…***.com/questions/7140859/…。非常感谢。