R language ggplot2 adds horizontal and vertical error bars to the PCA scatter plot result

created at 11-15-2021 views: 11

Load the required packages

library(ggplot2)
library(ggforce)
library(tidyverse)

Read data

df<-read.csv("Seed_Data.csv")
df$target<-paste0("cultivar",df$target)

Principal component analysis

df.pca<-prcomp(df[,1:7],scale. = T)

Extract mapping data for principal component analysis

df.pca$x %>% as.data.frame() %>% 
  mutate(group=df$target) -> pca.result

Calculate the average and standard deviation of PCA results

pca.result %>% 
  group_by(group) %>% 
  summarise(pc1m=mean(PC1),
            pc1sd=sd(PC1),
            pc2m=mean(PC2),
            pc2sd=mean(PC2)) -> pca.result.a

Preliminary sketch

ggplot()+
  geom_errorbar(data=pca.result.a,
                aes(x=pc1m,
                    ymin=pc2m-1.96*pc2sd,
                    ymax=pc2m+1.96*pc2sd,
                    color=group),
                width=0.2)+
  geom_errorbarh(data = pca.result.a,
                 aes(y=pc2m,
                     xmin=pc1m-1.96*pc1sd,
                     xmax=pc1m+1.96*pc1sd,
                     color=group))+
  stat_ellipse(data=pca.result,
               geom="polygon",
               aes(x=PC1,
                   y=PC2,
                   color=group,
                   fill=group),
               alpha=0.2) -> p
p

PCA

Extract mapping data from the graph

ggplot_build(p)$data[[1]] %>% 
  select(colour,x,ymin,ymax) %>% 
  pivot_longer(cols = c(ymin,ymax)) %>% 
  rename("group"="colour",
         "x" ="x",
         "y"="value") %>% 
  select(x,y,group) -> tmp.1

ggplot_build(p)$data[[2]] %>% 
  select(colour,y,xmin,xmax) %>% 
  pivot_longer(cols = c(xmin,xmax))%>% 
  rename("group"="colour",
         "y" ="y",
         "x"="value") %>% 
  select(x,y,group) -> tmp.2

tmp<-rbind(tmp.1,tmp.2)

Final plot

ggplot()+
  geom_mark_ellipse(data=tmp,
                    aes(x=x,y=y,
                        fill=group),
                    expand = unit(0,"mm"),
                    color="white")+
  geom_errorbar(data=pca.result.a,
                aes(x=pc1m,
                    ymin=pc2m-1.96*pc2sd,
                    ymax=pc2m+1.96*pc2sd),
                width=0.2)+
  geom_errorbarh(data = pca.result.a,
                 aes(y=pc2m,
                     xmin=pc1m-1.96*pc1sd,
                     xmax=pc1m+1.96*pc1sd))+
  theme_bw()+
  labs(x="PC1 (42.8%)",y="PC2(37.9%)")+
  geom_point(data=pca.result.a,
             aes(x=pc1m,y=pc2m),
             size=3)

pca final result

created at:11-15-2021
edited at: 11-15-2021: