Cross Validation

Aparicio Johan

Loading libraries

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

Genotypic information

data(DT_cpdata)

geno <- GT_cpdata
geno[1:5,1:3]
#      scaffold_50439_2381 scaffold_39344_153 uneak_3436043
# P003                   0                  0             0
# P004                   0                  0             0
# P005                   0                 -1             0
# P006                  -1                 -1            -1
# P007                   0                  0             0

Vector with genotype names

samp <- rownames(GT_cpdata)
samp[1:5]
# [1] "P003" "P004" "P005" "P006" "P007"

Phenotypic information

phen <- DT_cpdata
head(phen,3)
#        id Row Col Year      color  Yield FruitAver Firmness Rowf Colf
# P003 P003   3   1 2014 0.10075269 154.67     41.93  588.917    3    1
# P004 P004   4   1 2014 0.13891940 186.77     58.79  640.031    4    1
# P005 P005   5   1 2014 0.08681502  80.21     48.16  671.523    5    1

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)])
# Warning: traits with zero variance were removed from phen: Year
# []==============================================================[]
# []==================== Genomic Prediction  =====================[]
# []============= ASReml - BGLR - sommer package  ================[]
# []======= Last update: 2020-03-18  Johan Aparicio ==============[]
# []==============================================================[]
# color  == 362
# FruitAver  == 362
# 
# prior trait   randomPop   r.sqr   corr    finishedAt
# sommer    color   Pop_1   0.611   0.8777  2020-04-02 21:38:36
# sommer    FruitAver   Pop_1   0.1719  0.6235  2020-04-02 21:38:37
# 
# []============================ End =============================[]

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