Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Reproducing the following base graph with ggplot2

I'd like to reproduce the following base graph with ggplot2. enter image description here

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

enter image description here

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.

like image 525
MYaseen208 Avatar asked Jul 08 '11 05:07

MYaseen208


1 Answers

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 example

like image 100
rcs Avatar answered Nov 15 '22 19:11

rcs