---
title: "Supplementary Figures"
site: workflowr::wflow_site
date: "2021-March-22"
output: 
  workflowr::wflow_html:
    code_folding: "hide"
editor_options:
  chunk_output_type: inline
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, 
                      tidy='styler', tidy.opts=list(strict=FALSE,width.cutoff=100), highlight=TRUE)
```

```{r}
library(tidyverse); library(magrittr); library(ragg); library(patchwork)
```

# Supplementary Figures (Main)

## Figure S01: Genome-wide proportion homozygous

```{r}
propHom<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS14")

propHom %>% 
  mutate(Group=ifelse(!grepl("TMS13|TMS14|TMS15", GID),"GG (C0)",NA),
         Group=ifelse(grepl("TMS13", GID),"TMS13 (C1)",Group),
         Group=ifelse(grepl("TMS14", GID),"TMS14 (C2)",Group),
         Group=ifelse(grepl("TMS15", GID),"TMS15 (C3)",Group)) %>% 
  ggplot(.,aes(x=Group,y=PropSNP_homozygous,fill=Group)) + geom_boxplot(notch=TRUE) + 
  theme_bw() + 
  scale_fill_viridis_d()
```

**Figure S01: Boxplot of the genome-wide proportion of homozygous SNPs in each of four genetic groups comprising the study pedigree.**

## Figure S02: Correlations among phenotypic BLUPs (including Selection Indices)

```{r}
library(tidyverse); library(magrittr);
# Selection weights -----------
indices<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS01")
# BLUPs -----------
blups<-readRDS(here::here("data","blups_forawcdata.rds")) %>% 
  select(Trait,blups) %>% 
  unnest(blups) %>% 
  select(Trait,germplasmName,BLUP) %>% 
  spread(Trait,BLUP) %>% 
  select(germplasmName,all_of(c("DM","logFYLD","MCMDS","TCHART")))
blups %<>% 
  select(germplasmName,all_of(indices$Trait)) %>% 
  mutate(stdSI=blups %>% 
           select(all_of(indices$Trait)) %>% 
           as.data.frame(.) %>% 
           as.matrix(.)%*%indices$stdSI,
         biofortSI=blups %>% 
           select(all_of(indices$Trait)) %>% 
           as.data.frame(.) %>% 
           as.matrix(.)%*%indices$biofortSI)
```

```{r, fig.width=10, fig.height=5}
pngfile<-"docs/supfigures/figureS2.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.8)

library(patchwork)
p1<-ggplot(blups,aes(x=stdSI,y=biofortSI)) + geom_point(size=1.25) + theme_bw()
corMat<-cor(blups[,-1],use = 'pairwise.complete.obs')
(p1 | ~corrplot::corrplot(corMat, type = 'lower', col = viridis::viridis(n = 10), diag = T,addCoef.col = "black")) + 
  plot_layout(nrow=1, widths = c(0.35,0.65)) +
  plot_annotation(tag_levels = 'A',
                  title = 'Correlations among phenotypic BLUPs (including Selection Indices)')
invisible(dev.off())
```

![](supfigures/figureS2.png)

**Figure S02: Correlations among BLUPs (including Selection Indices).** (A) StdSI vs. BiofortSI computed from i.i.d. BLUPs. (B) Heatmap of the correlation among BLUPs for each of four component traits and two derived selection indices.

## Figure S03: Realized selection intensities: measuring post-cross selection

```{r}
library(patchwork)
## Table S13: Realized within-cross selection metrics
crossmetrics<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS13")
propPast<-crossmetrics %>% 
  mutate(Cycle=ifelse(!grepl("TMS13|TMS14|TMS15",sireID) & !grepl("TMS13|TMS14|TMS15",damID),"C0",
                      ifelse(grepl("TMS13",sireID) | grepl("TMS13",damID),"C1",
                             ifelse(grepl("TMS14",sireID) | grepl("TMS14",damID),"C2",
                                    ifelse(grepl("TMS15",sireID) | grepl("TMS15",damID),"C3","mixed"))))) %>% 
  select(Cycle,starts_with("prop")) %>%   distinct %>% 
  pivot_longer(cols = contains("prop"),values_to = "PropPast",names_to = "StagePast",names_prefix = "propPast|prop") %>% 
  rename(DescendentsOfCycle=Cycle) %>% 
  mutate(StagePast=gsub("UsedAs","",StagePast),
         StagePast=factor(StagePast,levels=c("Parent","Phenotyped","CET","PYT","AYT"))) %>% 
  ggplot(.,aes(x=StagePast,y=PropPast,fill=DescendentsOfCycle)) + 
  geom_boxplot(position = 'dodge2',color='black') + 
  theme_bw() + scale_fill_viridis_d()  + labs(y="Proportion of Family Selected") +
  theme(legend.position = 'none')
