In AparicioJohan/GS: Genomic Prediction

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#"
)

Loading libraries

library(tidyverse)
library(GS)
library(sommer)

Genotypic information

data(DT_cpdata)

geno <- GT_cpdata
geno[1:5,1:3]

Vector with genotype names

samp <- rownames(GT_cpdata)
samp[1:5]

Phenotypic information

phen <- DT_cpdata
head(phen,3)

Cross validation

tmp <- crossGP(geno,samp,phen,prior = "sommer", niter=20,testporc = 0.3,traits = names(phen)[c(5,7)])

Prediction Ability

ggplot(tmp$data, aes(x=trait,y=corr, fill=trait))+geom_boxplot()+theme_bw()

Variance explained

tmp2 <- crossGP(geno,samp,phen,prior = "sommer", niter=5,testporc = 0,traits = names(phen)[c(5,7)])

Final plot

tmp <- tmp$data[,c("trait","corr")]
tmp2 <- tmp2$data[,c("trait","r.sqr")]
merG <- merge(tmp,tmp2, by="trait", all=T)

p <- ggplot(merG, aes(x=trait,y=corr, fill=trait))+geom_boxplot()+theme_bw()+xlab(" ")+
  geom_segment(data=merG,aes(x = as.numeric(as.factor(trait)) - 0.48, 
                                 xend = as.numeric(as.factor(trait)) + 0.48, 
                                 yend = r.sqr , 
                                 y = r.sqr ),size=2.5, color="white")+
  geom_segment(data=merG,aes(x = as.numeric(as.factor(trait)) - 0.45, 
                                 xend = as.numeric(as.factor(trait)) + 0.45, 
                                 yend = r.sqr , 
                                 y = r.sqr , 
                                 colour = trait),size=1)+
  ylab("Prediction ability")+
  theme(axis.text.x=element_text(angle=80,vjust=0.5))
p