Play the next base graph with ggplot2

Question

I would like to reproduce the following basic graph with ggplot2.

Below is the R code to create 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 schedule done

Now it’s hard for me to match the convex hull on this graph and reduce the size of the arrows.

Any help would be greatly appreciated. Thanks in advance.

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)