realIntensity<-crossmetrics %>% 
  mutate(Cycle=ifelse(!grepl("TMS13|TMS14|TMS15",sireID) & !grepl("TMS13|TMS14|TMS15",damID),"C0",
                      ifelse(grepl("TMS13",sireID) | grepl("TMS13",damID),"C1",
                             ifelse(grepl("TMS14",sireID) | grepl("TMS14",damID),"C2",
                                    ifelse(grepl("TMS15",sireID) | grepl("TMS15",damID),"C3","mixed"))))) %>% 
  select(Cycle,sireID,damID,contains("realIntensity")) %>%   distinct %>% 
  pivot_longer(cols = contains("realIntensity"),
               names_to = "Stage", 
               values_to = "Intensity",
               names_prefix = "realIntensity") %>% 
  rename(DescendentsOfCycle=Cycle) %>% 
  distinct %>% ungroup() %>% 
  mutate(Stage=factor(Stage,levels=c("Parent","CET","PYT","AYT","UYT"))) %>% 
  ggplot(.,aes(x=Stage,y=Intensity,fill=DescendentsOfCycle)) + 
  geom_boxplot(position = 'dodge2',color='black') + 
  theme_bw() + scale_fill_viridis_d()  + labs(y="Stadardized Selection Intensity")
```

```{r}
pngfile<-"docs/supfigures/figureS3.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.8)
propPast + realIntensity +  
  plot_annotation(tag_levels = 'A',
                  title = 'Realized selection intensities as measures of post-cross selection') & 
  theme(plot.title = element_text(size = 14, face='bold'),
        plot.tag = element_text(size = 13, face='bold'),
        strip.text.x = element_text(size=11, face='bold'))
invisible(dev.off())
```

![](supfigures/figureS3.png)

**Figure S03: Realized selection intensities: measuring post-cross selection.** Boxplots showing (A) the proportion of each family selected and (B) the standardized selection intensity for each stage of the breeding pipeline, in each genetic group.

## Figure S04: Correlation matrix for predictions on the StdSI

```{r}
library(tidyverse); library(magrittr); 
predUntestedCrosses<-read.csv(here::here("manuscript","SupplementaryTable18.csv"),stringsAsFactors = F) %>% 
  filter(Model=="DirDom") %>% select(-Model)
forCorrMat<-predUntestedCrosses %>%
  mutate(Family=paste0(sireID,"x",damID),
         PredOf=paste0(Trait,"_",PredOf,"_",Component)) %>%
  select(Family,PredOf,Pred) %>%
  spread(PredOf,Pred)
```

```{r}
corMat_std<-cor(forCorrMat[,grepl("stdSI",colnames(forCorrMat))],use = 'pairwise.complete.obs')
corrplot::corrplot(corMat_std, type = 'lower', col = viridis::viridis(n = 10), diag = F,addCoef.col = "black", 
                   tl.srt = 15, tl.offset = 1,tl.col = 'darkred') 
