ggplot2 ile aşağıdaki taban grafiğin oluşturulması

Question

ggplot2 ile aşağıdaki taban grafiğini oluşturmak istiyorum. Bu grafiği üretmek için R kodu aşağıda belirtilmiştir.

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

Ben 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 

ile bu grafiği yapmak için aşağıdaki kodu kullandım ve benim teşebbüs grafiği Bu konuda dışbükey kabuğunu haritaya güçlük Şimdi

olduğunu grafik ve okların boyutunu küçültme.

Herhangi bir yardım çok takdir edilecektir. Şimdiden teşekkürler. güzel girişim için

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