How to add density plot per component in PCA plot in R?-CodePudding

I would like to know how add density to PCA plot .

This is my basic example which i would like to begin

x <- iris[1:4]
pc <- prcomp(x)
df <- cbind(pc$x[,1:2], iris[,5]) %>% as.data.frame()
df$PC1 <- as.numeric(df$PC1) / (pc$sdev[1] * sqrt(nrow(iris)))
df$PC2 <- as.numeric(df$PC2) / (pc$sdev[2] * sqrt(nrow(iris)))
df$V3 <- as.factor(df$V3)

#ggplot method
p1 <- ggplot(df, aes(PC1, PC2, colour = V3))  
  geom_point(size = 3, aes(shape = V3))  
  stat_ellipse(geom = "polygon", aes(fill = after_scale(alpha(colour, 0))),
               data = df[df$V3 == "1" | df$V3 == "2",], size = 1) 
p1

Now

I would like to add similar to my plot too how to do that? Any suggestion or help would be really appreciated.

CodePudding user response：

You could use the package cowplot by using insert_*axis_grob to insert two geom_density plots at the top x-axis and right y-axis. For the top x-axis density curve you can use the values of PC1 and for the right y-axis density curve you can use the values of PC2 and both color and fill them with V3. Make sure to specify the right axis for both graphs. Here is a reproducible example:

library(cowplot)
library(dplyr)
library(ggplot2)
x <- iris[1:4]
pc <- prcomp(x)
df <- cbind(pc$x[,1:2], iris[,5]) %>% as.data.frame()
df$PC1 <- as.numeric(df$PC1) / (pc$sdev[1] * sqrt(nrow(iris)))
df$PC2 <- as.numeric(df$PC2) / (pc$sdev[2] * sqrt(nrow(iris)))
df$V3 <- as.factor(df$V3)

# plot
p1 <- ggplot(df, aes(PC1, PC2, colour = V3))  
  geom_point(size = 3, aes(shape = V3))  
  stat_ellipse(geom = "polygon", aes(fill = after_scale(alpha(colour, 0))),
               data = df[df$V3 == "1" | df$V3 == "2",], size = 1)

# Add density curves to y and x axis
xdens <- 
  axis_canvas(p1, axis = "x")   
  geom_density(data = df, aes(x = PC1, fill = V3, colour = V3), alpha = 0.3)
ydens <-
  axis_canvas(p1, axis = "y", coord_flip = TRUE)   
  geom_density(data = df, aes(x = PC2, fill = V3, colour = V3), alpha = 0.3)  
  coord_flip()
p1 %>%
  insert_xaxis_grob(xdens, grid::unit(1, "in"), position = "top") %>%
  insert_yaxis_grob(ydens, grid::unit(1, "in"), position = "right") %>%
  ggdraw()

^{Created on 2022-08-31 with reprex v2.0.2}