```

**Figure S04: Correlation matrix for predictions on the StdSI.** Heatmap of the correlations between predictions of mean, standard deviation, and usefulness in terms of BV and TGV. Predictions were made for 47,083 possible pairwise crosses of 306 parents with a directional dominance model.

## Figure S05: Correlation matrix for predictions on the BiofortSI

```{r}
corMat_bio<-cor(forCorrMat[,grepl("biofortSI",colnames(forCorrMat))],use = 'pairwise.complete.obs')
corrplot::corrplot(corMat_bio, type = 'lower', col = viridis::viridis(n = 10), diag = F,addCoef.col = "black", 
                   tl.srt = 15, tl.offset = 1,tl.col = 'darkred') 
```

**Figure S05: Correlation matrix for predictions on the BiofortSI.** Heatmap of the correlations between predictions of mean, standard deviation, and usefulness in terms of BV and TGV. Predictions were made for 47,083 possible pairwise crosses of 306 parents with a directional dominance model.

# Supplementary Figures (Appendix)

## Figure S06: Contrasting GBLUPs and iidBLUPs as validation data for measuring family mean prediction accuracy

```{r}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
# Table S10: Accuracies predicting the mean
accMeans<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS10")
accMeans %<>% 
  filter(grepl("DirDom",Model))
