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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With