forplot<-accMeans %>% 
  mutate(Trait=factor(Trait,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         predOf=factor(predOf,levels=c("MeanBV","MeanTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Trait))

colors<-viridis::viridis(4)[1:2]

baseplot<-forplot %>% 
  ggplot(.,aes(x=predOf,y=Accuracy, fill=ValidationData,color=ValidationData)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors)

p1<-baseplot + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS6.png"  
agg_png(pngfile, width = 17.8, height = 8.9, units = "cm", res = 300, scaling = 0.9)
p1 + theme_bw() + labs(y="Accuracy") + 
  theme(plot.tag = element_text(face='bold'),
        axis.title.x = element_blank(),
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())
invisible(dev.off())
```

![](supfigures/figureS6.png)

**Figure S06: Contrasting GBLUPs and iidBLUPs as validation data for measuring family mean prediction accuracy.** The cross mean prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Each panel contains results for one of the selection indices (stdSI and biofortSI) and for the component traits (DM, logFYLD, MCMDS, TCHART). Prediction accuracies are on the y-axis and cross mean GEBV (MeanBV) and GETGV (MeanTGV) are on the x-axis. Colors distinguish the validation data used to estimate the accuracy.

## Figure S07: Contrasting GBLUPs and iidBLUPs as validation data for measuring family \*co)variance prediction accuracy

```{r}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
accVars<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS11")
forplot<-accVars %>% 
  filter(VarMethod=="PMV",grepl("DirDom",Model)) %>% 
  mutate(Trait1=factor(Trait1,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Trait2=factor(Trait2,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Component=paste0(Trait1,"_",Trait2),
         predOf=factor(predOf,levels=c("VarBV","VarTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Component))

colors<-viridis::viridis(4)[1:2]

p1<-forplot %>% filter(Trait1==Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=ValidationData,color=ValidationData)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)

p2<-forplot %>% filter(Trait1!=Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=ValidationData,color=ValidationData)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1+Trait2) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS7.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.9)
(p1 / p2) + 
  plot_layout(guides = 'collect',nrow=2) &
  theme_bw() & 
  theme(plot.tag = element_text(face='bold'),
        axis.title.x = element_blank(),
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) & labs(y="Accuracy")
invisible(dev.off())
```

![](supfigures/figureS7.png)

**Figure S07: Contrasting GBLUPs and iidBLUPs as validation data for measuring family (co)variance prediction accuracy.** The cross variance and covariance prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Each panel in the top row contains results for either a selection index (stdSI and biofortSI) or a component trait (DM, logFYLD, MCMDS, TCHART) variance. Each panel on the bottom row contains one of the six pairwise covariances between the four component traits. Prediction accuracies are on the y-axis and cross variance/covariance for GEBV (VarBV) and GETGV (VarTGV) are on the x-axis. Colors distinguish the validation data used to estimate the accuracy.

## Figure S08: Variance-covariance Accuracy considering only families with 10+ members?

```{r, eval=T}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
obsVSpredVars<-readRDS(here::here("output","obsVSpredVars.rds")) %>% 
  filter(grepl("DirDom",Model),ValidationData=="GBLUPs",VarMethod=="PMV") %>% 
  select(-Model,-ValidationData,-VarMethod)
compareAllFamsToBigFamsAccuracy<-obsVSpredVars %>% 
  drop_na(.) %>% 
  filter(FamSize>=10) %>% 
  select(-FamSize,-Nobs) %>% 
  nest(predVSobs=c(sireID,damID,predVar,obsVar,CorrWeight)) %>% 
  mutate(FamSize10plus=map_dbl(predVSobs,~psych::cor.wt(.[,3:4],w = .$CorrWeight) %$% r[1,2])) %>% 
  select(-predVSobs) %>% 
  left_join(readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS11") %>% 
              filter(VarMethod=="PMV",ValidationData=="GBLUPs", grepl("DirDom",Model)) %>% 
              select(-Model,-ValidationData,-VarMethod) %>% 
              select(-AccuracyCor) %>% 
              rename(AllFams=AccuracyWtCor)) %>% 
  mutate(accDiff=FamSize10plus-AllFams)
forplot<-compareAllFamsToBigFamsAccuracy %>% 
  select(-accDiff) %>% 
  pivot_longer(cols=c(FamSize10plus,AllFams),names_to = "FamiliesUsed", values_to = "Accuracy") %>% 
  mutate(FamiliesUsed=factor(FamiliesUsed,levels=c("AllFams","FamSize10plus")),
         Trait1=factor(Trait1,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Trait2=factor(Trait2,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Component=paste0(Trait1,"_",Trait2),
         predOf=factor(predOf,levels=c("VarBV","VarTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Component))

colors<-viridis::viridis(4)[1:2]

p1<-forplot %>% filter(Trait1==Trait2) %>% 
  ggplot(.,aes(x=predOf,y=Accuracy, fill=FamiliesUsed,color=FamiliesUsed)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE) 

p2<-forplot %>% filter(Trait1!=Trait2) %>% 
  ggplot(.,aes(x=predOf,y=Accuracy, fill=FamiliesUsed,color=FamiliesUsed)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1+Trait2) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS8.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.9)
(p1 / p2) + 
  plot_layout(guides = 'collect',nrow=2) &
  theme_bw() & 
  theme(plot.title = element_text(face='bold'),
        axis.title.x = element_blank(), #element_text(face='bold',color = 'black'),
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) & 
  labs(y="Accuracy")
invisible(dev.off())
```

![](supfigures/figureS8.png)

**Figure S08: Variance-covariance Accuracy considering only families with 10+ members?** The cross variance and covariance prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Results are shown based on the directional dominance model. Each panel in the top row contains results for either a selection index (stdSI and biofortSI) or a component trait (DM, logFYLD, MCMDS, TCHART) variance. Each panel on the bottom row contains one of the six pairwise covariances between the four component traits. Prediction accuracies are on the y-axis and cross variance/covariance for GEBV (VarBV) and GETGV (VarTGV) are on the x-axis. Colors distinguish whether all families (AllFams) or just the ones with at least 10 members were included in the accuracy estimates.

## Figure S09: Population estimates of genetic variance parameters - PMV vs. VPM

```{r}
library(tidyverse); library(magrittr);
## Table S15: Variance estimates for genetic groups
varcomps<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS15")

pngfile<-"docs/supfigures/figureS9.png"  
agg_png(pngfile, width = 9, height = 9, units = "cm", res = 300, scaling = 0.9)

varcomps %>% 
  filter(Method=="M2",grepl("DirDomAD",Model)) %>% 
  select(-propDom,-Model,-Method) %>% 
  pivot_longer(cols = c(VarA,VarD), names_to = "VarComp", values_to = "VarEst") %>% 
  filter(!is.na(VarEst)) %>% 
  spread(VarMethod,VarEst) %>% 
  ggplot(.,aes(x=VPM,y=PMV,color=VarComp)) + geom_point() + geom_abline(slope=1) + 
  theme_bw() + 
  theme(plot.title = element_text(face='bold'),
        axis.title.x = element_blank(), #element_text(face='bold',color = 'black'),
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())
invisible(dev.off())
```

![](supfigures/figureS9.png)

**Figure S09: Population estimates of genetic variance parameters - PMV vs. VPM.** We contrasted the variance of posterior means (VPM; x-axis) to the less biased, more intensive-to-compute posterior mean variance (PMV; y-axis). Each point is a trait variance or trait-trait covariance estimate from the directional dominance model. Colors distinguish additive variance (VarA) and dominance variance(VarD).

## Figure S10: PMV vs. VPM - Compare prediction accuracy

```{r}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
accVars<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS11") %>% 
  mutate(Component=ifelse(Trait1==Trait2,"Variance","Covariance"),
         TraitType=ifelse(grepl("SI",Trait1),"SI","ComponentTrait")) %>% 
  filter(ValidationData=="GBLUPs",grepl("DirDom",Model)) %>% 
  select(-ValidationData,-Model,-AccuracyCor) 

forplot<-accVars %>% 
  mutate(VarMethod=factor(VarMethod,levels=c("VPM","PMV")),
         Trait1=factor(Trait1,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Trait2=factor(Trait2,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Component=paste0(Trait1,"_",Trait2),
         predOf=factor(predOf,levels=c("VarBV","VarTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Component))

colors<-viridis::viridis(4)[1:2]

p1<-forplot %>% filter(Trait1==Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=VarMethod,color=VarMethod)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)

p2<-forplot %>% filter(Trait1!=Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=VarMethod,color=VarMethod)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1+Trait2) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS10.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.9)
(p1 / p2) + 
  #plot_annotation(title="Compare PMV vs. VPM accuracy") +
  plot_layout(guides = 'collect',nrow=2) &
  theme_bw() & 
  theme(plot.title = element_text(face='bold'),
        axis.title.x = element_blank(), #element_text(face='bold',color = 'black'),
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) & 
  labs(y="Accuracy")
invisible(dev.off())
```

![](supfigures/figureS10.png)

**Figure S10: Variance-covariance Accuracy comparing VPM vs. PMV.** The cross variance and covariance prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Results are shown based on the directional dominance model. Each panel in the top row contains results for either a selection index (stdSI and biofortSI) or a component trait (DM, logFYLD, MCMDS, TCHART) variance. Each panel on the bottom row contains one of the six pairwise covariances between the four component traits. Prediction accuracies are on the y-axis and cross variance/covariance for GEBV (VarBV) and GETGV (VarTGV) are on the x-axis. Colors distinguish whether predictions were based on the VPM or the PMV.

## Figure S11: Directional Dominance vs. Classic Model - Family Mean Prediction Accuracy

```{r}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
# Table S10: Accuracies predicting the mean
accMeans<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS10")
accMeans %<>% 
  filter(ValidationData=="GBLUPs") %>% 
  select(-ValidationData) %>% 
  mutate(Model=ifelse(grepl("DirDom",Model),"DirDom","Classic"))


forplot<-accMeans %>% 
  mutate(Trait=factor(Trait,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         predOf=factor(predOf,levels=c("MeanBV","MeanTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Trait))

colors<-viridis::viridis(4)[1:2]

baseplot<-forplot %>% 
  ggplot(.,aes(x=predOf,y=Accuracy, fill=Model,color=Model)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors)

p1<-baseplot + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS11.png"  
agg_png(pngfile, width = 17.8, height = 8.9, units = "cm", res = 300, scaling = 0.9)
p1 + theme_bw() + 
  theme(plot.tag = element_text(face='bold'),
        axis.title.x = element_blank(), 
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) & 
  labs(y="Accuracy")
invisible(dev.off())
```

![](supfigures/figureS11.png)

**Figure S11: Contrasting directional and non-directional dominance models accuracy predicting family means.** The cross mean prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Each panel contains results for one of the selection indices (stdSI and biofortSI) and for the component traits (DM, logFYLD, MCMDS, TCHART). Prediction accuracies are on the y-axis and cross mean GEBV (MeanBV) and GETGV (MeanTGV) are on the x-axis. Colors distinguish whether results are based on the directional dominance (DirDom) model or not (Classic).

## Figure S12: Directional Dominance vs. Classic Model - Family (Co)variance Prediction Accuracy

```{r}
## Table S11: Accuracies predicting the variances
accVars<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS11") %>% 
  mutate(Component=ifelse(Trait1==Trait2,"Variance","Covariance"),
         TraitType=ifelse(grepl("SI",Trait1),"SI","ComponentTrait")) %>% 
  filter(ValidationData=="GBLUPs",VarMethod=="PMV") %>% 
  select(-ValidationData,-VarMethod,-AccuracyCor) %>% 
  mutate(Model=ifelse(grepl("DirDom",Model),"DirDom","Classic"))
```

```{r}
library(tidyverse); library(magrittr); library(patchwork); library(ragg)
accVars<-readxl::read_xlsx(here::here("manuscript","SupplementaryTables.xlsx"),sheet = "TableS11")
forplot<-accVars %>% 
  filter(ValidationData=="GBLUPs",VarMethod=="PMV") %>% 
  select(-ValidationData,-VarMethod,-AccuracyCor) %>% 
  mutate(Model=ifelse(grepl("DirDom",Model),"DirDom","Classic"),
         Trait1=factor(Trait1,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Trait2=factor(Trait2,levels=c("stdSI","biofortSI","DM","logFYLD","MCMDS","TCHART")),
         Component=paste0(Trait1,"_",Trait2),
         predOf=factor(predOf,levels=c("VarBV","VarTGV")),
         RepFold=paste0(Repeat,"_",Fold,"_",Component))

colors<-viridis::viridis(4)[1:2]

p1<-forplot %>% filter(Trait1==Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=Model,color=Model)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)

p2<-forplot %>% filter(Trait1!=Trait2) %>% 
  ggplot(.,aes(x=predOf,y=AccuracyWtCor, fill=Model,color=Model)) + 
  geom_hline(yintercept = 0, color='black', size=0.8) + 
  facet_grid(.~Trait1+Trait2) + 
  scale_fill_manual(values = colors) + 
  scale_color_manual(values = colors) + 
  geom_boxplot(size=0.9,notch = TRUE)
```

```{r,warning=F}
pngfile<-"docs/supfigures/figureS12.png"  
agg_png(pngfile, width = 17.8, height = 11.13, units = "cm", res = 300, scaling = 0.9)
(p1 / p2) +
  plot_layout(guides = 'collect',nrow=2) &
  theme_bw() & 
  theme(plot.tag = element_text(face='bold'),
        axis.title.x = element_blank(), 
        axis.title.y = element_text(face='bold',color = 'black'),
        strip.text.x = element_text(face='bold',color='black'),
        axis.text.x = element_text(face = 'bold',color='black', angle=30, hjust=1),
        axis.text.y = element_text(face = 'bold',color='black'),
        legend.title = element_text(face = 'bold',color='black'),
        legend.text = element_text(face='bold'),
        legend.position = 'bottom',
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) & labs(y="Accuracy")
invisible(dev.off())
```

![](supfigures/figureS12.png)

**Figure S12: Contrasting directional and non-directional dominance models accuracy predicting family (co)variances.** The cross variance and covariance prediction accuracy based on fivefold parent-wise cross-validation is shown using boxplots. Results are shown based on the directional dominance model. Each panel in the top row contains results for either a selection index (stdSI and biofortSI) or a component trait (DM, logFYLD, MCMDS, TCHART) variance. Each panel on the bottom row contains one of the six pairwise covariances between the four component traits. Prediction accuracies are on the y-axis and cross variance/covariance for GEBV (VarBV) and GETGV (VarTGV) are on the x-axis. Colors distinguish whether results are based on the directional dominance (DirDom) model or not (Classic).
