├── 01_LineBreeding ├── 06_Figure.png ├── 03_TwoPartGS │ ├── RunGSModels.R │ ├── LineGSTP.rds │ ├── Results.png │ ├── LineGSTP_accPI.rds │ ├── UpdateParents.R │ ├── StoreTrainPop.R │ ├── AdvanceYear.R │ ├── CreateParents.R │ ├── FillPipeline.R │ ├── GlobalParameters.R │ ├── ANALYZERESULTS.R │ ├── AdvanceYear_GSTP.R │ └── 00RUNME.R ├── LineProgram.jpeg ├── 02_GenomicSelection │ ├── RunGSModels.R │ ├── LineGS.rds │ ├── Results.png │ ├── LineProgramGS.jpeg │ ├── UpdateParents.R │ ├── UpdateParents_GS.R │ ├── StoreTrainPop.R │ ├── AdvanceYear.R │ ├── AdvanceYear_GS.R │ ├── CreateParents.R │ ├── FillPipeline.R │ ├── ANALYZERESULTS.R │ ├── GlobalParameters.R │ └── 00RUNME.R └── 01_PhenotypicSelection │ ├── 01_MassSelection │ ├── UpdateParents.R │ ├── Results.png │ ├── MassSelection.rds │ ├── AdvanceYear.R │ ├── FillPipeline.R │ ├── GlobalParameters.R │ ├── CreateParents.R │ ├── ExtraFunctions.R │ ├── ANALYZERESULTS.R │ └── 00RUNME.R │ ├── 02_SingleSeedDescent │ ├── UpdateParents.R │ ├── Results.png │ ├── LinePheno_SSD.rds │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── AdvanceYear.R │ ├── FillPipeline.R │ ├── GlobalParameters.R │ └── 00RUNME.R │ ├── 03_PedigreeSelection │ ├── UpdateParents.R │ ├── Results.png │ ├── LinePheno_pedigree.rds │ ├── ExtraFunctions.R │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── GlobalParameters.R │ ├── 00RUNME.R │ ├── AdvanceYear.R │ └── FillPipeline.R │ └── 04_DoubledHaploid │ ├── Results.png │ ├── UpdateParents.R │ ├── LinePheno_DH.rds │ ├── AdvanceYear.R │ ├── FillPipeline.R │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── GlobalParameters.R │ └── 00RUNME.R ├── 02_ClonalBreeding ├── ClonalProgram.jpeg ├── 03_GenomicSelection │ ├── RunModel_GS.R │ ├── Results.png │ ├── ClonalGS.rds │ ├── UpdateParents.R │ ├── CreateParents.R │ ├── AdvanceYear_GS.R │ ├── ANALYZERESULTS.R │ ├── AdvanceYear.R │ ├── GlobalParameters.R │ ├── StoreTrainPop.R │ ├── FillPipeline.R │ └── 00RUNME.R ├── 01_PhenotypicSelection │ ├── Results.png │ ├── ClonalPheno.rds │ ├── UpdateParents.R │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── AdvanceYear.R │ ├── GlobalParameters.R │ ├── FillPipeline.R │ └── 00RUNME.R └── 02_PedigreeSelection │ ├── Results.png │ ├── ClonalPedigree.rds │ ├── UpdateParents.R │ ├── CreateParents.R │ ├── AdvanceYear_Pedigree.R │ ├── ANALYZERESULTS.R │ ├── AdvanceYear.R │ ├── GlobalParameters.R │ ├── RunModel_Pedigree2.R │ ├── StoreTrainPop.R │ ├── FillPipeline.R │ ├── RunModel_Pedigree.R │ └── 00RUNME.R ├── 03_HybridBreeding ├── HybridProgram.jpeg ├── 03_TwoPartGS │ ├── Results.png │ ├── HybridGSTP.rds │ ├── HybridGSTP_accPI.rds │ ├── UpdateParents.R │ ├── UpdateResults.R │ ├── UpdateTesters.R │ ├── RunGSModels.R │ ├── StoreTrainPop.R │ ├── CreateParents.R │ ├── GlobalParameters.R │ ├── AdvanceYear.R │ ├── ANALYZERESULTS.R │ ├── FillPipeline.R │ └── 00RUNME.R ├── 02_GenomicSelection │ ├── Results.png │ ├── HybridGS.rds │ ├── UpdateParents.R │ ├── UpdateResults.R │ ├── UpdateTesters.R │ ├── UpdateParents_GS.R │ ├── RunGSModels.R │ ├── StoreTrainPop.R │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── GlobalParameters.R │ ├── AdvanceYear.R │ ├── FillPipeline.R │ ├── AdvanceYear_GS.R │ └── 00RUNME.R └── 01_PhenotypicSelection │ ├── Results.png │ ├── HybridPheno.rds │ ├── RunGSModels.R │ ├── UpdateParents.R │ ├── UpdateTesters.R │ ├── UpdateResults.R │ ├── StoreTrainPop.R │ ├── CreateParents.R │ ├── ANALYZERESULTS.R │ ├── GlobalParameters.R │ ├── AdvanceYear.R │ ├── FillPipeline.R │ └── 00RUNME.R ├── jbancic_alphasimr_plants.Rproj ├── .gitignore ├── LICENSE ├── 04_Features ├── genomeEditing.R ├── speedBreeding.R ├── miscellaneousSlot.R ├── setHeritability.R ├── importExternalHaplo.R ├── functions.R ├── simulateGxE.R ├── simulateGWAS.R ├── traitIntrogression.R └── specifyDemography.R └── README.md /01_LineBreeding/06_Figure.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/06_Figure.png -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/RunGSModels.R: -------------------------------------------------------------------------------- 1 | # Run genomic model 2 | 3 | cat(" Running GS model\n") 4 | gsModel = RRBLUP(TrainPop) 5 | -------------------------------------------------------------------------------- /01_LineBreeding/LineProgram.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/LineProgram.jpeg -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/RunGSModels.R: -------------------------------------------------------------------------------- 1 | # Run genomic model 2 | 3 | cat(" Running GS model\n") 4 | gsModel = RRBLUP(TrainPop) 5 | -------------------------------------------------------------------------------- /02_ClonalBreeding/ClonalProgram.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/ClonalProgram.jpeg -------------------------------------------------------------------------------- /03_HybridBreeding/HybridProgram.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/HybridProgram.jpeg -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/LineGSTP.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/03_TwoPartGS/LineGSTP.rds -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/03_TwoPartGS/Results.png -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/03_TwoPartGS/Results.png -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Parents are the selected individuals 4 | Parents = selected 5 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/RunModel_GS.R: -------------------------------------------------------------------------------- 1 | # Run ridge regression BLUP using AlphaSimR function 2 | 3 | gsmodel = RRBLUP(pop = trainPop, useReps = TRUE) -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/LineGS.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/02_GenomicSelection/LineGS.rds -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/02_GenomicSelection/Results.png -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/LineGSTP_accPI.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/03_TwoPartGS/LineGSTP_accPI.rds -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/HybridGSTP.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/03_TwoPartGS/HybridGSTP.rds -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/03_GenomicSelection/Results.png -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/02_GenomicSelection/Results.png -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/01_PhenotypicSelection/Results.png -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/02_PedigreeSelection/Results.png -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/ClonalGS.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/03_GenomicSelection/ClonalGS.rds -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/01_PhenotypicSelection/Results.png -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/HybridGS.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/02_GenomicSelection/HybridGS.rds -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/HybridGSTP_accPI.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/03_TwoPartGS/HybridGSTP_accPI.rds -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/LineProgramGS.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/02_GenomicSelection/LineProgramGS.jpeg -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new parents from EYT stage 4 | Parents = c(Parents[11:nParents], EYT) 5 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/ClonalPheno.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/01_PhenotypicSelection/ClonalPheno.rds -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/ClonalPedigree.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/02_ClonalBreeding/02_PedigreeSelection/ClonalPedigree.rds -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/HybridPheno.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/03_HybridBreeding/01_PhenotypicSelection/HybridPheno.rds -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/RunGSModels.R: -------------------------------------------------------------------------------- 1 | # Run genomic models 2 | 3 | cat(" Running GS model\n") 4 | gsModelM = RRBLUP(MaleTrainPop) 5 | gsModelF = RRBLUP(FemaleTrainPop) -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new parents from EYT stage 4 | Parents = c(Parents[11:nParents], EYT) 5 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/01_MassSelection/Results.png -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace all parents with new parents from ECT6 stage 4 | 5 | Parents = selectInd(ECT6, nInd = nParents, use = "pheno") 6 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace all parents with new parents from ECT6 stage 4 | 5 | Parents = selectInd(ECT6, nInd = nParents, use = "pheno") 6 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace all parents with new parents from ECT6 stage 4 | 5 | Parents = selectInd(ECT6, nInd = nParents, use = "pheno") 6 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest parents with 10 new parents from EYT1 stage 4 | Parents = c(Parents[11:nParents], EYT) 5 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest parents with 10 new parents from EYT stage 4 | Parents = c(Parents[11:nParents], EYT) 5 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/Results.png -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/Results.png -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/Results.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/Results.png -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new parents from EYT stage 4 | Parents = c(Parents[11:nParents], EYT) 5 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/MassSelection.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/01_MassSelection/MassSelection.rds -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/LinePheno_DH.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/LinePheno_DH.rds -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/LinePheno_SSD.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/LinePheno_SSD.rds -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/LinePheno_pedigree.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HighlanderLab/jbancic_alphasimr_plants/HEAD/01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/LinePheno_pedigree.rds -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new inbreds from YT4 stage 4 | MaleParents = c(MaleParents[11:nParents], selectInd(MaleInbredYT4,10)) 5 | FemaleParents = c(FemaleParents[11:nParents], selectInd(FemaleInbredYT4,10)) -------------------------------------------------------------------------------- /jbancic_alphasimr_plants.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new inbreds from YT4 stage 4 | MaleParents = c(MaleParents[11:nParents], selectInd(MaleInbredYT4,10)) 5 | FemaleParents = c(FemaleParents[11:nParents], selectInd(FemaleInbredYT4,10)) -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/UpdateParents.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new inbreds from YT4 stage 4 | MaleParents = c(MaleParents[11:nParents], selectInd(MaleInbredYT4,10)) 5 | FemaleParents = c(FemaleParents[11:nParents], selectInd(FemaleInbredYT4,10)) -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 3 7 | # Release variety 8 | 9 | # Stage 2 10 | F1 <- setPheno(F1, varE = varE) 11 | selected <- selectInd(F1,nParents) 12 | output$accSel[year] <- cor(F1@gv,F1@pheno) 13 | 14 | # Stage 1 15 | F1 <- randCross(Parents, nCrosses) 16 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/UpdateParents_GS.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new genomically-predicted 4 | # inbreds from DH stage 5 | 6 | # Predict ebv of DHs 7 | DH = setEBV(DH, gsModel) 8 | 9 | # Select 10 new parents based on EBVs 10 | newParents = selectInd(DH, 10, use = "ebv") 11 | 12 | # Replace 10 oldest inbred parents with 10 new inbreds from DH stage 13 | Parents = c(Parents[11:nParents], newParents) 14 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:2){ 5 | cat(" FillPipeline stage:",cohort,"of 2\n") 6 | if(cohort < 3){ 7 | #Stage 1 8 | F1 <- randCross(Parents, nCrosses) 9 | } 10 | if(cohort < 2){ 11 | #Stage 2 12 | F1 <- setPheno(F1, varE = varE) 13 | selected <- selectInd(F1,nParents) 14 | } 15 | if(cohort < 1){ 16 | ##Stage 3 17 | #Release variety 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Store training population 2 | 3 | if (year == startTP){ 4 | cat(" Start collecting training population \n") 5 | TrainPop = c(PYT, EYT, AYT) 6 | } 7 | 8 | if (year > startTP & year < nBurnin+1){ 9 | cat(" Collecting training population \n") 10 | TrainPop = c(TrainPop, 11 | PYT, EYT, AYT) 12 | } 13 | 14 | if (year > nBurnin){ 15 | cat(" Maintaining training population \n") 16 | TrainPop = c(TrainPop[-c(1:c(PYT, EYT, AYT)@nInd)], 17 | PYT, EYT, AYT) 18 | } 19 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Store training population 2 | 3 | if (year == startTP){ 4 | cat(" Start collecting training population \n") 5 | TrainPop = c(PYT, EYT, AYT) 6 | } 7 | 8 | if (year > startTP & year < nBurnin+1){ 9 | cat(" Collecting training population \n") 10 | TrainPop = c(TrainPop, 11 | PYT, EYT, AYT) 12 | } 13 | 14 | if (year > nBurnin){ 15 | cat(" Maintaining training population \n") 16 | TrainPop = c(TrainPop[-c(1:c(PYT, EYT, AYT)@nInd)], 17 | PYT, EYT, AYT) 18 | } 19 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/UpdateResults.R: -------------------------------------------------------------------------------- 1 | # Track performance of parental per se performance 2 | inbredMean[year] = (meanG(MaleInbredYT3)+meanG(FemaleInbredYT3))/2 3 | inbredVar[year] = (varG(MaleInbredYT3)+varG(FemaleInbredYT3))/2 4 | 5 | # Track performance of parental hybrid performance 6 | tmp = hybridCross(FemaleInbredYT3,MaleInbredYT3, 7 | returnHybridPop=TRUE) #Only use with DH parents 8 | hybridMean[year] = meanG(tmp) 9 | hybridVar[year] = varG(tmp) 10 | 11 | # Track per se-GCA correlation 12 | tmp = calcGCA(tmp,use="gv") 13 | hybridCorr[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 14 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 15 | rm(tmp) 16 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/UpdateTesters.R: -------------------------------------------------------------------------------- 1 | # Update testers 2 | 3 | # Replace oldest hybrid parent with parent of best hybrid from YT6 4 | bestMaleInbred = MaleHybridYT5@mother[ 5 | order(MaleHybridYT5@pheno[,1],decreasing=TRUE)[1] 6 | ] 7 | MaleElite = c(MaleElite[-1],MaleInbredYT5[bestMaleInbred]) 8 | 9 | bestFemaleInbred = FemaleHybridYT5@mother[ 10 | order(FemaleHybridYT5@pheno,decreasing=TRUE)[1] 11 | ] 12 | FemaleElite = c(FemaleElite[-1],FemaleInbredYT5[bestFemaleInbred]) 13 | 14 | # Update testers 15 | MaleTester1 = MaleElite[1:nTester1] 16 | FemaleTester1 = FemaleElite[1:nTester1] 17 | 18 | MaleTester2 = MaleElite[1:nTester2] 19 | FemaleTester2 = FemaleElite[1:nTester2] 20 | 21 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/UpdateTesters.R: -------------------------------------------------------------------------------- 1 | # Update testers 2 | 3 | # Replace oldest hybrid parent with parent of best hybrid from YT6 4 | bestMaleInbred = MaleHybridYT5@mother[ 5 | order(MaleHybridYT5@pheno[,1],decreasing=TRUE)[1] 6 | ] 7 | MaleElite = c(MaleElite[-1],MaleInbredYT5[bestMaleInbred]) 8 | 9 | bestFemaleInbred = FemaleHybridYT5@mother[ 10 | order(FemaleHybridYT5@pheno,decreasing=TRUE)[1] 11 | ] 12 | FemaleElite = c(FemaleElite[-1],FemaleInbredYT5[bestFemaleInbred]) 13 | 14 | # Update testers 15 | MaleTester1 = MaleElite[1:nTester1] 16 | FemaleTester1 = FemaleElite[1:nTester1] 17 | 18 | MaleTester2 = MaleElite[1:nTester2] 19 | FemaleTester2 = FemaleElite[1:nTester2] 20 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/UpdateResults.R: -------------------------------------------------------------------------------- 1 | # Track performance of parental per se performance 2 | inbredMean[year] = (meanG(MaleInbredYT3)+meanG(FemaleInbredYT3))/2 3 | inbredVar[year] = (varG(MaleInbredYT3)+varG(FemaleInbredYT3))/2 4 | 5 | # Track performance of parental hybrid performance 6 | tmp = hybridCross(FemaleInbredYT3,MaleInbredYT3, 7 | returnHybridPop=TRUE) #Only use with DH parents 8 | hybridMean[year] = meanG(tmp) 9 | hybridVar[year] = varG(tmp) 10 | 11 | # Track per se-GCA correlation 12 | tmp = calcGCA(tmp,use="gv") 13 | hybridCorr[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 14 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 15 | rm(tmp) 16 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/UpdateResults.R: -------------------------------------------------------------------------------- 1 | # Track performance of parental per se performance 2 | inbredMean[year] = (meanG(MaleInbredYT3)+meanG(FemaleInbredYT3))/2 3 | inbredVar[year] = (varG(MaleInbredYT3)+varG(FemaleInbredYT3))/2 4 | 5 | # Track performance of parental hybrid performance 6 | tmp = hybridCross(FemaleInbredYT3,MaleInbredYT3, 7 | returnHybridPop=TRUE) #Only use with DH parents 8 | hybridMean[year] = meanG(tmp) 9 | hybridVar[year] = varG(tmp) 10 | 11 | # Track per se-GCA correlation 12 | tmp = calcGCA(tmp,use="gv") 13 | hybridCorr[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 14 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 15 | rm(tmp) 16 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/UpdateTesters.R: -------------------------------------------------------------------------------- 1 | # Update testers 2 | 3 | # Replace oldest hybrid parent with parent of best hybrid from YT6 4 | bestMaleInbred = MaleHybridYT5@mother[ 5 | order(MaleHybridYT5@pheno[,1],decreasing=TRUE)[1] 6 | ] 7 | MaleElite = c(MaleElite[-1],MaleInbredYT5[bestMaleInbred]) 8 | 9 | bestFemaleInbred = FemaleHybridYT5@mother[ 10 | order(FemaleHybridYT5@pheno,decreasing=TRUE)[1] 11 | ] 12 | FemaleElite = c(FemaleElite[-1],FemaleInbredYT5[bestFemaleInbred]) 13 | 14 | # Update testers 15 | MaleTester1 = MaleElite[1:nTester1] 16 | FemaleTester1 = FemaleElite[1:nTester1] 17 | 18 | MaleTester2 = MaleElite[1:nTester2] 19 | FemaleTester2 = FemaleElite[1:nTester2] 20 | 21 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 7 7 | # Release variety 8 | 9 | # Stage 6 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 5 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 4 18 | output$accSel[year] = cor(HDRW@gv, HDRW@pheno) 19 | PYT = selectWithinFam(HDRW, famMax) 20 | PYT = selectInd(PYT, nPYT) 21 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 22 | 23 | # Stage 3 24 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 25 | 26 | # Stage 2 27 | DH = makeDH(F1, nDH) 28 | 29 | # Stage 1 30 | F1 = randCross(Parents, nCrosses) 31 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 7 7 | # Release variety 8 | 9 | # Stage 6 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 5 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 4 18 | output$accSel[year] = cor(HDRW@gv, HDRW@pheno) 19 | PYT = selectWithinFam(HDRW, famMax) 20 | PYT = selectInd(PYT, nPYT) 21 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 22 | 23 | # Stage 3 24 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 25 | 26 | # Stage 2 27 | DH = makeDH(F1, nDH) 28 | 29 | # Stage 1 30 | F1 = randCross(Parents, nCrosses) 31 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/UpdateParents_GS.R: -------------------------------------------------------------------------------- 1 | # Update parents 2 | 3 | # Replace 10 oldest inbred parents with 10 new genomically-predicted 4 | # inbreds from DH stage 5 | 6 | # Predict GCA of DHs 7 | if (exists("gsModel")) { 8 | MaleDH = setEBV(MaleDH, gsModel) 9 | FemaleDH = setEBV(FemaleDH, gsModel) 10 | } else { 11 | MaleDH = setEBV(MaleDH, gsModelM) 12 | FemaleDH = setEBV(FemaleDH, gsModelF) 13 | } 14 | 15 | # Select 10 new parents based on EBVs 16 | newMaleParents = selectInd(MaleDH, 10, use = "ebv") 17 | newFemaleParents = selectInd(FemaleDH, 10, use = "ebv") 18 | 19 | # Replace 10 oldest inbred parents with 10 new inbreds from DH stage 20 | MaleParents = c(MaleParents[11:nParents], newMaleParents) 21 | FemaleParents = c(FemaleParents[11:nParents], newFemaleParents) -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/ExtraFunctions.R: -------------------------------------------------------------------------------- 1 | ## This function is used to calculate between family accuracies 2 | ##' @param pop an object of Pop-class 3 | accuracy_family <- function(pop){ 4 | mother <- pop@mother 5 | father <- pop@father 6 | df <- data.frame( 7 | mother = mother, 8 | father = father 9 | ) 10 | df <- unique(df) 11 | families <- vector(mode = "list", length = nrow(df)) 12 | for (i in 1:nrow(df)) { 13 | mother_i <- df$mother[i] 14 | father_i <- df$father[i] 15 | families_i <- pop@mother == mother_i & pop@father == father_i 16 | tmp <- pop[families_i] 17 | families[[i]] <- tmp 18 | } 19 | phenotypes <- unlist(lapply(families, meanP)) 20 | gvs <- unlist(lapply(families,meanG)) 21 | cor(gvs,phenotypes) 22 | } 23 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | 5 | nReps = 1 # Number of simulation replicates 6 | nBurnin = 20 # Number of years in burnin phase 7 | nFuture = 20 # Number of years in future phase 8 | nCycles = nBurnin + nFuture 9 | 10 | # ---- Genome simulation ---- 11 | 12 | nChr = 1 # Number of QTL 13 | nQtl = 1000 # Number of QTL per chromosome 14 | nSnp = 0 # Number of SNP per chromosome 15 | 16 | # ---- Initial parents mean and variance ---- 17 | 18 | initMeanG = 1 19 | initVarG = 1 20 | varE = 1 21 | 22 | # ---- Breeding program details ---- 23 | 24 | nParents = 50 # Number of parents to start a breeding cycle 25 | nCrosses = 100 # Number of crosses per year 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | 41 | # Mac OS custom attributes file 42 | .DS_Store 43 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | SP = SimParam$new(founderPop) 10 | 11 | # Add SNP chip 12 | SP$restrSegSites(nQtl, nSnp) 13 | if (nSnp > 0) { 14 | SP$addSnpChip(nSnp) 15 | } 16 | 17 | # Add traits: trait represents yield 18 | SP$addTraitAG(nQtlPerChr = nQtl, 19 | mean = initMeanG, 20 | var = initVarG) 21 | 22 | # Collect pedigree 23 | SP$setTrackPed(TRUE) 24 | 25 | # Create founder parents 26 | Parents = newPop(founderPop) 27 | 28 | rm(founderPop) 29 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 7 7 | # Release variety 8 | 9 | # Stage 6 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 5 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 4 18 | output$accSel[year] = cor(HDRW@gv, HDRW@pheno) 19 | PYT = selectWithinFam(HDRW, famMax) 20 | PYT = selectInd(PYT, nPYT) 21 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 22 | 23 | # Stage 3 24 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 25 | 26 | # Stage 2 27 | DH = makeDH(F1, nDH) 28 | 29 | # Stage 1 30 | F1 = randCross(Parents, nCrosses) 31 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/AdvanceYear_GS.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 6 7 | # Release variety 8 | 9 | # Stage 5 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 4 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 3 - apply genomic selection 18 | # NOTE: HDRW removed because phenotyping not needed 19 | DH = setEBV(DH, gsModel) 20 | output$accSel[year] = cor(DH@gv, DH@ebv) 21 | PYT = selectWithinFam(DH, famMax,use = "ebv") 22 | PYT = selectInd(PYT, nPYT, use="ebv") 23 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 24 | 25 | # Stage 2 26 | DH = makeDH(F1, nDH) 27 | 28 | # Stage 1 29 | F1 = randCross(Parents, nCrosses) 30 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/ExtraFunctions.R: -------------------------------------------------------------------------------- 1 | # This function is used to calculate between family accuracies 2 | #' @param pop an object of Pop-class 3 | accuracy_family <- function(pop){ 4 | mother <- pop@mother 5 | father <- pop@father 6 | df <- data.frame( 7 | mother = mother, 8 | father = father 9 | ) 10 | df <- unique(df) 11 | families <- vector(mode = "list", length = nrow(df)) 12 | for (i in 1:nrow(df)) { 13 | mother_i <- df$mother[i] 14 | father_i <- df$father[i] 15 | families_i <- pop@mother == mother_i & pop@father == father_i 16 | tmp <- pop[families_i] 17 | families[[i]] <- tmp 18 | # PG: Do we want group level heritability so there is measurement error? 19 | } 20 | phenotypes <- unlist(lapply(families, meanP)) 21 | gvs <- unlist(lapply(families,meanG)) 22 | # PG: sometimes the gvs are all identical throwing an NA for the correlation. 23 | cor(gvs,phenotypes) 24 | } 25 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Create founder population 4 | founderPop = runMacs2(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | genLen = genLen, 8 | mutRate = mutRate) 9 | 10 | # Set simulation parameters 11 | SP = SimParam$new(founderPop) 12 | 13 | # Add SNP chip 14 | SP$restrSegSites(nQtl,nSnp) 15 | if (nSnp > 0) { 16 | SP$addSnpChip(nSnp) 17 | } 18 | 19 | # Add traits: trait represents yield 20 | SP$addTraitADG(nQtlPerChr = nQtl, 21 | mean = initMeanG, 22 | var = initVarG, 23 | varGxE = initVarGE) 24 | 25 | # Collect pedigree 26 | SP$setTrackPed(TRUE) 27 | 28 | # Create founder parents 29 | Parents = newPop(founderPop) 30 | 31 | # Set a phenotype to founder parents 32 | Parents = setPheno(Parents, varE = VarE, reps = repECT) 33 | rm(founderPop) 34 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | SP = SimParam$new(founderPop) 10 | 11 | # Add SNP chip 12 | SP$restrSegSites(nQtl, nSnp) 13 | if(nSnp > 0){ 14 | SP$addSnpChip(nSnp) 15 | } 16 | 17 | # Add traits: trait represents yield 18 | SP$addTraitAG(nQtlPerChr = nQtl, 19 | mean = initMeanG, 20 | var = initVarG, 21 | varEnv = initVarEnv, 22 | varGxE = initVarGE) 23 | 24 | SP$setTrackPed(TRUE) 25 | 26 | # Create founder parents 27 | Parents = newPop(founderPop) 28 | 29 | # Add phenotype reflecting evaluation in EYT 30 | Parents = setPheno(Parents, varE = varE, reps = repEYT) 31 | rm(founderPop) 32 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | SP = SimParam$new(founderPop) 10 | 11 | # Add SNP chip 12 | SP$restrSegSites(nQtl, nSnp) 13 | if (nSnp > 0) { 14 | SP$addSnpChip(nSnp) 15 | } 16 | 17 | # Add traits: trait represents yield 18 | SP$addTraitAG(nQtlPerChr = nQtl, 19 | mean = initMeanG, 20 | var = initVarG, 21 | varEnv = initVarEnv, 22 | varGxE = initVarGE) 23 | 24 | # Collect pedigree 25 | SP$setTrackPed(TRUE) 26 | 27 | # Create founder parents 28 | Parents = newPop(founderPop) 29 | 30 | # Add phenotype reflecting evaluation in EYT 31 | Parents = setPheno(Parents, varE = varE, reps = repEYT) 32 | rm(founderPop) 33 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | SP = SimParam$new(founderPop) 10 | 11 | # Add SNP chip 12 | SP$restrSegSites(nQtl, nSnp) 13 | if (nSnp > 0) { 14 | SP$addSnpChip(nSnp) 15 | } 16 | 17 | # Add traits: trait represents yield 18 | SP$addTraitAG(nQtlPerChr = nQtl, 19 | mean = initMeanG, 20 | var = initVarG, 21 | varEnv = initVarEnv, 22 | varGxE = initVarGE) 23 | 24 | # Collect pedigree 25 | SP$setTrackPed(TRUE) 26 | 27 | # Create founder parents 28 | Parents = newPop(founderPop) 29 | 30 | # Add phenotype reflecting evaluation in EYT 31 | Parents = setPheno(Parents, varE = varE, reps = repEYT) 32 | 33 | rm(founderPop) 34 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:7){ 5 | cat(" FillPipeline stage:",cohort,"of 7\n") 6 | if(cohort<7){ 7 | # Stage 1 8 | F1 = randCross(Parents, nCrosses) 9 | } 10 | if(cohort<6){ 11 | # Stage 2 12 | DH = makeDH(F1, nDH) 13 | } 14 | if(cohort<5){ 15 | # Stage 3 16 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 17 | } 18 | if(cohort<4){ 19 | # Stage 4 20 | PYT = selectWithinFam(HDRW, famMax) 21 | PYT = selectInd(PYT, nPYT) 22 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 23 | } 24 | if(cohort<3){ 25 | # Stage 5 26 | AYT = selectInd(PYT, nAYT) 27 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 28 | } 29 | if(cohort<2){ 30 | # Stage 6 31 | EYT = selectInd(AYT, nEYT) 32 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 33 | } 34 | if(cohort<1){ 35 | # Stage 7 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Create founder population 4 | founderPop = runMacs2(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | genLen = genLen, 8 | mutRate = mutRate) 9 | 10 | # Set simulation parameters 11 | SP = SimParam$new(founderPop) 12 | 13 | # Add SNP chip 14 | SP$restrSegSites(nQtl,nSnp) 15 | if (nSnp > 0) { 16 | SP$addSnpChip(nSnp) 17 | } 18 | 19 | # Add traits: trait represents yield 20 | SP$addTraitADG(nQtlPerChr = nQtl, 21 | mean = initMeanG, 22 | var = initVarG, 23 | varGxE = initVarGE) 24 | 25 | # Collect pedigree 26 | SP$setTrackPed(TRUE) 27 | 28 | # Create founder parents 29 | Parents = newPop(founderPop) 30 | 31 | # Set a phenotype to founder parents 32 | Parents = setPheno(Parents, varE = VarE, reps = repECT) 33 | rm(founderPop) 34 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Create founder population 4 | founderPop = runMacs2(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | genLen = genLen, 8 | mutRate = mutRate) 9 | 10 | # Set simulation parameters 11 | SP = SimParam$new(founderPop) 12 | 13 | # Add SNP chip 14 | SP$restrSegSites(nQtl,nSnp) 15 | if (nSnp > 0) { 16 | SP$addSnpChip(nSnp) 17 | } 18 | 19 | # Add traits: trait represents yield 20 | SP$addTraitADG(nQtlPerChr = nQtl, 21 | mean = initMeanG, 22 | var = initVarG, 23 | varGxE = initVarGE) 24 | 25 | # Collect pedigree 26 | SP$setTrackPed(TRUE) 27 | 28 | # Create founder parents 29 | Parents = newPop(founderPop) 30 | 31 | # Set a phenotype to founder parents 32 | Parents = setPheno(Parents, varE = VarE, reps = repECT) 33 | rm(founderPop) 34 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:7){ 5 | cat(" FillPipeline stage:",cohort,"of 7\n") 6 | if(cohort<7){ 7 | # Stage 1 8 | F1 = randCross(Parents, nCrosses) 9 | } 10 | if(cohort<6){ 11 | # Stage 2 12 | DH = makeDH(F1, nDH) 13 | } 14 | if(cohort<5){ 15 | # Stage 3 16 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 17 | } 18 | if(cohort<4){ 19 | # Stage 4 20 | PYT = selectWithinFam(HDRW, famMax) 21 | PYT = selectInd(PYT, nPYT) 22 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 23 | } 24 | if(cohort<3){ 25 | # Stage 5 26 | AYT = selectInd(PYT, nAYT) 27 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 28 | } 29 | if(cohort<2){ 30 | # Stage 6 31 | EYT = selectInd(AYT, nEYT) 32 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 33 | } 34 | if(cohort<1){ 35 | # Stage 7 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:7){ 5 | cat(" FillPipeline stage:",cohort,"of 7\n") 6 | if(cohort<7){ 7 | # Stage 1 8 | F1 = randCross(Parents, nCrosses) 9 | } 10 | if(cohort<6){ 11 | # Stage 2 12 | DH = makeDH(F1, nDH) 13 | } 14 | if(cohort<5){ 15 | # Stage 3 16 | HDRW = setPheno(DH, varE = varE, reps = repHDRW) 17 | } 18 | if(cohort<4){ 19 | # Stage 4 20 | PYT = selectWithinFam(HDRW, famMax) 21 | PYT = selectInd(PYT, nPYT) 22 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 23 | } 24 | if(cohort<3){ 25 | # Stage 5 26 | AYT = selectInd(PYT, nAYT) 27 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 28 | } 29 | if(cohort<2){ 30 | # Stage 6 31 | EYT = selectInd(AYT, nEYT) 32 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 33 | } 34 | if(cohort<1){ 35 | # Stage 7 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | SP = SimParam$new(founderPop) 10 | 11 | # Add SNP chip 12 | SP$restrSegSites(nQtl, nSnp) 13 | if (nSnp > 0) { 14 | SP$addSnpChip(nSnp) 15 | } 16 | 17 | # Add traits: trait represents yield 18 | SP$addTraitAG(nQtlPerChr = nQtl, 19 | mean = initMeanG, 20 | var = initVarG, 21 | varEnv = initVarEnv, 22 | varGxE = initVarGE) 23 | 24 | # Collect pedigree to conduct the Single-Hill method 25 | SP$setTrackPed(TRUE) 26 | 27 | # Create founder parents 28 | Parents = newPop(founderPop) 29 | 30 | # Add phenotype reflecting evaluation in EYT 31 | Parents = setPheno(Parents, varE = varE, reps = repEYT) 32 | rm(founderPop) 33 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Store training population of the past 3 years 2 | 3 | if (year == startTP){ 4 | cat(" Start collecting training population \n") 5 | MaleTrainPop = c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 6 | FemaleTrainPop = c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 7 | } 8 | 9 | if (year > startTP & year < nBurnin+1){ 10 | cat(" Collecting training population \n") 11 | MaleTrainPop = c(MaleTrainPop, 12 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 13 | FemaleTrainPop = c(FemaleTrainPop, 14 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 15 | } 16 | 17 | if (year > nBurnin){ 18 | cat(" Maintaining training population \n") 19 | MaleTrainPop = c(MaleTrainPop[-c(1:c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5)@nInd)], 20 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 21 | FemaleTrainPop = c(FemaleTrainPop[-c(1:c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5)@nInd)], 22 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 23 | } 24 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/AdvanceYear_GS.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 13 7 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[year]) 8 | 9 | # Stage 12 10 | ECT5 = ECT4 11 | 12 | # Stage 11 13 | ECT4 = ECT3 14 | 15 | # Stage 10 16 | ECT3 = ECT2 17 | 18 | # Stage 9 19 | ECT2 = ECT1 20 | 21 | # Stage 8 22 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 23 | 24 | # Stage 7 25 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[year]) 26 | 27 | # Stage 6 28 | ACT4 = ACT3 29 | 30 | # Stage 5 31 | ACT3 = ACT2 32 | 33 | # Stage 4 34 | ACT2 = ACT1 35 | 36 | # Stage 3 37 | ACT1 = setEBV(Seedlings, gsmodel, value = "bv") # calculate EBVs for Seedlings 38 | output$accSel[year] = cor(gv(ACT1), ebv(ACT1)) # accuracy based on 800 inds 39 | ACT1 = selectInd(ACT1, nInd = nClonesACT, use = "ebv") 40 | 41 | # Stage 2 42 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[year]) 43 | 44 | # Stage 1 45 | # Crossing block 46 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright <2023-> 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 6 | 7 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 8 | 9 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 10 | 11 | https://opensource.org/license/MIT 12 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/AdvanceYear_Pedigree.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 13 7 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[year]) 8 | 9 | # Stage 12 10 | ECT5 = ECT4 11 | 12 | # Stage 11 13 | ECT4 = ECT3 14 | 15 | # Stage 10 16 | ECT3 = ECT2 17 | 18 | # Stage 9 19 | ECT2 = ECT1 20 | 21 | # Stage 8 22 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 23 | 24 | # Stage 7 25 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[year]) 26 | 27 | # Stage 6 28 | ACT4 = ACT3 29 | 30 | # Stage 5 31 | ACT3 = ACT2 32 | 33 | # Stage 4 34 | ACT2 = ACT1 35 | 36 | # Stage 3 37 | # Use pedigree estimated breeding values to select seedlings for further evaluation 38 | Seedlings@ebv = as.matrix(tail(EBV, Seedlings@nInd)) 39 | output$accSel[year] = cor(gv(Seedlings), ebv(Seedlings)) 40 | ACT1 = selectInd(Seedlings, nInd = nClonesACT, use = "ebv") 41 | 42 | # Stage 2 43 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[year]) 44 | 45 | # Stage 1 46 | # Crossing block 47 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 48 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | # Generate initial haplotypes 4 | founderPop = runMacs(nInd = nParents, 5 | nChr = nChr, 6 | segSites = nQtl + nSnp, 7 | inbred = TRUE, 8 | species = "WHEAT") 9 | # founderPop = quickHaplo(nInd = nParents, 10 | # nChr = nChr, 11 | # segSites = nQtl + nSnp, 12 | # inbred = TRUE) 13 | 14 | SP = SimParam$new(founderPop) 15 | 16 | # Add SNP chip 17 | SP$restrSegSites(nQtl, nSnp) 18 | if (nSnp > 0) { 19 | SP$addSnpChip(nSnp) 20 | } 21 | 22 | # Add traits: trait represents yield 23 | SP$addTraitAG(nQtlPerChr = nQtl, 24 | mean = initMeanG, 25 | var = initVarG, 26 | varEnv = initVarEnv, 27 | varGxE = initVarGE) 28 | 29 | # Collect pedigree 30 | SP$setTrackPed(TRUE) 31 | 32 | # Create founder parents 33 | Parents = newPop(founderPop) 34 | 35 | # Add phenotype reflecting evaluation in EYT 36 | Parents = setPheno(Parents, varE = varE, reps = repEYT) 37 | 38 | rm(founderPop) 39 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 16 7 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[year]) 8 | 9 | # Stage 15 10 | ECT5 = ECT4 11 | 12 | # Stage 14 13 | ECT4 = ECT3 14 | 15 | # Stage 13 16 | ECT3 = ECT2 17 | 18 | # Stage 12 19 | ECT2 = ECT1 20 | 21 | # Stage 11 22 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 23 | 24 | # Stage 10 25 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[year]) 26 | 27 | # Stage 9 28 | ACT4 = ACT3 29 | 30 | # Stage 8 31 | ACT3 = ACT2 32 | 33 | # Stage 7 34 | ACT2 = ACT1 35 | 36 | # Stage 6 37 | output$accSel[year] = cor(gv(HPT3), pheno(HPT3)) # accuracy based on 2000 inds 38 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 39 | 40 | # Stage 5 41 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[year]) 42 | 43 | # Stage 4 44 | HPT2 = HPT1 45 | 46 | # Stage 3 47 | HPT1 = Seedlings 48 | 49 | # Stage 2 50 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[year]) 51 | 52 | # Stage 1 53 | # Crossing block 54 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 55 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 16 7 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[year]) 8 | 9 | # Stage 15 10 | ECT5 = ECT4 11 | 12 | # Stage 14 13 | ECT4 = ECT3 14 | 15 | # Stage 13 16 | ECT3 = ECT2 17 | 18 | # Stage 12 19 | ECT2 = ECT1 20 | 21 | # Stage 11 22 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 23 | 24 | # Stage 10 25 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[year]) 26 | 27 | # Stage 9 28 | ACT4 = ACT3 29 | 30 | # Stage 8 31 | ACT3 = ACT2 32 | 33 | # Stage 7 34 | ACT2 = ACT1 35 | 36 | # Stage 6 37 | output$accSel[year] = cor(gv(HPT3), pheno(HPT3)) # accuracy based on 2000 inds 38 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 39 | 40 | # Stage 5 41 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[year]) 42 | 43 | # Stage 4 44 | HPT2 = HPT1 45 | 46 | # Stage 3 47 | HPT1 = Seedlings 48 | 49 | # Stage 2 50 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[year]) 51 | 52 | # Stage 1 53 | # Crossing block 54 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 55 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 16 7 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[year]) 8 | 9 | # Stage 15 10 | ECT5 = ECT4 11 | 12 | # Stage 14 13 | ECT4 = ECT3 14 | 15 | # Stage 13 16 | ECT3 = ECT2 17 | 18 | # Stage 12 19 | ECT2 = ECT1 20 | 21 | # Stage 11 22 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 23 | 24 | # Stage 10 25 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[year]) 26 | 27 | # Stage 9 28 | ACT4 = ACT3 29 | 30 | # Stage 8 31 | ACT3 = ACT2 32 | 33 | # Stage 7 34 | ACT2 = ACT1 35 | 36 | # Stage 6 37 | output$accSel[year] = cor(gv(HPT3), pheno(HPT3)) # accuracy based on 2000 inds 38 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 39 | 40 | # Stage 5 41 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[year]) 42 | 43 | # Stage 4 44 | HPT2 = HPT1 45 | 46 | # Stage 3 47 | HPT1 = Seedlings 48 | 49 | # Stage 2 50 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[year]) 51 | 52 | # Stage 1 53 | # Crossing block 54 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 55 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 450, res = 150) # Higher resolution 16 | par(mfrow = c(3, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 20 | "Genetic gain", "Year", "Yield") 21 | 22 | # Genetic Variance 23 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 24 | "Genetic variance", "Year", "Variance") 25 | 26 | # Selection Accuracy 27 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 28 | "Selection accuracy", "Year", "Correlation") 29 | 30 | dev.off() 31 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 11 7 | # Release variety 8 | 9 | # Stage 10 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 9 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 8 18 | output$accSel[year] = cor(HDRW@gv, HDRW@pheno) 19 | PYT = selectWithinFam(HDRW, famMax) 20 | PYT = selectInd(PYT, nPYT) 21 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 22 | 23 | # Stage 7 24 | HDRW = setPheno(S4, varE = varE, reps = repHDRW) 25 | 26 | # Stage 6 27 | # Assume all seed germinates 28 | # Take single seed from each plant 29 | # Lines almost fully inbred 30 | S4 = self(S3) 31 | 32 | # Stage 5 33 | # Assume all seed germinates 34 | # Take single seed from each plant 35 | S3 = self(S2) 36 | 37 | # Stage 4 38 | # Assume all seed germinates 39 | # Take single seed from each plant 40 | S2 = self(S1) 41 | 42 | # Stage 3 43 | # Take single seed from each plant 44 | S1 = self(S0) 45 | 46 | # Stage 2 47 | # Create segregating population 48 | S0 = self(F1, nProgeny) 49 | 50 | # Stage 1 51 | F1 = randCross(Parents, nCrosses) 52 | 53 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:11){ 5 | cat(" FillPipeline stage:",cohort,"of 11\n") 6 | if(cohort < 11){ 7 | # Stage 1 8 | F1 = randCross(Parents, nCrosses) 9 | } 10 | if(cohort < 10){ 11 | # Stage 2 12 | S0 = self(F1, nProgeny) 13 | } 14 | if(cohort < 9){ 15 | # Stage 3 16 | S1 = self(S0) 17 | } 18 | if(cohort < 8){ 19 | # Stage 4 20 | S2 = self(S1) 21 | } 22 | if(cohort < 7){ 23 | # Stage 5 24 | S3 = self(S2) 25 | } 26 | if(cohort < 6){ 27 | # Stage 6 28 | S4 = self(S3) 29 | } 30 | if(cohort < 5){ 31 | # Stage 7 32 | HDRW = setPheno(S4, varE = varE, reps = repHDRW) 33 | } 34 | if(cohort < 4){ 35 | # Stage 8 36 | PYT = selectWithinFam(HDRW, famMax) 37 | PYT = selectInd(PYT, nPYT) 38 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 39 | } 40 | if(cohort < 3){ 41 | # Stage 9 42 | AYT = selectInd(PYT, nAYT) 43 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 44 | } 45 | if(cohort < 2){ 46 | # Stage 10 47 | EYT = selectInd(AYT, nEYT) 48 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 49 | } 50 | if(cohort < 1){ 51 | # Stage 11 52 | # Release variety 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/RunGSModels.R: -------------------------------------------------------------------------------- 1 | # Run genomic models 2 | 3 | # # Option 1: Single pool additive GCA model (in code) 4 | # cat(" Running GS model\n") 5 | # gsModelM = RRBLUP(MaleTrainPop) 6 | # gsModelF = RRBLUP(FemaleTrainPop) 7 | 8 | # Option 2: Hybrid additive GCA model (in code) 9 | cat(" Running GS model\n") 10 | gsModel = RRBLUP(HybTrainPop) 11 | 12 | # Option 3: Hybrid Additive + Dominance Model (GCA + SCA) 13 | # NOTE: Not implemented in the code! 14 | # Example for asigning EBVs 15 | # MaleParents = setEBV(MaleParents, gsModel, value = "bv", targetPop = FemaleParents) 16 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "bv", targetPop = MaleParents) 17 | 18 | # Option 4: Hybrid Pool Specific Additive Model (GCAm + GCAf) 19 | # NOTE: Not implemented in the code! 20 | # gsModel = RRBLUP_GCA(HybTrainPop) 21 | # Example for asigning EBVs 22 | # MaleParents = setEBV(MaleParents, gsModel, value = "male") 23 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "female") 24 | 25 | # Option 5: Hybrid Pool Specific Additive + Dominance Model (GCAm + GCAf + SCA) 26 | # NOTE: Not implemented in the code! 27 | # gsModel = RRBLUP_SCA(HybTrainPop) 28 | # Example for asigning EBVs 29 | # MaleParents = setEBV(MaleParents, gsModel, value = "male", targetPop = FemaleParents) 30 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "female", targetPop = MaleParents) -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/RunGSModels.R: -------------------------------------------------------------------------------- 1 | # Run genomic models 2 | 3 | # # Option 1: Single pool additive GCA model (in code) 4 | # cat(" Running GS model\n") 5 | # gsModelM = RRBLUP(MaleTrainPop) 6 | # gsModelF = RRBLUP(FemaleTrainPop) 7 | 8 | # Option 2: Hybrid additive GCA model (in code) 9 | cat(" Running GS model\n") 10 | gsModel = RRBLUP(HybTrainPop) 11 | 12 | # Option 3: Hybrid Additive + Dominance Model (GCA + SCA) 13 | # NOTE: Not implemented in the code! 14 | # Example for asigning EBVs 15 | # MaleParents = setEBV(MaleParents, gsModel, value = "bv", targetPop = FemaleParents) 16 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "bv", targetPop = MaleParents) 17 | 18 | # Option 4: Hybrid Pool Specific Additive Model (GCAm + GCAf) 19 | # NOTE: Not implemented in the code! 20 | # gsModel = RRBLUP_GCA(HybTrainPop) 21 | # Example for asigning EBVs 22 | # MaleParents = setEBV(MaleParents, gsModel, value = "male") 23 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "female") 24 | 25 | # Option 5: Hybrid Pool Specific Additive + Dominance Model (GCAm + GCAf + SCA) 26 | # NOTE: Not implemented in the code! 27 | # gsModel = RRBLUP_SCA(HybTrainPop) 28 | # Example for asigning EBVs 29 | # MaleParents = setEBV(MaleParents, gsModel, value = "male", targetPop = FemaleParents) 30 | # FemaleParent = setEBV(FemaleParent, gsModel, value = "female", targetPop = MaleParents) -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | 9 | # ---- Genome simulation ---- 10 | nQtl = 1000 # Number of QTL per chromosome 11 | nSnp = 0 # Number of SNP per chromosome 12 | 13 | # ---- Initial parents mean and variance ---- 14 | initMeanG = 1 15 | initVarG = 1 16 | initVarEnv = 1e-6 # Virtually zero for consistency with 2-Part paper 17 | initVarGE = 2 18 | varE = 4 # Yield trial error variance, bushels per acre 19 | # Relates to error variance for an entry mean 20 | 21 | # ---- Breeding program details ---- 22 | nParents = 50 # Number of parents to start a breeding cycle 23 | nCrosses = 100 # Number of crosses per year 24 | nProgeny = 10 # Selfed pregeny produced per cross 25 | famMax = 10 # The maximum number of selfed lines per cross to enter PYT 26 | nPYT = 500 # Entries per preliminary yield trial 27 | nAYT = 50 # Entries per advanced yield trial 28 | nEYT = 10 # Entries per elite yield trial 29 | 30 | # Effective replication of yield trials 31 | repHDRW = 4/9 #h2 = 0.1 32 | repPYT = 1 #h2 = 0.2 33 | repAYT = 4 #h2 = 0.5 34 | repEYT = 8 #h2 = 0.7 35 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 19 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 10 12 | nQtl = 1000 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | 15 | # ---- Initial parents mean and variance ---- 16 | initMeanG = 1 17 | initVarG = 1 18 | initVarEnv = 1e-6 # Virtually zero for consistency with 2-Part paper 19 | initVarGE = 2 20 | varE = 4 # Yield trial error variance, bushels per acre 21 | # Relates to error variance for an entry mean 22 | 23 | # ---- Breeding program details ---- 24 | nParents = 50 # Number of parents to start a breeding cycle 25 | nCrosses = 100 # Number of crosses per year 26 | nDH = 100 # DH lines produced per cross 27 | famMax = 10 # The maximum number of DH lines per cross to enter PYT 28 | nPYT = 500 # Entries per preliminary yield trial 29 | nAYT = 50 # Entries per advanced yield trial 30 | nEYT = 10 # Entries per elite yield trial 31 | 32 | # Effective replication of yield trials 33 | repHDRW = 4/9 # h2 = 0.1 34 | repPYT = 1 # h2 = 0.2 35 | repAYT = 4 # h2 = 0.5 36 | repEYT = 8 # h2 = 0.7 37 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 19 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 10 12 | nQtl = 1000 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | 15 | # ---- Initial parents mean and variance ---- 16 | initMeanG = 1 17 | initVarG = 1 18 | initVarEnv = 1e-6 # Virtually zero for consistency with 2-Part paper 19 | initVarGE = 2 20 | varE = 4 # Yield trial error variance, bushels per acre 21 | # Relates to error variance for an entry mean 22 | 23 | # ---- Breeding program details ---- 24 | nParents = 50 # Number of parents to start a breeding cycle 25 | nCrosses = 100 # Number of crosses per year 26 | nDH = 100 # DH lines produced per cross 27 | famMax = 10 # The maximum number of DH lines per cross to enter PYT 28 | nPYT = 500 # Entries per preliminary yield trial 29 | nAYT = 50 # Entries per advanced yield trial 30 | nEYT = 10 # Entries per elite yield trial 31 | 32 | # Effective replication of yield trials 33 | repHDRW = 4/9 # h2 = 0.1 34 | repPYT = 1 # h2 = 0.2 35 | repAYT = 4 # h2 = 0.5 36 | repEYT = 8 # h2 = 0.7 37 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 18 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 10 12 | nQtl = 1000 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | 15 | # ---- Initial parents mean and variance ---- 16 | initMeanG = 1 17 | initVarG = 1 18 | initVarEnv = 1e-6 # Virtually zero for consistency with 2-Part paper 19 | initVarGE = 2 20 | varE = 4 # Yield trial error variance, bushels per acre 21 | # Relates to error variance for an entry mean 22 | 23 | # ---- Breeding program details ---- 24 | nParents = 50 # Number of parents to start a breeding cycle 25 | nCrosses = 100 # Number of crosses per year 26 | nDH = 100 # DH lines produced per cross 27 | famMax = 10 # The maximum number of DH lines per cross to enter PYT 28 | nPYT = 500 # Entries per preliminary yield trial 29 | nAYT = 50 # Entries per advanced yield trial 30 | nEYT = 10 # Entries per elite yield trial 31 | 32 | # Effective replication of yield trials 33 | repHDRW = 4/9 # h2 = 0.1 34 | repPYT = 1 # h2 = 0.2 35 | repAYT = 4 # h2 = 0.5 36 | repEYT = 8 # h2 = 0.7 37 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 40 # Number of years in burnin phase 6 | nFuture = 40 # Number of years in future phase 7 | startRecords = 35 # Year when training and pedigree record collecting begins 8 | nCycles = nBurnin + nFuture 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 160 # Number of QTL per chromosome: 15 chr x 160 QTL = 2400 QTLs 13 | nSnp = 600 # Simulate SNP chip with 9000 markers 14 | genLen = 1 # Genetic length 15 | PhyLen = 1e+08 # Physical length 16 | mutRate = 2.5e-08 # Mutation rate 17 | 18 | # ---- Initial parents mean and variance ---- 19 | initMeanG = 2500 # Phenotypic mean 20 | initVarG = 150000 # Genetic variance 21 | initVarGE = 150000 # Genotype-by-year interaction variance 22 | VarE = 2800000 # Single variance 23 | 24 | # ---- Breeding program details ---- 25 | nParents = 20 # Number of parents (and founders) 26 | nCrosses = 100 # Number of crosses 27 | nProgeny = 20 # Number of progenies per cross 28 | nClonesACT = 500 # Number of individuals selected at ACT stage 29 | nClonesECT = 40 # Number of individuals selected at ECT stage 30 | 31 | # Effective replication of yield trials 32 | repHPT = 1 # h2 = 0.05 33 | repACT = 15 # h2 = 0.45 34 | repECT = 50 # h2 = 0.65 -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 40 # Number of years in burnin phase 6 | nFuture = 40 # Number of years in future phase 7 | startRecords = 35 # Year when training and pedigree record collecting begins 8 | nCycles = nBurnin + nFuture 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 160 # Number of QTL per chromosome: 15 chr x 160 QTL = 2400 QTLs 13 | nSnp = 600 # Simulate SNP chip with 9000 markers 14 | genLen = 1 # Genetic length 15 | PhyLen = 1e+08 # Physical length 16 | mutRate = 2.5e-08 # Mutation rate 17 | 18 | # ---- Initial parents mean and variance ---- 19 | initMeanG = 2500 # Phenotypic mean 20 | initVarG = 150000 # Genetic variance 21 | initVarGE = 150000 # Genotype-by-year interaction variance 22 | VarE = 2800000 # Single variance 23 | 24 | # ---- Breeding program details ---- 25 | nParents = 20 # Number of parents (and founders) 26 | nCrosses = 100 # Number of crosses 27 | nProgeny = 20 # Number of progenies per cross 28 | nClonesACT = 500 # Number of individuals selected at ACT stage 29 | nClonesECT = 40 # Number of individuals selected at ECT stage 30 | 31 | # Effective replication of yield trials 32 | repHPT = 1 # h2 = 0.05 33 | repACT = 15 # h2 = 0.45 34 | repECT = 50 # h2 = 0.65 -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 40 # Number of years in burnin phase 6 | nFuture = 40 # Number of years in future phase 7 | startRecords = 35 # Year when training and pedigree record collecting begins 8 | nCycles = nBurnin + nFuture 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 160 # Number of QTL per chromosome: 15 chr x 160 QTL = 2400 QTLs 13 | nSnp = 600 # Simulate SNP chip with 9000 markers 14 | genLen = 1 # Genetic length 15 | PhyLen = 1e+08 # Physical length 16 | mutRate = 2.5e-08 # Mutation rate 17 | 18 | # ---- Initial parents mean and variance ---- 19 | initMeanG = 2500 # Phenotypic mean 20 | initVarG = 150000 # Genetic variance 21 | initVarGE = 150000 # Genotype-by-year interaction variance 22 | VarE = 2800000 # Single variance 23 | 24 | # ---- Breeding program details ---- 25 | nParents = 20 # Number of parents (and founders) 26 | nCrosses = 100 # Number of crosses 27 | nProgeny = 20 # Number of progenies per cross 28 | nClonesACT = 500 # Number of individuals selected at ACT stage 29 | nClonesECT = 40 # Number of individuals selected at ECT stage 30 | 31 | # Effective replication of yield trials 32 | repHPT = 1 # h2 = 0.05 33 | repACT = 15 # h2 = 0.45 34 | repECT = 50 # h2 = 0.65 -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | df2 <- bind_rows(readRDS(paste0(scenarioName,"_accPI.rds"))) 7 | 8 | # Plotting function 9 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 10 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 11 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 12 | if (!is.null(extra_plot_func)) extra_plot_func() 13 | } 14 | 15 | # Plot 16 | png("Results.png", height = 1200, width = 600, res = 150) # Higher resolution 17 | par(mfrow = c(4, 1), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 18 | 19 | # Genetic Gain 20 | plot_results(1:nCycles, rowMeans(matrix(df$meanG, ncol = max(df$rep))), 21 | "Genetic gain", "Year", "Yield") 22 | 23 | # Genetic Variance 24 | plot_results(1:nCycles, rowMeans(matrix(df$varG, ncol = max(df$rep))), 25 | "Genetic variance", "Year", "Variance") 26 | 27 | # Selection Accuracy in Product Development 28 | plot_results(1:nCycles, rowMeans(matrix(df$accSel, ncol = max(df$rep))), 29 | "Selection accuracy in Product Development", "Year", "Correlation") 30 | 31 | # Selection Accuracy in Population Improvement 32 | plot_results(1:nCycles, rowMeans(matrix(df2$accPI, ncol = max(df$rep))), 33 | "Selection accuracy in Population Improvement", "Cycle", "Correlation") 34 | 35 | dev.off() 36 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | 9 | # ---- Genome simulation ---- 10 | nQtl = 1000 # Number of QTL per chromosome 11 | nSnp = 0 # Number of SNP per chromosome 12 | nChr = 1 # Number of chromosomes 13 | 14 | # ---- Initial parents mean and variance ---- 15 | initMeanG = 1 16 | initVarG = 1 17 | initVarEnv = 1e-6 # Virtually zero for consistency with 2-Part paper 18 | initVarGE = 2 19 | varE = 4 # Yield trial error variance, bushels per acre 20 | # Relates to error variance for an entry mean 21 | ## h2 = 0.05 22 | 23 | # ---- Breeding program details ---- 24 | nParents = 20 # Number of parents to start a breeding cycle 25 | nCrosses = 40 # Number of crosses per year 26 | 27 | # Number of progeny per selfed individual in each stage 28 | nF2 = 100 29 | plantsPerRow = 20 30 | 31 | # Number of individuals to select in each stage 32 | nPYT = 100 # Entries per preliminary yield trial 33 | nAYT = 50 # Entries per advanced yield trial 34 | nEYT = 10 # Entries per elite yield trial 35 | nSelF2 = 10 36 | nSelF3 = 4 37 | nSelF4 = 4 38 | nSelF5 = 4 39 | 40 | # Number of rows to select in each stage 41 | nRowF3 = 10 42 | nRowF4 = 10 43 | nRowF5 = 10 44 | nRowF6 = 4 45 | 46 | # Effective replication of yield trials 47 | repF6 = 4/9 # h2 = 0.1 48 | repPYT = 1 #h2 = 0.2 49 | repAYT = 4 #h2 = 0.5 50 | repEYT = 8 #h2 = 0.7 51 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/RunModel_Pedigree2.R: -------------------------------------------------------------------------------- 1 | # Run pedigree BLUP model internal AlphaSimR solver 2 | 3 | # Pedigree BLUP is used to predict breeding values of Seedlings in 4 | # order to skip HPT stages 5 | 6 | # Prepare prediction dataset for seedlings 7 | pedPop_tmp = rbind(pedPop, 8 | data.frame(Ind = c(Seedlings@id), 9 | Sire = c(Seedlings@father), 10 | Dam = c(Seedlings@mother), 11 | Year = year, 12 | Stage = rep("Seedlings",Seedlings@nInd), 13 | Pheno = NA, 14 | GV = c(Seedlings@gv))) 15 | 16 | # Construct numerator relationship matrix A 17 | pedPop_tmp$Ind = as.factor(pedPop_tmp$Ind) 18 | pedPop_tmp$Dam = as.factor(pedPop_tmp$Dam) 19 | pedPop_tmp$Sire = as.factor(pedPop_tmp$Sire) 20 | A = ainverse(pedPop_tmp[,1:3]) 21 | 22 | # Run model 23 | pedPop_tmp$Year[is.na(pedPop_tmp$Year)] = 0 24 | pedPop_tmp$Year = as.factor(pedPop_tmp$Year) 25 | pedPop_tmp$Stage = as.factor(pedPop_tmp$Stage) 26 | 27 | asreml.options(trace=FALSE) 28 | pedModel <- asreml(fixed = Pheno ~ 1 + Year, 29 | random = ~ vm(Ind, A), 30 | # residual = ~ dsum(~id(units) | Year), 31 | residual = ~ units, 32 | na.action = na.method(y='include'), 33 | data = pedPop_tmp) 34 | 35 | # Loop to ensure model converges 36 | while (pedModel$converge != TRUE) { 37 | pedModel <- update.asreml(pedModel) 38 | } 39 | 40 | # Assign estimated breeding values to Seedling 41 | EBV = pedModel$coef$random 42 | 43 | 44 | rm(pedPop_tmp) 45 | 46 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Store training population of the past 3 years 2 | 3 | if (year == startTP){ 4 | cat(" Start collecting training population \n") 5 | HybTrainPop = c(MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 6 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 7 | MaleTrainPop = c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 8 | FemaleTrainPop = c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 9 | } 10 | 11 | if (year > startTP & year < nBurnin+1){ 12 | cat(" Collecting training population \n") 13 | HybTrainPop = c(HybTrainPop, 14 | MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 15 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 16 | MaleTrainPop = c(MaleTrainPop, 17 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 18 | FemaleTrainPop = c(FemaleTrainPop, 19 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 20 | } 21 | 22 | if (year > nBurnin){ 23 | cat(" Maintaining training population \n") 24 | nRemove = c(MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 25 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5)@nInd 26 | HybTrainPop = c(HybTrainPop[-c(1:nRemove)], 27 | MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 28 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 29 | MaleTrainPop = c(MaleTrainPop[-c(1:c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5)@nInd)], 30 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 31 | FemaleTrainPop = c(FemaleTrainPop[-c(1:c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5)@nInd)], 32 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 33 | rm(nRemove) 34 | } 35 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Store training population of the past 3 years 2 | 3 | if (year == startTP){ 4 | cat(" Start collecting training population \n") 5 | HybTrainPop = c(MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 6 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 7 | MaleTrainPop = c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 8 | FemaleTrainPop = c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 9 | } 10 | 11 | if (year > startTP & year < nBurnin+1){ 12 | cat(" Collecting training population \n") 13 | HybTrainPop = c(HybTrainPop, 14 | MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 15 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 16 | MaleTrainPop = c(MaleTrainPop, 17 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 18 | FemaleTrainPop = c(FemaleTrainPop, 19 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 20 | } 21 | 22 | if (year > nBurnin){ 23 | cat(" Maintaining training population \n") 24 | nRemove = c(MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 25 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5)@nInd 26 | HybTrainPop = c(HybTrainPop[-c(1:nRemove)], 27 | MaleHybridYT3,MaleHybridYT4,MaleHybridYT5, 28 | FemaleHybridYT3,FemaleHybridYT4,FemaleHybridYT5) 29 | MaleTrainPop = c(MaleTrainPop[-c(1:c(MaleInbredYT3,MaleInbredYT4,MaleInbredYT5)@nInd)], 30 | MaleInbredYT3,MaleInbredYT4,MaleInbredYT5) 31 | FemaleTrainPop = c(FemaleTrainPop[-c(1:c(FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5)@nInd)], 32 | FemaleInbredYT3,FemaleInbredYT4,FemaleInbredYT5) 33 | rm(nRemove) 34 | } 35 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | cat("Making initial parents \n") 4 | 5 | # Create founder population 6 | founderPop = runMacs(nInd = nParents * 2, 7 | nChr = nChr, 8 | segSites = nQtl + nSnp, 9 | inbred = TRUE, 10 | split = nGenSplit, 11 | species = "MAIZE") 12 | 13 | # Set simulation parameters 14 | SP = SimParam$new(founderPop) 15 | 16 | # Add SNP chip 17 | SP$restrSegSites(nQtl,nSnp) 18 | if (nSnp > 0) { 19 | SP$addSnpChip(nSnp) 20 | } 21 | 22 | # Add traits: trait represents yield 23 | SP$addTraitADG(nQtlPerChr = nQtl, 24 | mean = initMeanG, 25 | var = initVarG, 26 | meanDD = MeanDD, 27 | varDD = VarDD, 28 | varGxE = initVarGE) 29 | # Set permanent yield trial error variance 30 | SP$setVarE(varE = VarE) 31 | 32 | # Split heterotic pools to form initial parents 33 | FemaleParents = newPop(founderPop[1:nParents]) 34 | MaleParents = newPop(founderPop[(nParents+1):(nParents*2)]) 35 | 36 | # Set hybrid parents for later yield trials 37 | MaleElite = selectInd(MaleParents, nElite, use = "gv") 38 | FemaleElite = selectInd(FemaleParents, nElite, use = "gv") 39 | 40 | # Reverse order to keep best parent in longer 41 | MaleElite = MaleElite[nElite:1] 42 | FemaleElite = FemaleElite[nElite:1] 43 | 44 | # Set initial testers for YT1 and YT2 45 | # Requires nTesters to be smaller than nElite 46 | MaleTester1 = MaleElite[1:nTester1] 47 | FemaleTester1 = FemaleElite[1:nTester1] 48 | MaleTester2 = MaleElite[1:nTester2] 49 | FemaleTester2 = FemaleElite[1:nTester2] 50 | rm(founderPop) 51 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | cat("Making initial parents \n") 4 | 5 | # Create founder population 6 | founderPop = runMacs(nInd = nParents * 2, 7 | nChr = nChr, 8 | segSites = nQtl + nSnp, 9 | inbred = TRUE, 10 | split = nGenSplit, 11 | species = "MAIZE") 12 | 13 | # Set simulation parameters 14 | SP = SimParam$new(founderPop) 15 | 16 | # Add SNP chip 17 | SP$restrSegSites(nQtl,nSnp) 18 | if (nSnp > 0) { 19 | SP$addSnpChip(nSnp) 20 | } 21 | 22 | # Add traits: trait represents yield 23 | SP$addTraitADG(nQtlPerChr = nQtl, 24 | mean = initMeanG, 25 | var = initVarG, 26 | meanDD = MeanDD, 27 | varDD = VarDD, 28 | varGxE = initVarGE) 29 | # Set permanent yield trial error variance 30 | SP$setVarE(varE = VarE) 31 | 32 | # Split heterotic pools to form initial parents 33 | FemaleParents = newPop(founderPop[1:nParents]) 34 | MaleParents = newPop(founderPop[(nParents+1):(nParents*2)]) 35 | 36 | # Set hybrid parents for later yield trials 37 | MaleElite = selectInd(MaleParents, nElite, use = "gv") 38 | FemaleElite = selectInd(FemaleParents, nElite, use = "gv") 39 | 40 | # Reverse order to keep best parent in longer 41 | MaleElite = MaleElite[nElite:1] 42 | FemaleElite = FemaleElite[nElite:1] 43 | 44 | # Set initial testers for YT1 and YT2 45 | # Requires nTesters to be smaller than nElite 46 | MaleTester1 = MaleElite[1:nTester1] 47 | FemaleTester1 = FemaleElite[1:nTester1] 48 | MaleTester2 = MaleElite[1:nTester2] 49 | FemaleTester2 = FemaleElite[1:nTester2] 50 | rm(founderPop) 51 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/CreateParents.R: -------------------------------------------------------------------------------- 1 | # Create founders 2 | 3 | cat("Making initial parents \n") 4 | 5 | # Create founder population 6 | founderPop = runMacs(nInd = nParents * 2, 7 | nChr = nChr, 8 | segSites = nQtl + nSnp, 9 | inbred = TRUE, 10 | split = nGenSplit, 11 | species = "MAIZE") 12 | 13 | # Set simulation parameters 14 | SP = SimParam$new(founderPop) 15 | 16 | # Add SNP chip 17 | SP$restrSegSites(nQtl,nSnp) 18 | if (nSnp > 0) { 19 | SP$addSnpChip(nSnp) 20 | } 21 | 22 | # Add traits: trait represents yield 23 | SP$addTraitADG(nQtlPerChr = nQtl, 24 | mean = initMeanG, 25 | var = initVarG, 26 | meanDD = MeanDD, 27 | varDD = VarDD, 28 | varGxE = initVarGE) 29 | # Set permanent yield trial error variance 30 | SP$setVarE(varE = VarE) 31 | 32 | # Split heterotic pools to form initial parents 33 | FemaleParents = newPop(founderPop[1:nParents]) 34 | MaleParents = newPop(founderPop[(nParents+1):(nParents*2)]) 35 | 36 | # Set hybrid parents for later yield trials 37 | MaleElite = selectInd(MaleParents, nElite, use = "gv") 38 | FemaleElite = selectInd(FemaleParents, nElite, use = "gv") 39 | 40 | # Reverse order to keep best parent in longer 41 | MaleElite = MaleElite[nElite:1] 42 | FemaleElite = FemaleElite[nElite:1] 43 | 44 | # Set initial testers for YT1 and YT2 45 | # Requires nTesters to be smaller than nElite 46 | MaleTester1 = MaleElite[1:nTester1] 47 | FemaleTester1 = FemaleElite[1:nTester1] 48 | MaleTester2 = MaleElite[1:nTester2] 49 | FemaleTester2 = FemaleElite[1:nTester2] 50 | rm(founderPop) 51 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 900, res = 150) # Higher resolution 16 | par(mfrow = c(3, 2), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Inbred Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_inbred, ncol = max(df$rep))), 20 | "Inbred genetic gain", "Year", "Yield") 21 | 22 | # Hybrid Genetic Gain 23 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_hybrid, ncol = max(df$rep))), 24 | "Hybrid genetic gain", "Year", "Yield") 25 | 26 | # Inbred Variance 27 | plot_results(1:nCycles, rowMeans(matrix(df$varG_inbred, ncol = max(df$rep))), 28 | "Inbred genetic variance", "Year", "Variance") 29 | 30 | # Hybrid Variance 31 | plot_results(1:nCycles, rowMeans(matrix(df$varG_hybrid, ncol = max(df$rep))), 32 | "Hybrid genetic variance", "Year", "Variance") 33 | 34 | # Selection accuracy 35 | plot_results(1:nCycles, rowMeans(matrix(df$acc_sel, ncol = max(df$rep))), 36 | "Selection accuracy", "Year", "Accuracy") 37 | 38 | # Correlation 39 | plot_results(1:nCycles, rowMeans(matrix(df$cor, ncol = max(df$rep))), 40 | "Inbred vs. hybrid yield cor.", "Year", "Correlation") 41 | 42 | dev.off() 43 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | 7 | # Plotting function 8 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 9 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 10 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 11 | if (!is.null(extra_plot_func)) extra_plot_func() 12 | } 13 | 14 | # Plot 15 | png("Results.png", height = 1200, width = 900, res = 150) # Higher resolution 16 | par(mfrow = c(3, 2), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 17 | 18 | # Inbred Genetic Gain 19 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_inbred, ncol = max(df$rep))), 20 | "Inbred genetic gain", "Year", "Yield") 21 | 22 | # Hybrid Genetic Gain 23 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_hybrid, ncol = max(df$rep))), 24 | "Hybrid genetic gain", "Year", "Yield") 25 | 26 | # Inbred Variance 27 | plot_results(1:nCycles, rowMeans(matrix(df$varG_inbred, ncol = max(df$rep))), 28 | "Inbred genetic variance", "Year", "Variance") 29 | 30 | # Hybrid Variance 31 | plot_results(1:nCycles, rowMeans(matrix(df$varG_hybrid, ncol = max(df$rep))), 32 | "Hybrid genetic variance", "Year", "Variance") 33 | 34 | # Selection accuracy 35 | plot_results(1:nCycles, rowMeans(matrix(df$acc_sel, ncol = max(df$rep))), 36 | "Selection accuracy", "Year", "Accuracy") 37 | 38 | # Correlation 39 | plot_results(1:nCycles, rowMeans(matrix(df$cor, ncol = max(df$rep))), 40 | "Inbred vs. hybrid yield cor.", "Year", "Correlation") 41 | 42 | dev.off() 43 | -------------------------------------------------------------------------------- /04_Features/genomeEditing.R: -------------------------------------------------------------------------------- 1 | # Script name: Genome editing in AlphaSimR 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates editing of a single locus in AlphaSimR. 8 | 9 | # ---- Clean environment and load packages ---- 10 | 11 | rm(list = ls()) 12 | # install.packages(pkgs = "AlphaSimR") 13 | library(package = "AlphaSimR") 14 | 15 | # ---- Setup simulation ---- 16 | 17 | # Generate founder haplotypes 18 | founderPop = runMacs(nInd = 100, 19 | segSites = 1000, 20 | inbred = TRUE, 21 | species = "WHEAT") 22 | 23 | # Set simulation parameters 24 | SP = SimParam$new(founderPop) 25 | 26 | # Create additive trait with 10 QTLs 27 | SP$addTraitAG(nQtlPerChr = 10, 28 | mean = 1, 29 | var = 1) 30 | 31 | # Create population 32 | pop = newPop(founderPop) 33 | 34 | # Check genetic values 35 | meanG(pop) 36 | 37 | # Get QTL haplotypes 38 | genMap = pullQtlHaplo(pop) 39 | 40 | # ---- Option 1: Edit single locus in an individual ---- 41 | 42 | # To change a single locus you can do the following, which changes 43 | # the first homologue in individual 1 to its alternative allele 44 | genMap["1_1",1] = (genMap["1_1", 1] + 1) %% 2 45 | 46 | # Or you can manually edit the first QTL on the first homologue to be 1 47 | for(i in 1:pop@nInd) { 48 | genMap[paste0(i,"_1"), colnames(genMap)[1]] = 1 49 | } 50 | # Re-assign haplotypes 51 | pop2 = setMarkerHaplo(pop, genMap) 52 | # Check genetic mean 53 | meanG(pop2) 54 | 55 | # ---- Option 2: Edit single locus in the entire population ---- 56 | 57 | # Edit QTL with largest additive effect using internal function 58 | pop3 = editGenomeTopQtl(pop, ind = 100, nQtl = 1) 59 | # Check genetic mean 60 | meanG(pop3) 61 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Save pedPop records and training population for GS from year 35 2 | 3 | ACT5@fixEff <- as.integer(rep(year,nInd(ACT5))) 4 | ECT6@fixEff <- as.integer(rep(year,nInd(ECT6))) 5 | 6 | if(year == startRecords) { 7 | trainPop = ECT6 8 | pedPop = data.frame(Ind = c(ACT5@id), 9 | Sire = c(ACT5@father), 10 | Dam = c(ACT5@mother), 11 | Year = year, 12 | Stage = c(rep("ACT5",ACT5@nInd)), 13 | Pheno = c(ACT5@pheno), 14 | GV = c(ACT5@gv)) 15 | } 16 | 17 | if (year > startRecords & year < nBurnin+1) { 18 | trainPop = c(trainPop,ECT6) 19 | pedPop = rbind(pedPop, 20 | data.frame(Ind = c(ACT5@id), 21 | Sire = c(ACT5@father), 22 | Dam = c(ACT5@mother), 23 | Year = year, 24 | Stage = c(rep("ACT5",ACT5@nInd)), 25 | Pheno = c(ACT5@pheno), 26 | GV = c(ACT5@gv))) 27 | } 28 | 29 | if (year > nBurnin) { 30 | # Update training population (set to keep 6 years worth of records) 31 | remove = table(trainPop@fixEff)[1] # remove oldest records 32 | trainPop = c(trainPop[-c(1:remove)], ECT6) # add new records 33 | 34 | # Update pedPop with new records from ACT stage 35 | pedPop = rbind(pedPop, 36 | data.frame(Ind = c(ACT5@id), 37 | Sire = c(ACT5@father), 38 | Dam = c(ACT5@mother), 39 | Year = year, 40 | Stage = c(rep("ACT",ACT5@nInd)), 41 | Pheno = c(ACT5@pheno), 42 | GV = c(ACT5@gv))) 43 | } 44 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/StoreTrainPop.R: -------------------------------------------------------------------------------- 1 | # Save pedPop records and training population for GS from year 35 2 | 3 | ACT5@fixEff <- as.integer(rep(year,nInd(ACT5))) 4 | ECT6@fixEff <- as.integer(rep(year,nInd(ECT6))) 5 | 6 | if(year == startRecords) { 7 | trainPop = ECT6 8 | pedPop = data.frame(Ind = c(ACT5@id), 9 | Sire = c(ACT5@father), 10 | Dam = c(ACT5@mother), 11 | Year = year, 12 | Stage = c(rep("ACT5",ACT5@nInd)), 13 | Pheno = c(ACT5@pheno), 14 | GV = c(ACT5@gv)) 15 | } 16 | 17 | if (year > startRecords & year < nBurnin+1) { 18 | trainPop = c(trainPop,ECT6) 19 | pedPop = rbind(pedPop, 20 | data.frame(Ind = c(ACT5@id), 21 | Sire = c(ACT5@father), 22 | Dam = c(ACT5@mother), 23 | Year = year, 24 | Stage = c(rep("ACT5",ACT5@nInd)), 25 | Pheno = c(ACT5@pheno), 26 | GV = c(ACT5@gv))) 27 | } 28 | 29 | if (year > nBurnin) { 30 | # Update training population (set to keep 6 years worth of records) 31 | remove = table(trainPop@fixEff)[1] # remove oldest records 32 | trainPop = c(trainPop[-c(1:remove)], ECT6) # add new records 33 | 34 | # Update pedPop with new records from ACT stage 35 | pedPop = rbind(pedPop, 36 | data.frame(Ind = c(ACT5@id), 37 | Sire = c(ACT5@father), 38 | Dam = c(ACT5@mother), 39 | Year = year, 40 | Stage = c(rep("ACT",ACT5@nInd)), 41 | Pheno = c(ACT5@pheno), 42 | GV = c(ACT5@gv))) 43 | } 44 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 16 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 300 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | nGenSplit = 100 # Heterotic pool split 15 | 16 | # ---- Initial inbred parents mean and variance ---- 17 | initMeanG = 70 # bushels per acre 18 | initVarG = 20 # bushels per acre 19 | # Degree of dominance 20 | MeanDD = 0.92 # mean 21 | VarDD = 0.3 # variance 22 | # Error variances 23 | initVarGE = 40 # Genotype-by-year interaction 24 | VarE = 270 # Yield trial error variance, bushels per acre 25 | # Relates to error variance for an entry mean 26 | 27 | # ---- Breeding program details ---- 28 | nParents = 50 # Number of parents to start a breeding cycle 29 | nCrosses = 80 # Number of crosses per year 30 | famMax = 15 # The maximum number of DH lines per cross 31 | nDH = 50 # DH lines produced per cross 32 | 33 | # Effective replication of yield trials 34 | repYT1 = 1 #h2 = 0.06 35 | repYT2 = 2 #h2 = 0.11 36 | repYT3 = 4 #h2 = 0.20 37 | repYT4 = 8 #h2 = 0.34 38 | repYT5 = 100 #h2 = 0.86 39 | 40 | # ----Selection on GCA ---- 41 | # Number of inbreds per heterotic pool per stage 42 | nInbred1 = nCrosses*nDH #Do not change 43 | nInbred2 = 400 44 | nInbred3 = 40 45 | 46 | # Number of testers per heterotic pool per stage 47 | # Values must be smaller than nElite 48 | nTester1 = 1 49 | nTester2 = 3 50 | 51 | # Yield trial entries 52 | nYT1 = nInbred1*nTester1 #Do not change 53 | nYT2 = nInbred2*nTester2 #Do not change 54 | 55 | # ---- Selection on SCA ---- 56 | 57 | # Elite parents per heterotic pool 58 | nElite = 5 59 | 60 | # Elite YT size 61 | nYT3 = nInbred3*nElite #Do not change 62 | nYT4 = 20 63 | nYT5 = 4 64 | 65 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 18 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 300 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | nGenSplit = 100 # Heterotic pool split 15 | 16 | # ---- Initial inbred parents mean and variance ---- 17 | initMeanG = 70 # bushels per acre 18 | initVarG = 20 # bushels per acre 19 | # Degree of dominance 20 | MeanDD = 0.92 # mean 21 | VarDD = 0.3 # variance 22 | # Error variances 23 | initVarGE = 40 # Genotype-by-year interaction 24 | VarE = 270 # Yield trial error variance, bushels per acre 25 | # Relates to error variance for an entry mean 26 | 27 | # ---- Breeding program details ---- 28 | nParents = 50 # Number of parents to start a breeding cycle 29 | nCrosses = 80 # Number of crosses per year 30 | famMax = 15 # The maximum number of DH lines per cross 31 | nDH = 50 # DH lines produced per cross 32 | 33 | # Effective replication of yield trials 34 | repYT1 = 1 #h2 = 0.06 35 | repYT2 = 2 #h2 = 0.11 36 | repYT3 = 4 #h2 = 0.20 37 | repYT4 = 8 #h2 = 0.34 38 | repYT5 = 100 #h2 = 0.86 39 | 40 | # ----Selection on GCA ---- 41 | # Number of inbreds per heterotic pool per stage 42 | nInbred1 = nCrosses*nDH #Do not change 43 | nInbred2 = 400 44 | nInbred3 = 40 45 | 46 | # Number of testers per heterotic pool per stage 47 | # Values must be smaller than nElite 48 | nTester1 = 1 49 | nTester2 = 3 50 | 51 | # Yield trial entries 52 | nYT1 = nInbred1*nTester1 #Do not change 53 | nYT2 = nInbred2*nTester2 #Do not change 54 | 55 | # ---- Selection on SCA ---- 56 | 57 | # Elite parents per heterotic pool 58 | nElite = 5 59 | 60 | # Elite YT size 61 | nYT3 = nInbred3*nElite #Do not change 62 | nYT4 = 20 63 | nYT5 = 4 64 | 65 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/GlobalParameters.R: -------------------------------------------------------------------------------- 1 | # Global Parameters 2 | 3 | # ---- Number of simulation replications and breeding cycles ---- 4 | nReps = 1 # Number of simulation replicates 5 | nBurnin = 20 # Number of years in burnin phase 6 | nFuture = 20 # Number of years in future phase 7 | nCycles = nBurnin + nFuture 8 | startTP = 18 # Year to start training population 9 | 10 | # ---- Genome simulation ---- 11 | nChr = 15 # Number of chromosomes 12 | nQtl = 300 # Number of QTL per chromosome 13 | nSnp = 400 # Number of SNP per chromosome 14 | nGenSplit = 100 # Heterotic pool split 15 | 16 | # ---- Initial inbred parents mean and variance ---- 17 | initMeanG = 70 # bushels per acre 18 | initVarG = 20 # bushels per acre 19 | # Degree of dominance 20 | MeanDD = 0.92 # mean 21 | VarDD = 0.3 # variance 22 | # Error variances 23 | initVarGE = 40 # Genotype-by-year interaction 24 | VarE = 270 # Yield trial error variance, bushels per acre 25 | # Relates to error variance for an entry mean 26 | 27 | # ---- Breeding program details ---- 28 | nParents = 50 # Number of parents to start a breeding cycle 29 | nCrosses = 80 # Number of crosses per year 30 | famMax = 15 # The maximum number of DH lines per cross 31 | nDH = 50 # DH lines produced per cross 32 | 33 | # Effective replication of yield trials 34 | repYT1 = 1 #h2 = 0.06 35 | repYT2 = 2 #h2 = 0.11 36 | repYT3 = 4 #h2 = 0.20 37 | repYT4 = 8 #h2 = 0.34 38 | repYT5 = 100 #h2 = 0.86 39 | 40 | # ----Selection on GCA ---- 41 | # Number of inbreds per heterotic pool per stage 42 | nInbred1 = nCrosses*nDH #Do not change 43 | nInbred2 = 400 44 | nInbred3 = 40 45 | 46 | # Number of testers per heterotic pool per stage 47 | # Values must be smaller than nElite 48 | nTester1 = 1 49 | nTester2 = 3 50 | 51 | # Yield trial entries 52 | nYT1 = nInbred1*nTester1 #Do not change 53 | nYT2 = nInbred2*nTester2 #Do not change 54 | 55 | # ---- Selection on SCA ---- 56 | 57 | # Elite parents per heterotic pool 58 | nElite = 5 59 | 60 | # Elite YT size 61 | nYT3 = nInbred3*nElite #Do not change 62 | nYT4 = 20 63 | nYT5 = 4 64 | 65 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | #Set initial yield trials with unique individuals 3 | 4 | # Sample year effects 5 | P = runif(16) 6 | 7 | # Breeding program 8 | for(cohort in 1:16) { 9 | cat(" FillPipeline stage:",cohort,"of 16\n") 10 | # Stage 1 Crossing block 11 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 12 | if(cohort < 16){ 13 | # Stage 2 Germinate the seedlings in the nursery 14 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[cohort]) 15 | } 16 | if(cohort < 15){ 17 | # Stage 3 Plant in the seedlings in the field as HPT and record yields 18 | HPT1 = Seedlings 19 | } 20 | if(cohort < 14){ 21 | # Stage 4 Record the HPT yields 22 | HPT2 = HPT1 23 | } 24 | if(cohort < 13){ 25 | # Stage 5 Record the HPT yields 26 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[cohort+3L]) 27 | } 28 | if(cohort < 12){ 29 | # Stage 6 Select 500 superior individuals and plant as advanced clonal trials (ACT) 30 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 31 | } 32 | if(cohort < 11){ 33 | # Stage 7 Record ACT yields 34 | ACT2 = ACT1 35 | } 36 | if(cohort < 10){ 37 | # Stage 8 Record ACT yields 38 | ACT3 = ACT2 39 | } 40 | if(cohort < 9){ 41 | # Stage 9 Record ACT yields 42 | ACT4 = ACT3 43 | } 44 | if(cohort < 8){ 45 | # Stage 10 Record ACT yields 46 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[cohort+8L]) 47 | } 48 | if(cohort < 7){ 49 | # Stage 11 Select 30 superior individuals and plant as elite clonal trials (ECT) 50 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 51 | } 52 | if(cohort < 6){ 53 | # Stage 12 Record ECT yields 54 | ECT2 = ECT1 55 | } 56 | if(cohort < 5){ 57 | # Stage 13 Record ECT yields 58 | ECT3 = ECT2 59 | } 60 | if(cohort < 4){ 61 | # Stage 14 Record ECT yields 62 | ECT4 = ECT3 63 | } 64 | if(cohort < 3){ 65 | # Stage 15 Record ECT yields 66 | ECT5 = ECT4 67 | } 68 | if(cohort < 2){ 69 | # Stage 16 Record ECT yields 70 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[cohort+14L]) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | #Set initial yield trials with unique individuals 4 | 5 | # Sample year effects 6 | P = runif(16) 7 | 8 | # Breeding program 9 | for(cohort in 1:16) { 10 | cat(" FillPipeline year:",cohort,"of 16\n") 11 | # Stage 1 Crossing block 12 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 13 | if(cohort < 16){ 14 | # Stage 2 Germinate the seedlings in the nursery 15 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[cohort]) 16 | } 17 | if(cohort < 15){ 18 | # Stage 3 Plant in the seedlings in the field as HPT and record yields 19 | HPT1 = Seedlings 20 | } 21 | if(cohort < 14){ 22 | # Stage 4 Record the HPT yields 23 | HPT2 = HPT1 24 | } 25 | if(cohort < 13){ 26 | # Stage 5 Record the HPT yields 27 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[cohort+3L]) 28 | } 29 | if(cohort < 12){ 30 | # Stage 6 Select 500 superior individuals and plant as advanced clonal trials (ACT) 31 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 32 | } 33 | if(cohort < 11){ 34 | # Stage 7 Record ACT yields 35 | ACT2 = ACT1 36 | } 37 | if(cohort < 10){ 38 | # Stage 8 Record ACT yields 39 | ACT3 = ACT2 40 | } 41 | if(cohort < 9){ 42 | # Stage 9 Record ACT yields 43 | ACT4 = ACT3 44 | } 45 | if(cohort < 8){ 46 | # Stage 10 Record ACT yields 47 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[cohort+8L]) 48 | } 49 | if(cohort < 7){ 50 | # Stage 11 Select 30 superior individuals and plant as elite clonal trials (ECT) 51 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 52 | } 53 | if(cohort < 6){ 54 | # Stage 12 Record ECT yields 55 | ECT2 = ECT1 56 | } 57 | if(cohort < 5){ 58 | # Stage 13 Record ECT yields 59 | ECT3 = ECT2 60 | } 61 | if(cohort < 4){ 62 | # Stage 14 Record ECT yields 63 | ECT4 = ECT3 64 | } 65 | if(cohort < 3){ 66 | # Stage 15 Record ECT yields 67 | ECT5 = ECT4 68 | } 69 | if(cohort < 2){ 70 | # Stage 16 Record ECT yields 71 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[cohort+14L]) 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | cat(" Advancing year \n") 4 | # Advance breeding program by 1 year 5 | # Works backwards through pipeline to avoid copying data 6 | 7 | # Stage 7 8 | # Release hybrid 9 | 10 | 11 | # Stage 6 12 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 13 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 14 | 15 | MaleHybridYT5 = setPheno(MaleHybridYT5, reps = repYT5, p = p) 16 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, reps = repYT5, p = p) 17 | 18 | MaleInbredYT5 = 19 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 20 | FemaleInbredYT5 = 21 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 22 | 23 | 24 | # Stage 5 25 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 26 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 27 | 28 | MaleHybridYT4 = setPheno(MaleHybridYT4, reps = repYT4, p = p) 29 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, reps = repYT4, p = p) 30 | 31 | MaleInbredYT4 = 32 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 33 | FemaleInbredYT4 = 34 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 35 | 36 | 37 | # Stage 4 38 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 39 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 40 | 41 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 42 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 43 | 44 | MaleHybridYT3 = setPheno(MaleHybridYT3, reps = repYT3, p = p) 45 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, reps = repYT3, p = p) 46 | 47 | 48 | # Stage 3 49 | MaleYT2 = selectInd(MaleYT1, nInbred2) 50 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 51 | 52 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, reps = repYT2, inbred = T, p = p) 53 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, reps = repYT2, inbred = T, p = p) 54 | 55 | 56 | # Stage 2 57 | MaleDH = makeDH(MaleF1, nDH) 58 | FemaleDH = makeDH(FemaleF1, nDH) 59 | 60 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, reps = repYT1, inbred = T, p = p) 61 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, reps = repYT1, inbred = T, p = p) 62 | 63 | 64 | # Stage 1 65 | MaleF1 = randCross(MaleParents, nCrosses) 66 | FemaleF1 = randCross(FemaleParents, nCrosses) 67 | 68 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | 5 | # Sample year effects 6 | P = runif(16) 7 | 8 | # Breeding program 9 | for(cohort in 1:16) { 10 | cat(" FillPipeline stage:",cohort,"of 16\n") 11 | # Stage 1 Crossing block 12 | F1 = randCross(Parents, nCrosses = nCrosses, nProgeny = nProgeny) 13 | if(cohort < 16){ 14 | # Stage 2 Germinate the seedlings in the nursery 15 | Seedlings = setPheno(F1, varE = VarE, reps = repHPT, p = P[cohort]) 16 | } 17 | if(cohort < 15){ 18 | # Stage 3 Plant in the seedlings in the field as HPT and record yields 19 | HPT1 = Seedlings 20 | } 21 | if(cohort < 14){ 22 | # Stage 4 Record the HPT yields 23 | HPT2 = HPT1 24 | } 25 | if(cohort < 13){ 26 | # Stage 5 Record the HPT yields 27 | HPT3 = setPheno(HPT2, varE = VarE, reps = repHPT, p = P[cohort+3L]) 28 | } 29 | if(cohort < 12){ 30 | # Stage 6 Select 500 superior individuals and plant as advanced clonal trials (ACT) 31 | ACT1 = selectInd(HPT3, nInd = nClonesACT, use = "pheno") 32 | } 33 | if(cohort < 11){ 34 | # Stage 7 Record ACT yields 35 | ACT2 = ACT1 36 | } 37 | if(cohort < 10){ 38 | # Stage 8 Record ACT yields 39 | ACT3 = ACT2 40 | } 41 | if(cohort < 9){ 42 | # Stage 9 Record ACT yields 43 | ACT4 = ACT3 44 | } 45 | if(cohort < 8){ 46 | # Stage 10 Record ACT yields 47 | ACT5 = setPheno(ACT4, varE = VarE, reps = repACT, p = P[cohort+8L]) 48 | } 49 | if(cohort < 7){ 50 | # Stage 11 Select 30 superior individuals and plant as elite clonal trials (ECT) 51 | ECT1 = selectInd(ACT5, nInd = nClonesECT, use = "pheno") 52 | } 53 | if(cohort < 6){ 54 | # Stage 12 Record ECT yields 55 | ECT2 = ECT1 56 | } 57 | if(cohort < 5){ 58 | # Stage 13 Record ECT yields 59 | ECT3 = ECT2 60 | } 61 | if(cohort < 4){ 62 | # Stage 14 Record ECT yields 63 | ECT4 = ECT3 64 | } 65 | if(cohort < 3){ 66 | # Stage 15 Record ECT yields 67 | ECT5 = ECT4 68 | } 69 | if(cohort < 2){ 70 | # Stage 16 Record ECT yields 71 | ECT6 = setPheno(ECT5, varE = VarE, reps = repECT, p = P[cohort+14L]) 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /04_Features/speedBreeding.R: -------------------------------------------------------------------------------- 1 | # Script name: Speed breeding 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates speed breeding of plants in a glasshouse 8 | # using AlphaSimR. 9 | 10 | # ---- Clean environment and load packages ---- 11 | 12 | rm(list = ls()) 13 | # install.packages(pkgs = "AlphaSimR") 14 | library(package = "AlphaSimR") 15 | 16 | # ---- Setup simulation ---- 17 | 18 | # Generate founder haplotypes 19 | founderPop = runMacs( 20 | nInd = 100, 21 | segSites = 1000, 22 | inbred = TRUE, 23 | species = "WHEAT" 24 | ) 25 | 26 | # Set simulation parameters 27 | SP = SimParam$new(founderPop) 28 | 29 | # Create additive trait with 10 QTLs 30 | SP$addTraitAG(nQtlPerChr = 10, 31 | mean = 0, 32 | var = 1) 33 | 34 | # Create population 35 | pop = newPop(founderPop) 36 | 37 | # ---- Example 1: 20 years of breeding without speed breeding ---- 38 | 39 | pop2 = pop 40 | mean = vector() 41 | mean[1] = meanG(pop2) 42 | # Each year make 100 crosses, grow individuals in field trials, 43 | # and advance 50 44 | for (year in 1:10) { 45 | pop2 = setPheno(pop2, h2 = 0.5) 46 | pop2 = selectCross(pop2, nInd = 50, nCrosses = 100) 47 | mean[year + 1] = meanG(pop2) 48 | } 49 | 50 | # ---- Example 2: 10 years of breeding with 4 cycles of speed breeding ---- 51 | 52 | pop3 = pop 53 | mean2 = vector() 54 | mean2[1] = meanG(pop3) 55 | for (year in 1:10) { 56 | for (speedCyc in 1:4) { 57 | # Grow individuals in greenhouse and advance 50 58 | # Assume accuracy of selection 0.3 59 | pop3 = setPheno(pop3, h2 = 0.3) 60 | pop3 = selectCross(pop3, nInd = 50, nCrosses = 100) 61 | } 62 | # Grow individuals in field trials and advance 50 63 | pop3 = setPheno(pop3, h2 = 0.5) 64 | pop3 = selectInd(pop3, nInd = 50) 65 | mean2[year + 1] = meanG(pop3) 66 | } 67 | 68 | # ---- Compare two breeding scenarios ---- 69 | 70 | require(ggplot2) 71 | df <- data.frame( 72 | Year = 0:10, 73 | Scenario = c(rep("Conv", 11), rep("Speed", 11)), 74 | Pheno = c(mean, mean2) 75 | ) 76 | 77 | ggplot(df, aes(x = Year, y = Pheno)) + 78 | geom_line(aes(color = Scenario), linewidth = 0.8) 79 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/01_MassSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic mass selection 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | 7 | # ---- Clean environment and load packages ---- 8 | rm(list = ls()) 9 | # install.packages(pkgs = "AlphaSimR") 10 | library(package = "AlphaSimR") 11 | 12 | # ---- Load global parameters ---- 13 | source(file = "GlobalParameters.R") 14 | scenarioName = "MassSelection" 15 | 16 | # ---- Create list to store results from reps ---- 17 | results = list() 18 | 19 | for(REP in 1:nReps) { 20 | cat("Working on REP:", REP,"\n") 21 | 22 | # ---- Create a data frame to track key parameters ---- 23 | output = data.frame(year = 1:nCycles, 24 | rep = rep(REP, nCycles), 25 | scenario = rep(scenarioName, nCycles), 26 | meanG = numeric(nCycles), 27 | varG = numeric(nCycles), 28 | accSel = numeric(nCycles)) 29 | 30 | # ---- Create initial parents ---- 31 | source(file = "CreateParents.R") 32 | 33 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 34 | source(file = "FillPipeline.R") 35 | 36 | # ---- Burn-in phase ---- 37 | for(year in 1:nBurnin) { 38 | cat(" Working on burn-in year:",year,"\n") 39 | source(file = "UpdateParents.R") # Pick parents 40 | source(file = "AdvanceYear.R") # Advances yield trials by a year 41 | # Report results 42 | output$meanG[year] = meanG(F1) 43 | output$varG[year] = varG(F1) 44 | } 45 | 46 | # ---- Future phase ---- 47 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 48 | cat(" Working on future year:",year,"\n") 49 | source(file = "UpdateParents.R") # Pick parents 50 | source(file = "AdvanceYear.R") # Advances yield trials by a year 51 | # Report results 52 | output$meanG[year] = meanG(F1) 53 | output$varG[year] = varG(F1) 54 | } 55 | 56 | # ---- Save results from current replicate ---- 57 | results = append(results, list(output)) 58 | } 59 | 60 | # ---- Save results ---- 61 | saveRDS(results, file = paste0(scenarioName, ".rds")) 62 | 63 | # ---- Analyze results ---- 64 | source(file = "ANALYZERESULTS.R") 65 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/ANALYZERESULTS.R: -------------------------------------------------------------------------------- 1 | # install.packages(pkgs = "dplyr") 2 | library(package = "dplyr") 3 | 4 | # Read in results 5 | df <- bind_rows(readRDS(paste0(scenarioName,".rds"))) 6 | df2 <- bind_rows(readRDS(paste0(scenarioName,"_accPI.rds"))) 7 | 8 | # Plotting function 9 | plot_results <- function(x, y, main, xlab, ylab, ylim = NULL, extra_plot_func = NULL) { 10 | plot(x, y, type = "l", main = main, xlab = xlab, ylab = ylab, col = "blue", lwd = 2, ylim = ylim) 11 | grid(nx = NA, ny = NULL, lty = 6, col = "gray90") 12 | if (!is.null(extra_plot_func)) extra_plot_func() 13 | } 14 | 15 | # Plot 16 | png("Results.png", height = 1600, width = 900, res = 150) # Higher resolution 17 | par(mfrow = c(4, 2), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) 18 | 19 | # Inbred Genetic Gain 20 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_inbred, ncol = max(df$rep))), 21 | "Inbred genetic gain", "Year", "Yield") 22 | 23 | # Hybrid Genetic Gain 24 | plot_results(1:nCycles, rowMeans(matrix(df$meanG_hybrid, ncol = max(df$rep))), 25 | "Hybrid genetic gain", "Year", "Yield") 26 | 27 | # Inbred Variance 28 | plot_results(1:nCycles, rowMeans(matrix(df$varG_inbred, ncol = max(df$rep))), 29 | "Inbred genetic variance", "Year", "Variance") 30 | 31 | # Hybrid Variance 32 | plot_results(1:nCycles, rowMeans(matrix(df$varG_hybrid, ncol = max(df$rep))), 33 | "Hybrid genetic variance", "Year", "Variance") 34 | 35 | # Selection accuracy in Product Development 36 | plot_results(1:nCycles, rowMeans(matrix(df$acc_sel, ncol = max(df$rep))), 37 | "Selection accuracy in Product Development", "Year", "Accuracy") 38 | 39 | # Selection accuracy in Population Improvement 40 | plot_results(1:nCycles, rowMeans(matrix(df2$accPI, ncol = max(df$rep))), 41 | "Selection accuracy in Population Improvement", "Cycle", "Accuracy", 42 | extra_plot_func = function() { 43 | axis(1, at = seq(0, nCycles, 10), labels = seq(0, 20, 5)) 44 | abline(v = seq(1, 41, 2), col = "gray80", lty = 2) 45 | }) 46 | 47 | # Correlation 48 | plot_results(1:nCycles, rowMeans(matrix(df$cor, ncol = max(df$rep))), 49 | "Inbred vs. hybrid yield cor.", "Year", "Correlation") 50 | 51 | dev.off() 52 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/02_SingleSeedDescent/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic line breeding program with selfing 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | 7 | # ---- Clean environment and load packages ---- 8 | rm(list = ls()) 9 | # install.packages(pkgs = "AlphaSimR") 10 | library(package = "AlphaSimR") 11 | 12 | # ---- Load global parameters ---- 13 | source(file = "GlobalParameters.R") 14 | scenarioName = "LinePheno_SSD" 15 | 16 | # ---- Create list to store results from reps ---- 17 | results = list() 18 | 19 | for(REP in 1:nReps) { 20 | cat("Working on REP:", REP,"\n") 21 | 22 | # ---- Create a data frame to track key parameters ---- 23 | output = data.frame(year = 1:nCycles, 24 | rep = rep(REP, nCycles), 25 | scenario = rep(scenarioName, nCycles), 26 | meanG = numeric(nCycles), 27 | varG = numeric(nCycles), 28 | accSel = numeric(nCycles)) 29 | 30 | # ---- Create initial parents ---- 31 | source(file = "CreateParents.R") 32 | 33 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 34 | source(file = "FillPipeline.R") 35 | 36 | # ---- Burn-in phase ---- 37 | for(year in 1:nBurnin) 38 | { 39 | cat(" Working on burn-in year:",year,"\n") 40 | source(file = "UpdateParents.R") # Pick parents 41 | source(file = "AdvanceYear.R") # Advances yield trials by a year 42 | # Report results 43 | output$meanG[year] = meanG(S4) 44 | output$varG[year] = varG(S4) 45 | } 46 | 47 | # ---- Future phase ---- 48 | for(year in (nBurnin+1):(nBurnin+nFuture)) 49 | { 50 | cat(" Working on future year:",year,"\n") 51 | source(file = "UpdateParents.R") # Pick parents 52 | source(file = "AdvanceYear.R") # Advances yield trials by a year 53 | # Report results 54 | output$meanG[year] = meanG(S4) 55 | output$varG[year] = varG(S4) 56 | } 57 | 58 | # Save results from current replicate 59 | results = append(results, list(output)) 60 | } 61 | 62 | # Save results 63 | saveRDS(results, file = paste0(scenarioName,".rds")) 64 | 65 | # ---- Analyze results ---- 66 | source(file = "ANALYZERESULTS.R") 67 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # Advance year 3 | #----------------------------------------------------------------------- 4 | cat(" Advancing year \n") 5 | # Advance breeding program by 1 year 6 | # Works backwards through pipeline to avoid copying data 7 | 8 | ## Stage 7 9 | #Release hybrid 10 | 11 | ## Stage 6 12 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 13 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 14 | 15 | MaleHybridYT5 = setPheno(MaleHybridYT5, reps = repYT5, p = p) 16 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, reps = repYT5, p = p) 17 | 18 | MaleInbredYT5 = 19 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 20 | FemaleInbredYT5 = 21 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 22 | 23 | ## Stage 5 24 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 25 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 26 | 27 | MaleHybridYT4 = setPheno(MaleHybridYT4, reps = repYT4, p = p) 28 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, reps = repYT4, p = p) 29 | 30 | MaleInbredYT4 = 31 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 32 | FemaleInbredYT4 = 33 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 34 | 35 | ## Stage 4 36 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 37 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 38 | 39 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 40 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 41 | 42 | MaleHybridYT3 = setPheno(MaleHybridYT3, reps = repYT3, p = p) 43 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, reps = repYT3, p = p) 44 | 45 | ## Stage 3 46 | MaleYT2 = selectInd(MaleYT1, nInbred2) 47 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 48 | 49 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, reps = repYT2, inbred = T, p = p) 50 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, reps = repYT2, inbred = T, p = p) 51 | 52 | ## Stage 2 53 | MaleDH = makeDH(MaleF1, nDH) 54 | FemaleDH = makeDH(FemaleF1, nDH) 55 | 56 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, reps = repYT1, inbred = T, p = p) 57 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, reps = repYT1, inbred = T, p = p) 58 | 59 | ## Stage 1 60 | MaleF1 = randCross(MaleParents, nCrosses) 61 | FemaleF1 = randCross(FemaleParents, nCrosses) 62 | 63 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic line breeding program with pedigree selection 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | 7 | # ---- Clean environment and load packages ---- 8 | rm(list = ls()) 9 | # install.packages(pkgs = "AlphaSimR") 10 | library(package = "AlphaSimR") 11 | source(file = "ExtraFunctions.R") 12 | 13 | # ---- Load global parameters ---- 14 | source(file = "GlobalParameters.R") 15 | scenarioName = "LinePheno_pedigree" 16 | 17 | # ---- Create list to store results from reps ---- 18 | results = list() 19 | 20 | for(REP in 1:nReps) { 21 | cat("Working on REP:", REP,"\n") 22 | 23 | # ---- Create a data frame to track key parameters ---- 24 | output = data.frame(year = 1:nCycles, 25 | rep = rep(REP, nCycles), 26 | scenario = rep(scenarioName, nCycles), 27 | meanG = numeric(nCycles), 28 | varG = numeric(nCycles), 29 | accSel = numeric(nCycles)) 30 | 31 | # ---- Create initial parents ---- 32 | source(file = "CreateParents.R") 33 | 34 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 35 | source(file = "FillPipeline.R") 36 | 37 | # ---- Burn-in phase ---- 38 | for(year in 1:nBurnin) { 39 | cat(" Working on burn-in year:",year,"\n") 40 | source(file = "UpdateParents.R") # Pick parents 41 | source(file = "AdvanceYear.R") # Advances yield trials by a year 42 | # Report results 43 | output$meanG[year] = meanG(mergePops(F2)) 44 | output$varG[year] = varG(mergePops(F2)) 45 | } 46 | 47 | # ---- Future phase ---- 48 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 49 | cat(" Working on future year:",year,"\n") 50 | source(file = "UpdateParents.R") # Pick parents 51 | source(file = "AdvanceYear.R") # Advances yield trials by a year 52 | ## Report results 53 | output$meanG[year] = meanG(mergePops(F2)) 54 | output$varG[year] = varG(mergePops(F2)) 55 | } 56 | 57 | ## Save results from current replicate 58 | results = append(results, list(output)) 59 | } 60 | 61 | # Save results 62 | saveRDS(results, file = paste0(scenarioName,".rds")) 63 | 64 | # ---- Analyze results ---- 65 | source(file = "ANALYZERESULTS.R") 66 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | cat(" Advancing year \n") 4 | # Advance breeding program by 1 year 5 | # Works backwards through pipeline to avoid copying data 6 | 7 | # Stage 7 8 | # Release hybrid 9 | 10 | 11 | # Stage 6 12 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 13 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 14 | 15 | MaleHybridYT5 = setPheno(MaleHybridYT5, reps = repYT5, p = p) 16 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, reps = repYT5, p = p) 17 | 18 | MaleInbredYT5 = 19 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 20 | FemaleInbredYT5 = 21 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 22 | 23 | 24 | # Stage 5 25 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 26 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 27 | 28 | MaleHybridYT4 = setPheno(MaleHybridYT4, reps = repYT4, p = p) 29 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, reps = repYT4, p = p) 30 | 31 | MaleInbredYT4 = 32 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 33 | FemaleInbredYT4 = 34 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 35 | 36 | 37 | # Stage 4 38 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 39 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 40 | 41 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 42 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 43 | 44 | MaleHybridYT3 = setPheno(MaleHybridYT3, reps = repYT3, p = p) 45 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, reps = repYT3, p = p) 46 | 47 | 48 | # Stage 3 49 | # Report selection accuracy 50 | output$acc_sel[year] = c((cor(MaleYT1@pheno,MaleYT1@gv) + 51 | cor(FemaleYT1@pheno,FemaleYT1@gv))/2) 52 | 53 | MaleYT2 = selectInd(MaleYT1, nInbred2) 54 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 55 | 56 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, reps = repYT2, inbred = T, p = p) 57 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, reps = repYT2, inbred = T, p = p) 58 | 59 | 60 | # Stage 2 61 | MaleDH = makeDH(MaleF1, nDH) 62 | FemaleDH = makeDH(FemaleF1, nDH) 63 | 64 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, reps = repYT1, inbred = T, p = p) 65 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, reps = repYT1, inbred = T, p = p) 66 | 67 | 68 | # Stage 1 69 | MaleF1 = randCross(MaleParents, nCrosses) 70 | FemaleF1 = randCross(FemaleParents, nCrosses) 71 | 72 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/04_DoubledHaploid/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic line breeding program with doubled haploid technology 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | 8 | # ---- Clean environment and load packages ---- 9 | rm(list = ls()) 10 | # install.packages(pkgs = "AlphaSimR") 11 | library(package = "AlphaSimR") 12 | 13 | # ---- Load global parameters ---- 14 | source(file = "GlobalParameters.R") 15 | scenarioName = "LinePheno_DH" 16 | 17 | # ---- Create list to store results from reps ---- 18 | results = list() 19 | 20 | for(REP in 1:nReps) { 21 | cat("Working on REP:", REP,"\n") 22 | 23 | # ---- Create a data frame to track key parameters ---- 24 | output = data.frame(year = 1:nCycles, 25 | rep = rep(REP, nCycles), 26 | scenario = rep(scenarioName, nCycles), 27 | meanG = numeric(nCycles), 28 | varG = numeric(nCycles), 29 | accSel = numeric(nCycles)) 30 | 31 | # ---- Create initial parents ---- 32 | source(file = "CreateParents.R") 33 | 34 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 35 | source(file = "FillPipeline.R") 36 | 37 | # ---- Burn-in phase ---- 38 | for(year in 1:nBurnin) { 39 | cat(" Working on burn-in year:",year,"\n") 40 | source(file = "UpdateParents.R") # Pick parents 41 | source(file = "AdvanceYear.R") # Advances yield trials by a year 42 | # Report results 43 | output$meanG[year] = meanG(DH) 44 | output$varG[year] = varG(DH) 45 | } 46 | 47 | # ---- Future phase ---- 48 | for(year in (nBurnin+1):(nBurnin+nFuture)) 49 | { 50 | cat(" Working on future year:",year,"\n") 51 | source(file = "UpdateParents.R") # Pick parents 52 | source(file = "AdvanceYear.R") # Advances yield trials by a year 53 | # Report results 54 | output$meanG[year] = meanG(DH) 55 | output$varG[year] = varG(DH) 56 | } 57 | 58 | # Save results from current replicate 59 | results = append(results, list(output)) 60 | } 61 | 62 | # Save results 63 | saveRDS(results, file = paste0(scenarioName,".rds")) 64 | 65 | # ---- Analyze results ---- 66 | source(file = "ANALYZERESULTS.R") 67 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/AdvanceYear_GSTP.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 6 7 | # Release variety 8 | 9 | # Stage 5 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 4 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 3 - apply genomic selection 18 | # NOTE: HDRW removed because phenotyping not needed 19 | DH = setEBV(DH, gsModel) 20 | output$accSel[year] = cor(DH@gv, DH@ebv) 21 | PYT = selectInd(selectWithinFam(DH, famMax,use = "ebv"), 22 | nPYT, use = "ebv") 23 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 24 | 25 | # Stage 2 26 | DH = makeDH(F1, nDH) 27 | 28 | # Stage 1 29 | # Run population improvement 30 | 31 | if (year == nBurnin + 1) {count = 0} 32 | 33 | for(cycle in 1:nCyclesPI){ 34 | cat(" Population improvement cycle", cycle, "/", nCyclesPI,"\n") 35 | if(cycle == 1){ 36 | 37 | count = count + 1 38 | 39 | if (year == (nBurnin + 1)) { 40 | # Create F1s by crossing parents from Burn-in 41 | Parents = randCross(Parents, nCrosses) 42 | } 43 | 44 | # 1. Select best F1s using GS 45 | # Predict EBVs 46 | Parents = setEBV(Parents, gsModel) 47 | # Report prediction accuracy 48 | accPI$accPI[count] = cor(Parents@gv, Parents@ebv) 49 | # F1s to advance to product development 50 | F1 = selectInd(selectWithinFam(Parents, nInd = maxFamPI, use = "ebv"), 51 | nInd = nF1PI, use = "ebv") 52 | # F1s to advance to next cycle as new parents 53 | Parents = selectInd(Parents, nParentsPI, use = "ebv") 54 | 55 | # 2. Make parental crosses 56 | Parents = randCross(Parents, nCrossPI, nProgenyPI) 57 | } else { 58 | 59 | count = count + 1 60 | 61 | # 1. Select best F1s using GS 62 | # Predict EBVs 63 | Parents = setEBV(Parents, gsModel) 64 | # Report prediction accuracy 65 | accPI$accPI[count] = cor(Parents@gv, Parents@ebv) 66 | # F1s to advance to next cycle as new parents 67 | Parents = selectInd(selectWithinFam(Parents, nInd = maxFamPI, use = "ebv"), 68 | nInd = nParentsPI, use = "ebv") 69 | 70 | # 2. Make parental crosses 71 | Parents = randCross(Parents, nCrossPI, nProgenyPI) 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /02_ClonalBreeding/01_PhenotypicSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic tea clonal breeding program 2 | # 3 | # Authors: Initially developed by Nelson Lubanga, Gregor Gorjanc, Jon Bancic; 4 | # exanded/polished for this publication by Jon Bancic, Philip Greenspoon, 5 | # Chris Gaynor, Gregor Gorjanc 6 | # 7 | # Date Created: 2023-12-06 8 | 9 | # ---- Clean environment and load packages ---- 10 | rm(list = ls()) 11 | # install.packages(pkgs = "AlphaSimR") 12 | library(package = "AlphaSimR") 13 | 14 | # ---- Load global parameters ---- 15 | source(file = "GlobalParameters.R") 16 | scenarioName = "ClonalPheno" 17 | 18 | # ---- Create list to store results from reps ---- 19 | results = list() 20 | 21 | for(REP in 1:nReps){ 22 | cat("Working on REP:", REP,"\n") 23 | 24 | # ---- Create a data frame to track key parameters ---- 25 | output = data.frame(year = 1:nCycles, 26 | rep = rep(REP, nCycles), 27 | scenario = rep(scenarioName, nCycles), 28 | meanG = numeric(nCycles), 29 | varG = numeric(nCycles), 30 | accSel = numeric(nCycles)) 31 | 32 | # ---- Create initial parents ---- 33 | source(file = "CreateParents.R") 34 | 35 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 36 | source(file = "FillPipeline.R") 37 | 38 | # ---- Simulate year effects ---- 39 | P = runif(nCycles) 40 | 41 | # ---- Burn-in phase ---- 42 | for(year in 1:nBurnin) { 43 | cat(" Working on burnin year:",year,"\n") 44 | source(file = "UpdateParents.R") # Pick parents 45 | source(file = "AdvanceYear.R") # Advances yield trials by a year and collects records 46 | # Report results 47 | output$meanG[year] = meanG(Seedlings) 48 | output$varG[year] = varG(Seedlings) 49 | } 50 | 51 | # ---- Future phase ---- 52 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 53 | cat(" Working on future year:",year,"\n") 54 | source(file = "UpdateParents.R") # Pick parents 55 | source(file = "AdvanceYear.R") # Advances yield trials by a year and collects records 56 | # Report results 57 | output$meanG[year] = meanG(Seedlings) 58 | output$varG[year] = varG(Seedlings) 59 | } 60 | 61 | # Save results from current replicate 62 | results = append(results, list(output)) 63 | } 64 | 65 | # Save results 66 | saveRDS(results, file = paste0(scenarioName,".rds")) 67 | 68 | # ---- Analyze results ---- 69 | source(file = "ANALYZERESULTS.R") 70 | -------------------------------------------------------------------------------- /04_Features/miscellaneousSlot.R: -------------------------------------------------------------------------------- 1 | # Script name: Use of miscellaneous slot in AlphaSimR 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates how to use the miscellaneous slot in 8 | # AlphaSimR populations. Here, the slot is designed to be used as part 9 | # of selection criteria. 10 | # 11 | # WARNING: Organisation of the misc slot has changed with AlphaSimR 12 | # version 1.5.4. Prior to this version, misc slot was a list of length 13 | # equal to the number of individuals (nInd). Since version 1.5.4, misc 14 | # slot is a list of length equal to the number of nodes, with each node 15 | # of length equal to the number of individuals. 16 | 17 | # ---- Clean environment and load packages ---- 18 | 19 | rm(list = ls()) 20 | # install.packages(pkgs = "AlphaSimR") 21 | (AlphaSimRVersion = packageVersion(pkg = "AlphaSimR")) 22 | library(package = "AlphaSimR") 23 | 24 | # ---- Setup simulation ---- 25 | 26 | # Create founder haplotypes 27 | founderPop = runMacs( 28 | nInd = 10, 29 | nChr = 1, 30 | segSites = 100, 31 | inbred = TRUE, 32 | species = "GENERIC" 33 | ) 34 | 35 | # ---- Add two correlated additive traits with same genetic architecture ---- 36 | 37 | # Set simulation parameters 38 | SP = SimParam$new(founderPop) 39 | 40 | # Specify correlation between traits 41 | traitCor = matrix(c(1.0, 0.5, 42 | 0.5, 1.0), ncol = 2, byrow = T) 43 | traitCor 44 | 45 | # Create two traits 46 | SP$addTraitA( 47 | nQtlPerChr = 100, 48 | mean = c(0, 0), 49 | var = c(1, 1), 50 | corA = traitCor 51 | ) 52 | 53 | # Create population 54 | pop = newPop(founderPop) 55 | pop = setPheno(pop, h2 = c(0.5, 0.5)) 56 | 57 | # ---- Assign selection index values to the miscellaneous slot ---- 58 | 59 | # Set weights for each trait 60 | weights = c(1, 0.5) 61 | 62 | # Naive selection index 63 | selIndex = c(pheno(pop) %*% weights) 64 | 65 | # Assign index values to miscellaneous slot 66 | if (AlphaSimRVersion < "1.5.4") { 67 | pop = setMisc(pop, "selIndex", selIndex) 68 | } else { 69 | pop@misc$selIndex = selIndex 70 | } 71 | 72 | # Function to obtain nice table of miscellaneous slot values 73 | if (AlphaSimRVersion < "1.5.4") { 74 | getSelIndex <- function(pop) { 75 | sapply(getMisc(pop, "selIndex"), FUN = function(z) z) 76 | } 77 | } else { 78 | getSelIndex <- function(pop) { 79 | pop@misc$selIndex 80 | } 81 | } 82 | 83 | # Check miscellaneous slot 84 | getSelIndex(pop) 85 | 86 | # Order individuals using selection index stored in miscellaneous slot 87 | popOrd = pop[order(getSelIndex(pop), decreasing = TRUE)] 88 | data.frame(id = popOrd@id, 89 | selIndex = getSelIndex(popOrd)) 90 | 91 | -------------------------------------------------------------------------------- /02_ClonalBreeding/03_GenomicSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Genomic tea clonal breeding program 2 | # 3 | # Authors: Initially developed by Nelson Lubanga, Gregor Gorjanc, Jon Bancic; 4 | # exanded/polished for this publication by Jon Bancic, Philip Greenspoon, 5 | # Chris Gaynor, Gregor Gorjanc 6 | # 7 | # Date Created: 2023-12-06 8 | 9 | # ---- Clean environment and load packages ---- 10 | rm(list = ls()) 11 | # install.packages(pkgs = "AlphaSimR") 12 | library(package = "AlphaSimR") 13 | 14 | # ---- Load global parameters ---- 15 | source(file = "GlobalParameters.R") 16 | scenarioName = "ClonalGS" 17 | 18 | # ---- Create list to store results from reps ---- 19 | results = list() 20 | 21 | for(REP in 1:nReps){ 22 | cat("Working on REP:", REP,"\n") 23 | 24 | # ---- Create a data frame to track key parameters ---- 25 | output = data.frame(year = 1:nCycles, 26 | rep = rep(REP, nCycles), 27 | scenario = rep(scenarioName, nCycles), 28 | meanG = numeric(nCycles), 29 | varG = numeric(nCycles), 30 | accSel = numeric(nCycles)) 31 | 32 | # ---- Create initial parents ---- 33 | source(file = "CreateParents.R") 34 | 35 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 36 | source(file = "FillPipeline.R") 37 | 38 | # ---- Simulate year effects ---- 39 | P = runif(nCycles) 40 | 41 | # ---- Burn-in phase ---- 42 | for(year in 1:nBurnin) { 43 | cat(" Working on burnin year:",year,"\n") 44 | source(file = "UpdateParents.R") # Pick parents 45 | source(file = "AdvanceYear.R") # Advance yield trials by a year 46 | source(file = "StoreTrainPop.R") # Store training population 47 | # Report results 48 | output$meanG[year] = meanG(Seedlings) 49 | output$varG[year] = varG(Seedlings) 50 | } 51 | 52 | # ---- Future phase ---- 53 | # Replace three early stages with genomic prediction 54 | rm(HPT1, HPT2, HPT3) 55 | 56 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 57 | cat(" Working on future year:",year,"\n") 58 | source(file = "RunModel_GS.R") # Run pedigree model 59 | source(file = "UpdateParents.R") # Pick parents 60 | source(file = "AdvanceYear_GS.R") # Advance yield trials by a year 61 | source(file = "StoreTrainPop.R") # Store training population 62 | # Report results 63 | output$meanG[year] = meanG(Seedlings) 64 | output$varG[year] = varG(Seedlings) 65 | } 66 | 67 | # Save results from current replicate 68 | results = append(results, list(output)) 69 | } 70 | 71 | # Save results 72 | saveRDS(results, file = paste0(scenarioName,".rds")) 73 | 74 | # ---- Analyze results ---- 75 | source(file = "ANALYZERESULTS.R") 76 | -------------------------------------------------------------------------------- /01_LineBreeding/02_GenomicSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Genomic selection wheat line breeding program 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # Applies GS to advance individuals from DH to make PYT as well as to select new 9 | # parents from DH stage. 10 | 11 | # ---- Clean environment and load packages ---- 12 | rm(list = ls()) 13 | # install.packages(pkgs = "AlphaSimR") 14 | library(package = "AlphaSimR") 15 | 16 | # ---- Load global parameters ---- 17 | source(file = "GlobalParameters.R") 18 | scenarioName = "LineGS" 19 | 20 | # ---- Create list to store results from reps ---- 21 | results = list() 22 | 23 | for(REP in 1:nReps){ 24 | cat("Working on REP:", REP,"\n") 25 | 26 | # ---- Create a data frame to track key parameters ---- 27 | output = data.frame(year = 1:nCycles, 28 | rep = rep(REP, nCycles), 29 | scenario = "", 30 | meanG = numeric(nCycles), 31 | varG = numeric(nCycles), 32 | acc_sel = numeric(nCycles)) 33 | # ---- Create initial parents ---- 34 | source(file = "CreateParents.R") 35 | 36 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 37 | source(file = "FillPipeline.R") 38 | 39 | # ---- Simulate year effects ---- 40 | P = runif(nCycles) 41 | 42 | # ---- Burn-in phase: Phenotypic selection program ---- 43 | cat("--> Working on Burn-in \n") 44 | for(year in 1:nBurnin) { 45 | cat(" Working on burn-in year:",year,"\n") 46 | source(file = "UpdateParents.R") # Pick new parents 47 | source(file = "AdvanceYear.R") # Advance yield trials by a year 48 | source(file = "StoreTrainPop.R") # Store training population 49 | # Report results 50 | output$meanG[year] = meanG(DH) 51 | output$varG[year] = varG(DH) 52 | } 53 | 54 | # ---- Future phase: Genomic selection program ---- 55 | cat("--> Working on Genomic line breeding program \n") 56 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 57 | cat(" Working on future year:",year,"\n") 58 | source(file = "RunGSModels.R") # Run genomic model 59 | source(file = "UpdateParents_GS.R") # Pick new parents 60 | source(file = "AdvanceYear_GS.R") # Advance yield trials by a year 61 | source(file = "StoreTrainPop.R") # Store training population 62 | # Report results 63 | output$meanG[year] = meanG(DH) 64 | output$varG[year] = varG(DH) 65 | } 66 | 67 | # Save results from current replicate 68 | results = append(results, list(output)) 69 | } 70 | 71 | # Save results 72 | saveRDS(results, file = paste0(scenarioName,".rds")) 73 | 74 | # ---- Analyze results ---- 75 | source(file = "ANALYZERESULTS.R") 76 | -------------------------------------------------------------------------------- /04_Features/setHeritability.R: -------------------------------------------------------------------------------- 1 | # Script name: Setting heritability in AlphaSimR 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates three ways for setting error variance 8 | # of a phenotype. This is shown using a trait with additive 9 | # and dominance effects. 10 | 11 | # ---- Clean environment and load packages ---- 12 | 13 | rm(list = ls()) 14 | # install.packages(pkgs = "AlphaSimR") 15 | library(package = "AlphaSimR") 16 | 17 | # ---- Setup simulation ---- 18 | 19 | # Create founder haplotypes 20 | founderPop = quickHaplo(nInd = 1000, 21 | nChr = 1, 22 | segSites = 1000) 23 | 24 | # Set simulation parameters 25 | SP = SimParam$new(founderPop) 26 | 27 | # Add an additve + dominance trait 28 | SP$addTraitAD( 29 | nQtlPerChr = 1000, 30 | mean = 0, 31 | var = 1, 32 | meanDD = 0.92, 33 | varDD = 0.2 34 | ) 35 | 36 | # Create population 37 | pop = newPop(founderPop) 38 | 39 | # Obtain true additive and total genetic variance from SP object 40 | # These relate to the founder population and will change with selection 41 | varA = SP$varA[1] 42 | varG = SP$varG[1] 43 | 44 | # NOTES: 45 | # Users should choose only one of three options to set phenotype. 46 | # Option 1 and 2 use variances that relate to the founder population 47 | # We assume that heritability of the trait is 0.5. 48 | 49 | # ---- Option 1: By assigning the narrow sense heritability ---- 50 | 51 | pop = setPheno(pop, h2 = 0.5) 52 | # Check heritability 53 | cor(pop@pheno, pop@gv)^2 54 | 55 | # Equivalent to manual setting of phenotype as 56 | varE = varA / 0.5 - varG # obtain error variance given h2 and varA 57 | error = rnorm(pop@nInd, sd = sqrt(varE)) 58 | pheno = pop@gv + error 59 | # Check heritability 60 | cor(pheno, pop@gv)^2 61 | 62 | # ---- Option 2: By assigning the broad-sense heritability ---- 63 | 64 | pop = setPheno(pop, H2 = 0.5) 65 | # Check heritability 66 | cor(pop@pheno, pop@gv)^2 67 | 68 | # Equivalent to manual setting of phenotype as 69 | varE = varG / 0.5 - varG # obtain error variance given h2 and varG 70 | error = rnorm(pop@nInd, sd = sqrt(varE)) 71 | pheno = pop@gv + error 72 | # Check heritability 73 | cor(pheno, pop@gv)^2 74 | 75 | # ---- Option 3: By assigning error variance and number of replications ---- 76 | 77 | pop = setPheno(pop, varE = 1, reps = 1) 78 | # Check heritability 79 | cor(pop@pheno, pop@gv)^2 80 | 81 | # Increasing the number of replications will result in higher h2 82 | pop = setPheno(pop, varE = 1, reps = 10) 83 | # Check heritability 84 | cor(pop@pheno, pop@gv)^2 85 | 86 | # Equivalent to manual setting of phenotype as 87 | reps = 10 88 | varE = 1 89 | error = rnorm(pop@nInd, sd = sqrt(varE)) 90 | pheno = pop@gv + error / sqrt(reps) 91 | # Check heritability 92 | cor(pheno, pop@gv)^2 93 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/RunModel_Pedigree.R: -------------------------------------------------------------------------------- 1 | # Run pedigree BLUP model internal AlphaSimR solver 2 | 3 | # Pedigree BLUP is used to predict breeding values of Seedlings in 4 | # order to skip HPT stages 5 | 6 | # Prepare prediction dataset for seedlings 7 | pedPop_tmp = rbind(pedPop, 8 | data.frame(Ind = c(Seedlings@id), 9 | Sire = c(Seedlings@father), 10 | Dam = c(Seedlings@mother), 11 | Year = year, 12 | Stage = rep("Seedlings",Seedlings@nInd), 13 | Pheno = NA, 14 | GV = c(Seedlings@gv))) 15 | 16 | # Create factors 17 | pedPop_tmp$Ind = as.factor(pedPop_tmp$Ind) 18 | pedPop_tmp$Year = as.factor(pedPop_tmp$Year) 19 | pedPop_tmp$Stage = as.factor(pedPop_tmp$Stage) 20 | 21 | # Get complete pedigree 22 | id = as.factor(1:SP$lastId) 23 | dam = SP$pedigree[,1] 24 | dam[dam==0L] = NA 25 | sire = SP$pedigree[,2] 26 | sire[sire==0L] = NA 27 | ped = data.frame(id,dam,sire) 28 | # Trim pedigree 29 | trim = trimPed(ped, data = ped$id %in% pedPop_tmp$Ind) 30 | ped = ped[trim,] 31 | 32 | if (asreml.avail) { 33 | # Run pedigree model in asreml 34 | A = ainverse(ped) 35 | asreml.options(trace=FALSE) 36 | pedModel <- asreml(fixed = Pheno ~ 1 + Year, 37 | random = ~ vm(Ind, A), 38 | # residual = ~ dsum(~id(units) | Year), 39 | residual = ~ units, 40 | na.action = na.method(y='include'), 41 | data = pedPop_tmp) 42 | # Loop to ensure model converges 43 | while (pedModel$converge != TRUE) { 44 | pedModel <- update.asreml(pedModel) 45 | } 46 | 47 | # Obtain estimated breeding values 48 | EBV2 = data.frame(ebv = c(pedModel$coef$random)) 49 | EBV2$id = sub(pattern = ".*_","", rownames(pedModel$coef$random)) 50 | EBV2 = EBV2[EBV2$id %in% as.character(pedPop_tmp$Ind),] 51 | EBV2 = EBV2[match(as.character(pedPop_tmp$Ind),EBV2$id),] 52 | EBV = EBV2$ebv 53 | # Check 54 | # cor(EBV$ebv,EBV2$ebv) # 0.9999999 55 | # cor(pedPop_tmp$GV, EBV2$ebv) 56 | } else { 57 | # Run internal AlphaSimR solver (much slower than asreml) 58 | options(na.action='na.pass') 59 | y = matrix(pedPop_tmp$Pheno); dim(y) 60 | X = model.matrix(Pheno ~ 1 + Year, data = pedPop_tmp); dim(X) 61 | Z = model.matrix(Pheno ~ Ind - 1, data = pedPop_tmp); dim(Z) 62 | ped2 = with(ped, pedPop(label = id, sire = sire, dam = dam)) 63 | A = getA(ped2) 64 | A = A[rownames(A) %in% pedPop_tmp$Ind,rownames(A) %in% pedPop_tmp$Ind]; dim(A) 65 | fit = solveUVM(y = y, X = X, Z = Z, K = as.matrix(A)) 66 | 67 | # Obtain estimated breeding values 68 | EBV = data.frame(id = ped2@label[ped2@label %in% pedPop_tmp$Ind], ebv = fit$u) 69 | EBV = EBV[match(pedPop_tmp$Ind, EBV$id),] 70 | # Check 71 | # head(EBV$id) 72 | # head(pedPop_tmp$Ind) 73 | # cor(pedPop_tmp$GV, EBV$ebv) 74 | } 75 | 76 | rm(pedPop_tmp, id, dam, sire, ped, trim) -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | 5 | P = runif(6) # p-values for GxY effect 6 | 7 | for(cohort in 1:6){ 8 | cat("FillPipeline year:", cohort, "of 6\n") 9 | 10 | # Stage 1 11 | MaleF1 = randCross(MaleParents, nCrosses) 12 | FemaleF1 = randCross(FemaleParents, nCrosses) 13 | 14 | # Stage 2 15 | if(cohort<6){ 16 | p = P[6-cohort] 17 | 18 | MaleDH = makeDH(MaleF1, nDH) 19 | FemaleDH = makeDH(FemaleF1, nDH) 20 | 21 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, 22 | reps = repYT1, inbred = T, p = p) 23 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, 24 | reps = repYT1, inbred = T, p = p) 25 | } 26 | 27 | # Stage 3 28 | if(cohort<5){ 29 | p = P[5-cohort] 30 | 31 | MaleYT2 = selectInd(MaleYT1, nInbred2) 32 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 33 | 34 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, 35 | reps = repYT2, inbred = T, p = p) 36 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, 37 | reps = repYT2, inbred = T, p = p) 38 | } 39 | 40 | # Stage 4 41 | if(cohort<4){ 42 | p = P[4-cohort] 43 | 44 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 45 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 46 | 47 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 48 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 49 | 50 | MaleHybridYT3 = setPheno(MaleHybridYT3, 51 | reps = repYT3, p = p) 52 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, 53 | reps = repYT3, p = p) 54 | } 55 | 56 | # Stage 5 57 | if(cohort<3){ 58 | p = P[3-cohort] 59 | 60 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 61 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 62 | 63 | MaleHybridYT4 = setPheno(MaleHybridYT4, 64 | reps = repYT4, p = p) 65 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, 66 | reps = repYT4, p = p) 67 | 68 | MaleInbredYT4 = 69 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 70 | FemaleInbredYT4 = 71 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 72 | } 73 | 74 | # Stage 6 75 | if(cohort<2){ 76 | p = P[2-cohort] 77 | 78 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 79 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 80 | 81 | MaleHybridYT5 = setPheno(MaleHybridYT5, 82 | reps = repYT5, p = p) 83 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, 84 | reps = repYT5, p = p) 85 | 86 | MaleInbredYT5 = 87 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 88 | FemaleInbredYT5 = 89 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 90 | } 91 | 92 | # Stage 7, release 93 | } 94 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | 5 | P = runif(6) # p-values for GxY effect 6 | 7 | for(cohort in 1:6){ 8 | cat("FillPipeline year:", cohort, "of 6\n") 9 | 10 | # Stage 1 11 | MaleF1 = randCross(MaleParents, nCrosses) 12 | FemaleF1 = randCross(FemaleParents, nCrosses) 13 | 14 | # Stage 2 15 | if(cohort<6){ 16 | p = P[6-cohort] 17 | 18 | MaleDH = makeDH(MaleF1, nDH) 19 | FemaleDH = makeDH(FemaleF1, nDH) 20 | 21 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, 22 | reps = repYT1, inbred = T, p = p) 23 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, 24 | reps = repYT1, inbred = T, p = p) 25 | } 26 | 27 | # Stage 3 28 | if(cohort<5){ 29 | p = P[5-cohort] 30 | 31 | MaleYT2 = selectInd(MaleYT1, nInbred2) 32 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 33 | 34 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, 35 | reps = repYT2, inbred = T, p = p) 36 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, 37 | reps = repYT2, inbred = T, p = p) 38 | } 39 | 40 | # Stage 4 41 | if(cohort<4){ 42 | p = P[4-cohort] 43 | 44 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 45 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 46 | 47 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 48 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 49 | 50 | MaleHybridYT3 = setPheno(MaleHybridYT3, 51 | reps = repYT3, p = p) 52 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, 53 | reps = repYT3, p = p) 54 | } 55 | 56 | # Stage 5 57 | if(cohort<3){ 58 | p = P[3-cohort] 59 | 60 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 61 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 62 | 63 | MaleHybridYT4 = setPheno(MaleHybridYT4, 64 | reps = repYT4, p = p) 65 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, 66 | reps = repYT4, p = p) 67 | 68 | MaleInbredYT4 = 69 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 70 | FemaleInbredYT4 = 71 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 72 | } 73 | 74 | # Stage 6 75 | if(cohort<2){ 76 | p = P[2-cohort] 77 | 78 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 79 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 80 | 81 | MaleHybridYT5 = setPheno(MaleHybridYT5, 82 | reps = repYT5, p = p) 83 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, 84 | reps = repYT5, p = p) 85 | 86 | MaleInbredYT5 = 87 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 88 | FemaleInbredYT5 = 89 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 90 | } 91 | 92 | # Stage 7, release 93 | } 94 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | #Set initial yield trials with unique individuals 4 | 5 | P = runif(6) # p-values for GxY effect 6 | 7 | for(cohort in 1:6){ 8 | cat("FillPipeline year:", cohort, "of 6\n") 9 | 10 | # Stage 1 11 | MaleF1 = randCross(MaleParents, nCrosses) 12 | FemaleF1 = randCross(FemaleParents, nCrosses) 13 | 14 | # Stage 2 15 | if(cohort<6){ 16 | p = P[6-cohort] 17 | 18 | MaleDH = makeDH(MaleF1, nDH) 19 | FemaleDH = makeDH(FemaleF1, nDH) 20 | 21 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, 22 | reps = repYT1, inbred = T, p = p) 23 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, 24 | reps = repYT1, inbred = T, p = p) 25 | } 26 | 27 | # Stage 3 28 | if(cohort<5){ 29 | p = P[5-cohort] 30 | 31 | MaleYT2 = selectInd(MaleYT1, nInbred2) 32 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 33 | 34 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, 35 | reps = repYT2, inbred = T, p = p) 36 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, 37 | reps = repYT2, inbred = T, p = p) 38 | } 39 | 40 | # Stage 4 41 | if(cohort<4){ 42 | p = P[4-cohort] 43 | 44 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 45 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 46 | 47 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 48 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 49 | 50 | MaleHybridYT3 = setPheno(MaleHybridYT3, 51 | reps = repYT3, p = p) 52 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, 53 | reps = repYT3, p = p) 54 | } 55 | 56 | # Stage 5 57 | if(cohort<3){ 58 | p = P[3-cohort] 59 | 60 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 61 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 62 | 63 | MaleHybridYT4 = setPheno(MaleHybridYT4, 64 | reps = repYT4, p = p) 65 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, 66 | reps = repYT4, p = p) 67 | 68 | MaleInbredYT4 = 69 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 70 | FemaleInbredYT4 = 71 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 72 | } 73 | 74 | # Stage 6 75 | if(cohort<2){ 76 | p = P[2-cohort] 77 | 78 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 79 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 80 | 81 | MaleHybridYT5 = setPheno(MaleHybridYT5, 82 | reps = repYT5, p = p) 83 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, 84 | reps = repYT5, p = p) 85 | 86 | MaleInbredYT5 = 87 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 88 | FemaleInbredYT5 = 89 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 90 | } 91 | 92 | # Stage 7, release 93 | } 94 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/AdvanceYear_GS.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | cat(" Advancing year \n") 4 | # Advance breeding program by 1 year 5 | # Works backwards through pipeline to avoid copying data 6 | 7 | 8 | # Stage 7 9 | # Release hybrid 10 | 11 | 12 | # Stage 6 13 | MaleHybridYT5 = selectInd(MaleHybridYT4, nYT5) 14 | FemaleHybridYT5 = selectInd(FemaleHybridYT4, nYT5) 15 | 16 | # Grow hybrid trials 17 | MaleHybridYT5 = setPheno(MaleHybridYT5, reps = repYT5, p = p) 18 | FemaleHybridYT5 = setPheno(FemaleHybridYT5, reps = repYT5, p = p) 19 | 20 | MaleInbredYT5 = 21 | MaleInbredYT4[MaleInbredYT4@id%in%MaleHybridYT5@mother] 22 | FemaleInbredYT5 = 23 | FemaleInbredYT4[FemaleInbredYT4@id%in%FemaleHybridYT5@mother] 24 | 25 | 26 | # Stage 5 27 | MaleHybridYT4 = selectInd(MaleHybridYT3, nYT4) 28 | FemaleHybridYT4 = selectInd(FemaleHybridYT3, nYT4) 29 | 30 | # Grow hybrid trials 31 | MaleHybridYT4 = setPheno(MaleHybridYT4, reps = repYT4, p = p) 32 | FemaleHybridYT4 = setPheno(FemaleHybridYT4, reps = repYT4, p = p) 33 | 34 | MaleInbredYT4 = 35 | MaleInbredYT3[MaleInbredYT3@id%in%MaleHybridYT4@mother] 36 | FemaleInbredYT4 = 37 | FemaleInbredYT3[FemaleInbredYT3@id%in%FemaleHybridYT4@mother] 38 | 39 | 40 | # Stage 4 41 | MaleInbredYT3 = selectInd(MaleYT2, nInbred3) 42 | FemaleInbredYT3 = selectInd(FemaleYT2, nInbred3) 43 | 44 | MaleHybridYT3 = hybridCross(MaleInbredYT3, FemaleElite) 45 | FemaleHybridYT3 = hybridCross(FemaleInbredYT3, MaleElite) 46 | 47 | # Grow hybrid trials 48 | MaleHybridYT3 = setPheno(MaleHybridYT3, reps = repYT3, p = p) 49 | FemaleHybridYT3 = setPheno(FemaleHybridYT3, reps = repYT3, p = p) 50 | 51 | 52 | # Stage 3 53 | MaleYT2 = selectInd(MaleYT1, nInbred2) 54 | FemaleYT2 = selectInd(FemaleYT1, nInbred2) 55 | 56 | # Grow testcross trials 57 | MaleYT2 = setPhenoGCA(MaleYT2, FemaleTester2, reps = repYT2, inbred = T, p = p) 58 | FemaleYT2 = setPhenoGCA(FemaleYT2, MaleTester2, reps = repYT2, inbred = T, p = p) 59 | 60 | 61 | # Stage 2 62 | MaleDH = makeDH(MaleF1, nDH) 63 | FemaleDH = makeDH(FemaleF1, nDH) 64 | 65 | # Apply genomic selection - predict GCA of DHs 66 | if (exists("gsModel")) { 67 | MaleDH = setEBV(MaleDH, gsModel) 68 | FemaleDH = setEBV(FemaleDH, gsModel) 69 | } else { 70 | MaleDH = setEBV(MaleDH, gsModelM) 71 | FemaleDH = setEBV(FemaleDH, gsModelF) 72 | } 73 | 74 | # Report average prediction accuracy across two pools 75 | output$acc_sel[year] = c((cor(MaleDH@ebv,MaleDH@gv) + 76 | cor(FemaleDH@ebv,FemaleDH@gv))/2) 77 | 78 | # Make selection on EBVs 79 | MaleDH = selectInd(selectWithinFam(MaleDH, famMax, use = "ebv"), 80 | nInbred2, use = "ebv") 81 | FemaleDH = selectInd(selectWithinFam(FemaleDH, famMax, use = "ebv"), 82 | nInbred2, use = "ebv") 83 | 84 | # Grow testcross trials 85 | MaleYT1 = setPhenoGCA(MaleDH, FemaleTester1, reps = repYT1, inbred = T, p = p) 86 | FemaleYT1 = setPhenoGCA(FemaleDH, MaleTester1, reps = repYT1, inbred = T, p = p) 87 | 88 | 89 | # Stage 1 90 | # Make random crosses 91 | MaleF1 = randCross(MaleParents, nCrosses) 92 | FemaleF1 = randCross(FemaleParents, nCrosses) 93 | -------------------------------------------------------------------------------- /02_ClonalBreeding/02_PedigreeSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Pedigree tea clonal breeding program 2 | # 3 | # Authors: Initially developed by Nelson Lubanga, Gregor Gorjanc, Jon Bancic; 4 | # exanded/polished for this publication by Jon Bancic, Philip Greenspoon, 5 | # Chris Gaynor, Gregor Gorjanc 6 | # 7 | # Note: The simulation uses asreml to run a pedigree model by default. 8 | # Alternatively, there is code provided that uses internal AlphaSimR solver, 9 | # which is significantly slower and not recommended quick testing. 10 | # 11 | # Date Created: 2023-12-06 12 | 13 | # ---- Clean environment and load packages ---- 14 | rm(list = ls()) 15 | # install.packages(pkgs = c("AlphaSimR", "asreml", "pedigree")) 16 | library(package = "AlphaSimR") 17 | library(package = "pedigree") 18 | library(package = "asreml") 19 | asreml.avail = TRUE # FALSE if asreml unavailable 20 | 21 | # ---- Load global parameters ---- 22 | source(file = "GlobalParameters.R") 23 | scenarioName = "ClonalPedigree" 24 | 25 | # ---- Create list to store results from reps ---- 26 | results = list() 27 | 28 | for(REP in 1:nReps){ 29 | cat("Working on REP:", REP,"\n") 30 | 31 | # ---- Create a data frame to track key parameters ---- 32 | output = data.frame(year = 1:nCycles, 33 | rep = rep(REP, nCycles), 34 | scenario = rep(scenarioName, nCycles), 35 | meanG = numeric(nCycles), 36 | varG = numeric(nCycles), 37 | accSel = numeric(nCycles)) 38 | 39 | # ---- Create initial parents ---- 40 | source(file = "CreateParents.R") 41 | 42 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 43 | source(file = "FillPipeline.R") 44 | 45 | # ---- Simulate year effects ---- 46 | P = runif(nCycles) 47 | 48 | # ---- Burn-in phase ---- 49 | for(year in 1:nBurnin) { 50 | cat(" Working on burnin year:",year,"\n") 51 | source(file = "UpdateParents.R") # Pick parents 52 | source(file = "AdvanceYear.R") # Advance yield trials by a year 53 | source(file = "StoreTrainPop.R") # Store training population 54 | # Report results 55 | output$meanG[year] = meanG(Seedlings) 56 | output$varG[year] = varG(Seedlings) 57 | } 58 | 59 | # ---- Future phase ---- 60 | # Replace three early stages with pedigree prediction 61 | rm(HPT1, HPT2, HPT3) 62 | 63 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 64 | cat(" Working on future year:",year,"\n") 65 | source(file = "RunModel_Pedigree.R") # Run pedigree model 66 | source(file = "UpdateParents.R") # Pick parents 67 | source(file = "AdvanceYear_Pedigree.R") # Advance yield trials by a year 68 | source(file = "StoreTrainPop.R") # Store training population 69 | # Report results 70 | output$meanG[year] = meanG(Seedlings) 71 | output$varG[year] = varG(Seedlings) 72 | } 73 | 74 | # Save results from current replicate 75 | results = append(results, list(output)) 76 | } 77 | 78 | # Save results 79 | saveRDS(results, file = paste0(scenarioName,".rds")) 80 | 81 | # ---- Analyze results ---- 82 | source(file = "ANALYZERESULTS.R") 83 | -------------------------------------------------------------------------------- /04_Features/importExternalHaplo.R: -------------------------------------------------------------------------------- 1 | # Script name: Importing External Haplotypes in AlphaSimR 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # This script demonstrates the process of importing external 9 | # marker data into AlphaSimR for haplotype analysis. 10 | 11 | # ---- Clean environment and load packages ---- 12 | 13 | rm(list = ls()) 14 | # install.packages(pkgs = "AlphaSimR") 15 | library(package = "AlphaSimR") 16 | 17 | # ---- Step 1: Load in founder haplotypes ---- 18 | # This requires a genetic map and phased genotypes 19 | 20 | # Load the genetic map in the below format 21 | # Format: Marker name, Chromosome, Position (in Morgans) 22 | # Modeling 10 chromosomes with 10 loci each 23 | # Loci are equally space along 1 Morgan chromosomes 24 | genMap = data.frame( 25 | marker = paste0("x", 1:100), 26 | chromosome = rep(1:10, each = 10), 27 | position = rep(seq(from = 0, to = 1, length.out = 10), times = 10) 28 | ) 29 | 30 | # Load the haplotypes in the below format 31 | # Modeling 10 individuals 32 | # There will need to be 20 rows (# of individuals times 2, since each has 2 haplotypes) 33 | # Each individual will have 100 loci based on the map above 34 | # Generating just random 0s and 1s 35 | haplo = matrix( 36 | data = sample(0:1, size = 2 * 10 * 100, replace = TRUE), 37 | nrow = 2 * 10, 38 | ncol = 100 39 | ) 40 | 41 | # Assign marker names to the haplotypes 42 | # These can be in any order, because the software will order them based 43 | # on the genetic map automatically 44 | colnames(haplo) = genMap$marker 45 | 46 | # Load a pedigree in the below format (optional) 47 | # Pedigree will be for just the 10 individuals represented in the haplotypes 48 | ped = data.frame(id = letters[1:10], 49 | mother = rep(0, 10), 50 | father = rep(0, 10)) 51 | 52 | # Create the founder population 53 | # Uses the data structures loaded above 54 | founderPop = importHaplo( 55 | haplo = haplo, 56 | genMap = genMap, 57 | ploidy = 2, 58 | ped = ped 59 | ) 60 | 61 | # ---- Step 2: Set simulation parameters ---- 62 | # Initialize parameters with founder haplotypes 63 | 64 | SP = SimParam$new(founderPop) 65 | 66 | # Load your own QTL effects (optional) 67 | # This is useful if you want to model known QTL, estimated effects 68 | # from a genomic prediction model, or you just want to create your 69 | # own distribution for effects. The marker names most match the names 70 | # given in the map above. You can model additive effects, dominance 71 | # effects, and an intercept. 72 | qtlEffects = data.frame(marker = c("x1", "x11"), 73 | aditiveEffect = c(1, -1)) 74 | 75 | # Import into SimParam 76 | SP$importTrait( 77 | markerNames = qtlEffects$marker, 78 | addEff = qtlEffects$aditiveEffect, 79 | name = "Your_Trait" 80 | ) 81 | 82 | # ---- Step 3: Create a population from the founder haplotypes ---- 83 | 84 | pop = newPop(founderPop) 85 | 86 | # The population now works like any other AlphaSimR population 87 | gv(pop) 88 | getPed(pop) 89 | -------------------------------------------------------------------------------- /01_LineBreeding/03_TwoPartGS/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Two-part wheat line breeding program 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # Uses two-part strategy with rapid cycling of parents in population improvement 9 | # and conventional breeding for product development. Applies GS to advance 10 | # individuals from DH to make PYT as well as in population improvement. 11 | 12 | # ---- Clean environment and load packages ---- 13 | rm(list = ls()) 14 | # install.packages(pkgs = "AlphaSimR") 15 | library(package = "AlphaSimR") 16 | 17 | # ---- Load global parameters ---- 18 | source(file = "GlobalParameters.R") 19 | scenarioName = "LineGSTP" 20 | 21 | # ---- Create list to store results from reps ---- 22 | results = list() 23 | results_accPI = list() 24 | 25 | for(REP in 1:nReps){ 26 | cat("Working on REP:", REP,"\n") 27 | 28 | # ---- Create a data frame to track key parameters ---- 29 | output = data.frame(year = 1:nCycles, 30 | rep = rep(REP, nCycles), 31 | scenario = "", 32 | meanG = numeric(nCycles), 33 | varG = numeric(nCycles), 34 | accSel = numeric(nCycles)) 35 | 36 | # ---- Create initial parents ---- 37 | source(file = "CreateParents.R") 38 | 39 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 40 | source(file = "FillPipeline.R") 41 | 42 | # ---- Simulate year effects ---- 43 | P = runif(nCycles) 44 | 45 | # ---- Burn-in phase: Phenotypic selection program ---- 46 | cat("--> Working on Burn-in \n") 47 | for(year in 1:nBurnin) { 48 | cat(" Working on burn-in year:",year,"\n") 49 | source(file = "UpdateParents.R") # Pick new parents 50 | source(file = "AdvanceYear.R") # Advance yield trials by a year 51 | source(file = "StoreTrainPop.R") # Store training population 52 | # Report results 53 | output$meanG[year] = meanG(DH) 54 | output$varG[year] = varG(DH) 55 | } 56 | 57 | # ---- Future phase: Genomic selection program ---- 58 | cat("--> Working on Two-part line breeding program \n") 59 | # Parameters for population improvement 60 | nCyclesPI = 2 # Number of cycles per year 61 | nParentsPI = 30 # Number of selected individuals per cycle 62 | nCrossPI = 100 # Number of crosses per cycle 63 | nProgenyPI = 10 # Number of progeny per cross 64 | maxFamPI = 1 # Maximum number of selected individuals per cross 65 | nF1PI = 100 # Number of F1-PI to advance to PD 66 | # Create a data frame to track selection accuracy in every PI cycle 67 | accPI = data.frame(accPI = numeric(nFuture*nCyclesPI)) 68 | 69 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 70 | cat(" Working on future year:",year,"\n") 71 | source(file = "RunGSModels.R") # Run genomic model 72 | source(file = "AdvanceYear_GSTP.R") # Advance yield trials by a year 73 | source(file = "StoreTrainPop.R") # Store training population 74 | # Report results 75 | output$meanG[year] = meanG(DH) 76 | output$varG[year] = varG(DH) 77 | } 78 | 79 | # Save results from current replicate 80 | results = append(results, list(output)) 81 | results_accPI = append(results_accPI, list(accPI)) 82 | } 83 | 84 | # Save results 85 | saveRDS(results, file = paste0(scenarioName,".rds")) 86 | saveRDS(results_accPI, file = paste0(scenarioName,"_accPI.rds")) 87 | 88 | # ---- Analyze results ---- 89 | source(file = "ANALYZERESULTS.R") 90 | -------------------------------------------------------------------------------- /03_HybridBreeding/01_PhenotypicSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Phenotypic selection hybrid maize breeding program 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | 8 | # ---- Clean environment and load packages ---- 9 | rm(list = ls()) 10 | # install.packages(pkgs = "AlphaSimR") 11 | library(package = "AlphaSimR") 12 | 13 | # ---- Load global parameters ---- 14 | source(file = "GlobalParameters.R") 15 | scenarioName = "HybridPheno" 16 | 17 | # ---- Create list to store results from reps ---- 18 | results = list() 19 | 20 | for(REP in 1:nReps){ 21 | cat("Working on REP:", REP,"\n") 22 | 23 | # ---- Create a data frame to track key parameters ---- 24 | output = data.frame(year = 1:nCycles, 25 | rep = rep(REP, nCycles), 26 | scenario = scenarioName, 27 | meanG_inbred = numeric(nCycles), 28 | varG_inbred = numeric(nCycles), 29 | meanG_hybrid = numeric(nCycles), 30 | varG_hybrid = numeric(nCycles), 31 | acc_sel = numeric(nCycles), 32 | cor = numeric(nCycles)) 33 | 34 | # ---- Create initial parents and set testers ---- 35 | source(file = "CreateParents.R") 36 | 37 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 38 | source(file = "FillPipeline.R") 39 | 40 | # ---- Simulate year effects ---- 41 | P = runif(nCycles) 42 | 43 | # ---- Burn-in phase ---- 44 | cat("--> Working on Burn-in \n") 45 | for(year in 1:nBurnin) { 46 | cat(" Working on burnin year:",year,"\n") 47 | source(file = "UpdateParents.R") # Pick new parents 48 | source(file = "UpdateTesters.R") # Pick new testers 49 | source(file = "AdvanceYear.R") # Advance yield trials by a year 50 | source(file = "StoreTrainPop.R") # Store training population 51 | # Report results 52 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 53 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 54 | tmp = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 55 | output$meanG_hybrid[year] = meanG(tmp) 56 | output$varG_hybrid[year] = varG(tmp) 57 | tmp = calcGCA(tmp,use="gv") 58 | output$cor[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 59 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 60 | } 61 | 62 | # ---- Future phase: Phenotypic program ---- 63 | cat("--> Working on Phenotypic hybrid program \n") 64 | output$scenario <- "Pheno" 65 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 66 | cat(" Working on future year:",year,"\n") 67 | source(file = "UpdateParents.R") # Pick new parents 68 | source(file = "UpdateTesters.R") # Pick new testers 69 | source(file = "AdvanceYear.R") # Advance yield trials by a year 70 | # Report results 71 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 72 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 73 | tmp = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 74 | output$meanG_hybrid[year] = meanG(tmp) 75 | output$varG_hybrid[year] = varG(tmp) 76 | tmp = calcGCA(tmp,use="gv") 77 | output$cor[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 78 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 79 | } 80 | 81 | # Save results from current replicate 82 | results = append(results, list(output)) 83 | } 84 | 85 | # Save results 86 | saveRDS(results, file = paste0(scenarioName,".rds")) 87 | 88 | # ---- Analyze results ---- 89 | source(file = "ANALYZERESULTS.R") 90 | -------------------------------------------------------------------------------- /04_Features/functions.R: -------------------------------------------------------------------------------- 1 | # This function calculates Fst among two AlphaSimR populations 2 | calcFst <- function(pop1, pop2) { 3 | # Pop 1 expected heterozygosity 4 | M = pullQtlGeno(pop1) 5 | p1 = colMeans(M)/2 6 | He_pop1 = mean(2*p1*(1-p1)) 7 | # Pop 2 expected heterozygosity 8 | M = pullQtlGeno(pop2) 9 | p2 = colMeans(M)/2 10 | He_pop2 = mean(2*p2*(1-p2)) 11 | # Total pop expected heterozygosity 12 | M = pullQtlGeno(pop) 13 | p = colMeans(M)/2 14 | He_tot = mean(2*p*(1-p)) 15 | # Fst 16 | Hs = (He_pop1*pop1@nInd+He_pop2*pop2@nInd)/pop@nInd 17 | return(data.frame("Fst" = (He_tot-Hs)/He_tot)) 18 | } 19 | 20 | # This function calculates heterozygosity and inbreeding 21 | calcHet <- function(pop) { 22 | geno = pullQtlGeno(pop) 23 | Het = mean(rowMeans(1-abs(geno-1))) 24 | Inb = 1 - Het 25 | return(data.frame(Het, Inb)) 26 | } 27 | 28 | # This function creates maximum avoidance mating plan 29 | maxAvoidPlan = function(nInd, nProgeny = 1L){ 30 | crossPlan = matrix(1:nInd, ncol=2, byrow=TRUE) 31 | tmp = c(seq(1, nInd, by=2), 32 | seq(2, nInd, by=2)) 33 | crossPlan = cbind(rep(tmp[crossPlan[,1]], 34 | each=nProgeny), 35 | rep(tmp[crossPlan[,2]], 36 | each=nProgeny)) 37 | return(crossPlan) 38 | } 39 | 40 | # This function creates circular mating plan 41 | circularPlan = function(nInd, nProgeny = 1) { 42 | crossPlan = rep(1:nInd, each = 2) 43 | crossPlan = c(crossPlan[length(crossPlan)], crossPlan[-(length(crossPlan))]) 44 | crossPlan = matrix(crossPlan, 45 | ncol = 2, byrow = TRUE) 46 | crossPlan = crossPlan[rep(1:nrow(crossPlan), each = nProgeny),] 47 | return(crossPlan) 48 | } 49 | 50 | # This function calculates heterosis 51 | calcHeterosis <- function(popA, popB, hybPop) { 52 | inbMean = (meanG(popA) + meanG(popB))/2 53 | hybMean = meanG(hybPop) 54 | heterosis = meanG(hybPop) - (meanG(popA) + meanG(popB))/2 55 | perHeterosis = (hybMean-inbMean)/inbMean*100 56 | return(data.frame("Midparent value" = inbMean, 57 | "Hybrid value" = hybMean, 58 | "Heterosis" = heterosis, 59 | "Percent heterosis" = perHeterosis)) 60 | } 61 | 62 | # This function calculates mean and variance within and across families 63 | calcVar <- function(pop){ 64 | mother <- pop@mother 65 | father <- pop@father 66 | df <- data.frame( 67 | mother = mother, 68 | father = father 69 | ) 70 | df <- unique(df) 71 | families <- vector(mode = "list", length = nrow(df)) 72 | for (i in 1:nrow(df)) { 73 | mother_i <- df$mother[i] 74 | father_i <- df$father[i] 75 | families_i <- pop@mother == mother_i & pop@father == father_i 76 | tmp <- pop[families_i] 77 | families[[i]] <- tmp 78 | } 79 | avgFam <- mean(sapply(1:nrow(df), function(x) families[[x]]@nInd)) 80 | if (avgFam == 1) { 81 | stop("Families only have a single progeny") 82 | } 83 | totMean <- meanG(pop) 84 | wFamMean <- mean(unlist(lapply(families, meanG))) 85 | totVar <- varG(pop) 86 | wFamVar <- mean(unlist(lapply(families, varG))) 87 | cat("\n=====================================") 88 | cat("\n> Summary of means and variances") 89 | cat("\n=====================================") 90 | cat("\nWhole population") 91 | cat("\n Population size :", pop@nInd) 92 | cat("\n Genetic mean :", round(totMean,2)) 93 | cat("\n Genetic variance :", round(totVar,2)) 94 | cat("\nWithin family") 95 | cat("\n Number of families :", nrow(df)) 96 | cat("\n Average progeny :", round(avgFam,2)) 97 | cat("\n Average genetic mean :", round(wFamMean,2)) 98 | cat("\n Average genetic variance :", round(wFamVar,2)) 99 | cat("\n=====================================\n") 100 | } 101 | -------------------------------------------------------------------------------- /03_HybridBreeding/02_GenomicSelection/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Genomic selection hybrid maize breeding program 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # Applies GS to advance individuals in DH and YT1 as well as to select new 9 | # parents from DH stage. 10 | 11 | # ---- Clean environment and load packages ---- 12 | rm(list = ls()) 13 | # install.packages(pkgs = "AlphaSimR") 14 | library(package = "AlphaSimR") 15 | 16 | # ---- Load global parameters ---- 17 | source(file = "GlobalParameters.R") 18 | scenarioName = "HybridGS" 19 | 20 | # ---- Create list to store results from reps ---- 21 | results = list() 22 | 23 | for(REP in 1:nReps){ 24 | cat("Working on REP:", REP,"\n") 25 | 26 | # ---- Create a data frame to track key parameters ---- 27 | output = data.frame(year = 1:nCycles, 28 | rep = rep(REP, nCycles), 29 | scenario = "", 30 | meanG_inbred = numeric(nCycles), 31 | varG_inbred = numeric(nCycles), 32 | meanG_hybrid = numeric(nCycles), 33 | varG_hybrid = numeric(nCycles), 34 | acc_sel = numeric(nCycles), 35 | cor = numeric(nCycles)) 36 | 37 | # ---- Create initial parents and set testers ---- 38 | source(file = "CreateParents.R") 39 | 40 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 41 | source(file = "FillPipeline.R") 42 | 43 | # ---- Simulate year effects ---- 44 | P = runif(nCycles) 45 | 46 | # ---- Burn-in phase---- 47 | cat("--> Working on Burn-in \n") 48 | for(year in 1:nBurnin) { 49 | cat(" Working on burnin year:",year,"\n") 50 | source(file = "UpdateParents.R") # Pick new parents 51 | source(file = "UpdateTesters.R") # Pick new testers 52 | source(file = "AdvanceYear.R") # Advance yield trials by a year 53 | source(file = "StoreTrainPop.R") # Store training population 54 | # Report results 55 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 56 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 57 | tmp = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 58 | output$meanG_hybrid[year] = meanG(tmp) 59 | output$varG_hybrid[year] = varG(tmp) 60 | tmp = calcGCA(tmp,use="gv") 61 | output$cor[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 62 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 63 | } 64 | 65 | # ---- Future phase: Genomic selection program ---- 66 | cat("--> Working on Genomic hybrid program \n") 67 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 68 | cat(" Working on future year:",year,"\n") 69 | source(file = "RunGSModels.R") # Run genomic model 70 | source(file = "UpdateParents_GS.R") # Pick new parents 71 | source(file = "UpdateTesters.R") # Pick new testers 72 | source(file = "AdvanceYear_GS.R") # Advance yield trials by a year 73 | source(file = "StoreTrainPop.R") # Store training population 74 | # Report results 75 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 76 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 77 | tmp = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 78 | output$meanG_hybrid[year] = meanG(tmp) 79 | output$varG_hybrid[year] = varG(tmp) 80 | tmp = calcGCA(tmp,use="gv") 81 | output$cor[year] = cor(c(tmp$GCAf[,2],tmp$GCAm[,2]), 82 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 83 | } 84 | 85 | # Save results from current replicate 86 | results = append(results, list(output)) 87 | } 88 | 89 | # Save results 90 | saveRDS(results, file = paste0(scenarioName,".rds")) 91 | 92 | # ---- Analyze results ---- 93 | source(file = "ANALYZERESULTS.R") 94 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/AdvanceYear.R: -------------------------------------------------------------------------------- 1 | # Advance year 2 | 3 | # Advance breeding program by 1 year 4 | # Works backwards through pipeline to avoid copying data 5 | 6 | # Stage 10 7 | # Release variety 8 | 9 | # Stage 9 10 | EYT = selectInd(AYT, nEYT) 11 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 12 | 13 | # Stage 8 14 | AYT = selectInd(PYT, nAYT) 15 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 16 | 17 | # Stage 7 18 | output$accSel[year] = accuracy_family(F6) 19 | PYT = selectInd(F6, nPYT) 20 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 21 | 22 | # Stage 6 23 | F6 = vector("list",nCrosses) #Selected plants from each cross 24 | for(i in 1:nCrosses){ # Loop over crosses 25 | n = nInd(F5[[i]]) # Number of rows per cross 26 | F6lines = vector("list",n) # Rows in crosses 27 | F6pheno = numeric(n) # Row phenotypes 28 | for(j in 1:n){ 29 | F6lines[[j]] = F5[[i]][j] # No selfing due to deriving lines 30 | F6_j = self(F5[[i]][j],plantsPerRow) 31 | F6pheno[j] = meanP(F6_j) 32 | } 33 | # Select "nRowF6" F6 rows per cross 34 | take = order(F6pheno,decreasing=TRUE)[1:nRowF6] 35 | F6lines = F6lines[take] 36 | # Derive new lines from rows 37 | F6[[i]] = mergePops(F6lines) 38 | } 39 | F6 = mergePops(F6) 40 | F6 = setPheno(F6, varE = varE, reps = repF6) 41 | 42 | # Stage 5 43 | # Grow selected plants in F5 rows 44 | F5 = vector("list",nCrosses) # Selected plants from each cross 45 | for(i in 1:nCrosses){ # Loop over crosses 46 | n = nInd(F4[[i]]) # Number of rows per cross 47 | F5rows = vector("list",n) # Rows in crosses 48 | F5pheno = numeric(n) # Row phenotypes 49 | for(j in 1:n){ 50 | F5rows[[j]] = self(F4[[i]][j],plantsPerRow) 51 | F5pheno[j] = meanP(F5rows[[j]]) 52 | } 53 | # Select "nSelF5" F5 rows per cross 54 | take = order(F5pheno,decreasing=TRUE)[1:nRowF5] 55 | F5rows = F5rows[take] 56 | # Select "nSelF5" plants per F5 row 57 | for(j in 1:nRowF5){ 58 | F5rows[[j]] = setPheno(F5rows[[j]], varE = varE, reps = 1) 59 | F5rows[[j]] = selectInd(F5rows[[j]],nSelF5) 60 | } 61 | F5[[i]] = mergePops(F5rows) 62 | } 63 | 64 | # Stage 4 65 | # Grow selected plants in F4 rows 66 | F4 = vector("list",nCrosses) # Selected plants from each cross 67 | for(i in 1:nCrosses){ # Loop over crosses 68 | n = nInd(F3[[i]]) # Number of rows per cross 69 | F4rows = vector("list",n) # Rows in crosses 70 | F4pheno = numeric(n) # Row phenotypes 71 | for(j in 1:n){ 72 | F4rows[[j]] = self(F3[[i]][j],plantsPerRow) 73 | F4pheno[j] = meanP(F4rows[[j]]) 74 | } 75 | # Select "nRowF4" F4 rows per cross 76 | take = order(F4pheno,decreasing=TRUE)[1:nRowF4] 77 | F4rows = F4rows[take] 78 | # Select "nSelF4" plants per F4 row 79 | for(j in 1:nRowF4){ 80 | F4rows[[j]] = setPheno(F4rows[[j]], varE = varE, reps = 1) 81 | F4rows[[j]] = selectInd(F4rows[[j]],nSelF4) 82 | } 83 | F4[[i]] = mergePops(F4rows) 84 | } 85 | 86 | # Stage 3 87 | F3 = vector("list",nCrosses) # Selected plants from each cross 88 | for(i in 1:nCrosses){ # Loop over crosses 89 | n = nInd(F2[[i]]) # Number of rows per cross 90 | F3rows = vector("list",n) # Rows in crosses 91 | F3pheno = numeric(n) # Row phenotypes 92 | for(j in 1:n){ 93 | F3rows[[j]] = self(F2[[i]][j],plantsPerRow) 94 | F3pheno[j] = meanP(F3rows[[j]]) 95 | } 96 | # Select "nRowF3" F3 rows per cross 97 | take = order(F3pheno,decreasing=TRUE)[1:nRowF3] 98 | F3rows = F3rows[take] 99 | # Select "nSelF3" plants per selected F3 row 100 | for(j in 1:nRowF3){ 101 | F3rows[[j]] = setPheno(F3rows[[j]], varE = varE, reps = 1) 102 | F3rows[[j]] = selectInd(F3rows[[j]],nSelF3) 103 | } 104 | F3[[i]] = mergePops(F3rows) 105 | } 106 | 107 | # Stage 2 108 | F2 = vector("list",nCrosses) # Keep crosses seperate 109 | for(i in 1:nCrosses){ # Loop over crosses 110 | F2_i = self(F1[i], nProgeny = nF2) 111 | F2_i = setPheno(F2_i, varE = varE, reps = 1) 112 | F2[[i]] = selectInd(F2_i, nInd = nSelF2) 113 | } 114 | 115 | # Stage 1 116 | F1 = randCross(Parents, nCrosses) 117 | -------------------------------------------------------------------------------- /04_Features/simulateGxE.R: -------------------------------------------------------------------------------- 1 | # Script name: Simulation of genotype by environment interaction 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates two approaches to simulate genotype by 8 | # environment with AlphaSimR: 9 | # i) using a single latent environmental covariate 10 | # ii) using correlated traits as environments 11 | 12 | 13 | # ---- Clean environment and load packages ---- 14 | 15 | rm(list = ls()) 16 | # install.packages(pkgs = "AlphaSimR") 17 | packageDescription(pkg = "AlphaSimR")$Version 18 | library(package = "AlphaSimR") 19 | 20 | # ---- Setup simulation ---- 21 | 22 | # Create founder haplotypes 23 | founderPop = runMacs( 24 | nInd = 1000, 25 | nChr = 1, 26 | segSites = 1000, 27 | inbred = TRUE, 28 | species = "WHEAT" 29 | ) 30 | 31 | 32 | # ---- Using latent environment covariate ---- 33 | 34 | # Set simulation parameters 35 | SP = SimParam$new(founderPop) 36 | 37 | # Add additive and GxE trait 38 | SP$addTraitAG(nQtlPerChr = 1000, 39 | mean = 5, 40 | var = 1, 41 | varGxE = 2) 42 | # Check trait slots 43 | str(SP$traits) 44 | 45 | # Create population 46 | pop = newPop(founderPop) 47 | 48 | # Simulate phenotypes for 5 environments with homogeneous error variance 49 | pheno = data.frame( 50 | "Env1" = c(setPheno(pop, varE = 4, p = runif(1), onlyPheno = T)), 51 | "Env2" = c(setPheno(pop, varE = 4, p = runif(1), onlyPheno = T)), 52 | "Env3" = c(setPheno(pop, varE = 4, p = runif(1), onlyPheno = T)), 53 | "Env4" = c(setPheno(pop, varE = 4, p = runif(1), onlyPheno = T)), 54 | "Env5" = c(setPheno(pop, varE = 4, p = runif(1), onlyPheno = T)) 55 | ) 56 | # Sample different p-value from uniform distribution for the environmental covariate 57 | 58 | # Summarize per environment 59 | boxplot(pheno) 60 | # Note that pairwise correlations between environments will be different each time 61 | summary(cor(pheno)[upper.tri(cor(pheno))]) 62 | 63 | # Calculate mean across 5 environments and select top 10 genotypes 64 | pop@pheno = as.matrix(rowMeans(pheno)) 65 | pop2 = selectInd(pop, nInd = 10) 66 | 67 | # Check heritabilities 68 | (1/(1+2/5+4/5)) # expected mean-line h2 69 | cor(gv(pop),pheno(pop))^2 # observed mean-line h2 70 | 71 | (1/(1+2/1+4/1)) # expected plot-level h2 72 | mean(cor(gv(pop),pheno)^2) # observed plot-level h2 73 | 74 | 75 | 76 | # ---- Simulate 5 correlated traits as environments ---- 77 | 78 | # Set simulation parameters 79 | SP = SimParam$new(founderPop) 80 | 81 | # Specify correlation between traits 82 | set.seed(123) 83 | nEnv = 5 # No. of environments 84 | traitCor = matrix(0, nEnv, nEnv) 85 | traitCor[upper.tri(traitCor)] = runif(nEnv * (nEnv - 1)/2, 0.4, 1) 86 | traitCor = traitCor + t(traitCor); diag(traitCor) = 1 87 | # traitCor = matrix(1, ncol = nEnv, nrow = nEnv) # no GxE 88 | traitCor 89 | 90 | # Create five traits 91 | SP$addTraitAG( 92 | nQtlPerChr = 1000, 93 | mean = rep(5, nEnv), 94 | var = rep(1, nEnv), 95 | varGxE = rep(2, nEnv), 96 | corA = traitCor 97 | ) 98 | 99 | # Create population 100 | pop = newPop(founderPop) 101 | 102 | # Check difference between simulated and true correlations 103 | summary(cov2cor(varG(pop))[upper.tri(cov2cor(varG(pop)))]) 104 | cov2cor(varG(pop))-traitCor 105 | 106 | # Simulate phenotypes for 5 environments with homogeneous error variance 107 | pop = setPheno(pop, varE = rep(4, nEnv)) 108 | 109 | # Summarize per environment 110 | boxplot(pheno(pop)) 111 | # Note that pairwise correlations between environments will be more or less constant 112 | cov2cor(varP(pop)) 113 | summary(cor(pheno(pop))[upper.tri(cor(pheno(pop)))]) 114 | 115 | # Calculate mean across 5 environments and select top 10 genotypes 116 | pheno = as.matrix(rowMeans(pop@pheno)) 117 | pop2 = pop[order(pheno, decreasing = T)][1:10] 118 | # if selection based on fewer environments is desired, e.g. 3... 119 | # pheno = as.matrix(rowMeans(pop@pheno[,1:3])) 120 | 121 | # Check heritabilities 122 | (1/(1+2/5+4/5)) # expected mean-line h2 123 | cor(rowMeans(gv(pop)),pheno)^2 # observed mean-line h2 124 | 125 | (1/(1+2/1+4/1)) # expected plot-level h2 126 | mean(diag(cor(gv(pop),pop@pheno)))^2 # mean plot-level h2 127 | -------------------------------------------------------------------------------- /04_Features/simulateGWAS.R: -------------------------------------------------------------------------------- 1 | # Script name: Performing association study with simulated population 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates how to simulate a population for a GWAS 8 | # study. The simulation starts off by creating a single homogeneous 9 | # population which then undergoes a few rounds of selection 10 | # to induce stratification. 11 | 12 | # ---- Clean environment and load packages ---- 13 | 14 | rm(list = ls()) 15 | # install.packages(pkgs = c("AlphaSimR", "ade4", "ggplot2", "rrBLUP", "qqman") 16 | library(package = "AlphaSimR") 17 | library(package = "ade4") 18 | library(package = "ggplot2") 19 | library(package = "rrBLUP") 20 | library(package = "qqman") 21 | 22 | # ---- Setup simulation ---- 23 | 24 | # Generate founder haplotypes 25 | founderPop = runMacs( 26 | nInd = 1000, 27 | nChr = 10, 28 | segSites = 300, 29 | inbred = FALSE, 30 | # split = 100, # alternative way to split population 31 | species = "GENERIC" 32 | ) 33 | 34 | # Set simulation parameters 35 | SP = SimParam$new(founderPop) 36 | 37 | # Force QTLs and SNPs to overlap 38 | SP$restrSegSites(overlap = T) 39 | 40 | # Create additive trait with 5 QTLs per chromosome 41 | SP$addTraitAG(nQtlPerChr = 5, 42 | mean = 0, 43 | var = 1) 44 | 45 | # Add SNP-chip with 300 SNPs per chromosome 46 | SP$addSnpChip(nSnpPerChr = 300) 47 | 48 | # Check that QTLs and SNPs overlap 49 | sum(getQtlMap(trait = 1)$id %in% getSnpMap(1)$id) 50 | 51 | # ---- Create two subpopulations ---- 52 | 53 | pop = newPop(founderPop) 54 | popA = pop[1:500] 55 | popB = pop[501:1000] 56 | # Few rounds of crossing and selection 57 | # Alternatively, set split in runMaCS call and skip this 58 | for (i in 1:3) { 59 | popA = selectCross(popA, nInd = 50, nCrosses = 100, nProgeny = 5, use = "gv") 60 | popB = selectCross(popB, nInd = 100, nCrosses = 500, use = "gv") 61 | } 62 | pop = c(popA, popB) 63 | pop = setPheno(pop, h2 = 0.4) 64 | 65 | # ---- Visualise two sub-populations with PCA ---- 66 | 67 | geno = pullQtlGeno(pop) 68 | PCA = dudi.pca(df = geno, center = T, scale = F, scannf = F, nf = 5) 69 | (VAF = 100 * PCA$eig[1:5] / sum(PCA$eig)) # variance explained 70 | df.PCA = data.frame( 71 | "Pop" = c(rep("Pop1", popA@nInd), rep("Pop2", popB@nInd)), 72 | "PC1" = PCA$l1$RS1, 73 | "PC2" = PCA$l1$RS2) 74 | 75 | # Plot 76 | ggplot(df.PCA, aes(x = PC1, y = PC2)) + 77 | geom_point(aes(colour = factor(Pop))) + 78 | ggtitle("Population structure") + 79 | xlab(paste("Pcomp1: ", round(VAF[1], 2), "%", sep = "")) + 80 | ylab(paste("Pcomp2: ", round(VAF[2], 2), "%", sep = "")) 81 | 82 | # ---- Run GWAS ---- 83 | 84 | # Prepare data 85 | pheno = data.frame(id = 1:pop@nInd, 86 | pheno = pop@pheno, 87 | subPop = factor(c( 88 | rep("Pop1", popA@nInd), 89 | rep("Pop2", popB@nInd) 90 | ))) 91 | geno = pullSnpGeno(pop) 92 | geno = data.frame( 93 | snp = colnames(geno), 94 | chr = rep(1:10, each = 300), 95 | pos = rep(1:300, 10), 96 | t(geno - 1) 97 | ) 98 | colnames(geno)[-c(1:3)] = 1:pop@nInd 99 | 100 | # Run three GWAS models 101 | model1 = GWAS(pheno[, -3], geno, plot = F) 102 | model2 = GWAS(pheno[, -3], geno, n.PC = 3, plot = F) 103 | model3 = GWAS(pheno, geno, fixed = "subPop", plot = F) 104 | 105 | # Obtain p values 106 | model1$Trait1 = 10 ^ (-model1$Trait1) 107 | model2$Trait1 = 10 ^ (-model2$Trait1) 108 | model3$Trait1 = 10 ^ (-model3$Trait1) 109 | 110 | # Get true positions of QTLs 111 | qtl = as.vector(getQtlMap(trait = 1)$id) 112 | 113 | # Check Manhattan plot 114 | par(mfrow = c(3, 1)) 115 | manhattan(model1, chr = "chr", bp = "pos", p = "Trait1", snp = "snp", highlight = qtl, 116 | main = "Marker") 117 | manhattan(model2, chr = "chr", bp = "pos", p = "Trait1", snp = "snp", highlight = qtl, 118 | main = "Marker + principal components") 119 | manhattan(model3, chr = "chr", bp = "pos", p = "Trait1", snp = "snp", highlight = qtl, 120 | main = "Marker + subpopulation factor") 121 | 122 | # Check QQ-plot 123 | par(mfrow = c(3, 1)) 124 | qq(model1$Trait1, main = "Marker") 125 | qq(model2$Trait1, main = "Marker + principal components") 126 | qq(model3$Trait1, main = "Marker + subpopulation factor") 127 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Plant breeding simulations with AlphaSimR 2 | 3 | ## Introduction 4 | 5 | This repository contains R scripts that demonstrate simulations of plant breeding programs and techniques using AlphaSimR https://cran.r-project.org/package=AlphaSimR. These scripts and the process of simulating plant breeding programs are described in Bancic et al. (2024) Crop Science https://doi.org/10.1002/csc2.21312 6 | 7 | @article{Banci2024Plant, 8 | title = {Plant breeding simulations with {AlphaSimR}}, 9 | author = {Bančič, Jon and Greenspoon, Philip and Gaynor, R Chris and Gorjanc, Gregor}, 10 | journal = {Crop Science}, 11 | year = {2024}, 12 | doi = {10.1002/csc2.21312}, 13 | url = {https://doi.org/10.1002/csc2.21312} 14 | } 15 | 16 | If you use this material, please cite the above publication and the original AlphaSimR publication Gaynor et al. (2021) G3 https://doi.org/10.1093/g3journal/jkaa017 17 | 18 | @article{Gaynor2021AlphaSimR, 19 | author = {Gaynor, R. Chris and Gorjanc, Gregor and Hickey, John M.}, 20 | title = {{AlphaSimR}: An {R}-package for Breeding Program Simulations}, 21 | journal = {G3: Genes|Genomes|Genetics}, 22 | year = {2021}, 23 | doi = {10.1093/g3journal/jkaa017}, 24 | url = {https://doi.org/10.1093/g3journal/jkaa017} 25 | } 26 | 27 | If you have no prior experience with AlphaSimR, we suggest you complete the free online course "Breeding Programme Modelling with AlphaSimR" at https://www.edx.org/course/breeding-programme-modelling-with-alphasimr. The course is continually open, so you can enroll when it's convenient for you. 28 | 29 | If you are interested in animal breeding simulations, see https://github.com/HighlanderLab/gmafrafortuna_alphasimr_animals (work in progress) ... 30 | 31 | ## Repository contents 32 | 33 | * `README.md` is this file. 34 | 35 | * `LineBreeding.Rmd` (and its output `LineBreeding.html`) - Introductory vignette describing the logic of provided R scripts. 36 | 37 | * `jbancic_alphasimr_plants.Rproj` is the RStudio/Posit project file (to set the working directory etc.). 38 | 39 | * `01_LineBreeding` folder contains scripts for simulating a line breeding program - showing a wheat example that can be adapted to other selfing species. The scripts show several phenotypic selection strategies (mass selection, single seed descent, pedigree selection, and doubled haploids) and genomic selection strategies (conventional and two-part). 40 | 41 | * `02_ClonalBreeding` folder contains scripts for simulating a clonal breeding program - showing a tea example that can be adapted to other clonal species. The scripts show phenotypic, pedigree, or genomic selection strategies. 42 | 43 | * `03_HybridBreeding` folder contains scripts for simulating a hybrid breeding program - showing a maize example that can be adapted to other outcrossing species. The scripts show a phenotypic selection strategy and two genomic selection strategies (conventional and two-part). 44 | 45 | * `04_Features` folder contains scripts for simulating plant breeding programs using various breeding and genetic techniques. The scripts show: 46 | 47 | * Mating plans (`matingPlans.R`) 48 | 49 | * Genome-wide association study (`simulateGWAS.R`) 50 | 51 | * Setting heritability (`setHeritability.R`) 52 | 53 | * Multi-trait selection with selection index (`multipleTraits.R`) 54 | 55 | * Miscellaneous slot to store user-defined information (`miscellaneousSlot.R`) 56 | 57 | * Simulate genotype by environment interaction (`simulateGxE.R`) 58 | 59 | * Genomic prediction & selection models (`genomicModels.R`) 60 | 61 | * Trait introgression (`traitIntrogression.R`) 62 | 63 | * Genome editing (`genomeEditing.R`) 64 | 65 | * Speed breeding (`speedBreeding.R`) 66 | 67 | * Import external haplotypes (`importExternalHaplo.R`) 68 | 69 | * Specifying demography for simulating founder genomes (`specifyDemography.R`) 70 | 71 | * Extra functions used across scripts (`functions.R`) 72 | 73 | ## How to work with the provided R scripts 74 | 75 | 1) Read the manuscript and browse the introductory vignette `LineBreeding.Rmd` (and its output `LineBreeding.html`). 76 | 77 | 1) Download this whole repository 78 | 79 | 2) In RStudio/Posit, open project file `jbancic_alphasimr_plants.Rproj` 80 | 81 | 3) For each of the three types of plant breeding programs, select a folder 82 | and work through the `00RUNME.R` file to run simulations and then work through 83 | the `ANALYZERESULTS.R` file to analyze the simulations' results. 84 | -------------------------------------------------------------------------------- /04_Features/traitIntrogression.R: -------------------------------------------------------------------------------- 1 | # Script name: Speed breeding 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # This script models a simple trait introgression scheme using AlphaSimR. 9 | # 10 | # The scheme models a species with 2 chromosomes having a genetic length 11 | # of 1 Morgan. 12 | # 13 | # Genetic markers spaced 10 cM apart will be used to track IBD between an 14 | # inbred donor line and an inbred recurrent parent. The recurrent parent 15 | # will have the '1' allele at all loci and the donor parent will have the 16 | # '0' allele. 17 | # 18 | # A single locus representing a trait being introgressed will be added 19 | # to the middle of the first chromosome. The donor parent will have the 20 | # '1' allele at this locus and the recurrent parent will have the '0' allele. 21 | # 22 | # The simulation will model three rounds of backcrossing followed by selfing 23 | # to obtain homozygous lines for the trait being introgressed. Only plants 24 | # containing the trait in the heterozygous state are advanced after 25 | # backcrossing. 26 | 27 | # ---- Clean environment and load packages ---- 28 | 29 | rm(list = ls()) 30 | # install.packages(pkgs = "AlphaSimR") 31 | library(package = AlphaSimR) 32 | 33 | # ---- Setup simulation ---- 34 | 35 | # Create a genetic map with 2 chromosomes. 36 | # Each chromosome has a genetic length of 1 with markers 37 | # spaced 10 cM apart (11 markers per chromosome). 38 | genMap = data.frame( 39 | markerName = paste0("M", 1:(2 * 11)), 40 | chromosome = rep(1:2, each = 11), 41 | position = rep(seq(from = 0, to = 1, by = 0.1), times = 2) 42 | ) 43 | 44 | # Create genotypes for parents 45 | geno = rbind(rep(2, 2 * 11), 46 | rep(0, 2 * 11)) 47 | colnames(geno) = genMap$markerName 48 | 49 | # Create pedigree with just IDs 50 | # RP stands for recurrent parent 51 | ped = data.frame( 52 | id = c("RP", "Donor"), 53 | mother = c(0, 0), 54 | father = c(0, 0) 55 | ) 56 | 57 | # Create initial founder population 58 | founderPop = importInbredGeno(geno = geno, 59 | genMap = genMap, 60 | ped = ped) 61 | 62 | # Add the trait being introgressed 63 | # The RP has genotype 0 (c(0,0) haplotypes) 64 | # The donor has genotype 2 (c(1,1) haplotypes) 65 | founderPop = addSegSite( 66 | founderPop, 67 | siteName = "Trait", 68 | chr = 1, 69 | mapPos = 0.5, 70 | haplo = matrix(c(0, 0, 71 | 1, 1), ncol = 1) 72 | ) 73 | 74 | # Initialize the simulation parameters 75 | SP = SimParam$new(founderPop) 76 | 77 | # Exclude "Trait" as an eligible SNP marker 78 | SP$restrSegSites(excludeSnp = "Trait") 79 | 80 | # Add a SNP chip for the remaining sites 81 | SP$addSnpChip(nSnpPerChr = 11) 82 | 83 | # ---- Parents and Introgression via backcrossing ---- 84 | 85 | # Create separate population for the recurrent and donor parents 86 | RP = newPop(founderPop[1]) 87 | Donor = newPop(founderPop[2]) 88 | 89 | # Create an F1 plant, only one needed because parents are fully inbred 90 | F1 = randCross2(RP, Donor, nCrosses = 1) 91 | 92 | # Create BC1F1 by backcrossing to the recurrent parent 93 | BC1F1 = randCross2(F1, RP, nCrosses = 1000) 94 | 95 | # Select BC1F1 for presence of trait 96 | take = pullMarkerGeno(BC1F1, "Trait") == 1 97 | BC1F1 = BC1F1[take] 98 | 99 | # Create BC2F1 generation and select for trait 100 | BC2F1 = randCross2(BC1F1, RP, nCrosses = 1000) 101 | take = pullMarkerGeno(BC2F1, "Trait") == 1 102 | BC2F1 = BC2F1[take] 103 | 104 | # Create BC3F1 generation and select for trait 105 | BC3F1 = randCross2(BC2F1, RP, nCrosses = 1000) 106 | take = pullMarkerGeno(BC3F1, "Trait") == 1 107 | BC3F1 = BC3F1[take] 108 | 109 | # Create BC3F2 generation with selfing 110 | BC3F2 = self(BC3F1) 111 | 112 | # Select progeny that are homozygous for the trait 113 | take = pullMarkerGeno(BC3F2, "Trait") == 2 114 | BC3F2 = BC3F2[take] 115 | 116 | # ---- IBD analysis ---- 117 | 118 | # Pull SNP genotypes and divide by 2 to show IBD 119 | IBD = pullSnpGeno(BC3F2) / 2 120 | 121 | # Show IBD distribution as percentage by individuals 122 | IBD_ind = rowMeans(IBD) * 100 123 | hist(IBD_ind, xlab = "Percent IBD", main = "Distribution of IBD in BC3F2") 124 | 125 | # Show IBD distribution by marker 126 | # Could be made much prettier using ggplot2 127 | # Note that M6 co-localizes with the trait, so it will 128 | # have zero IBD with the recurrent parent. 129 | boxplot(IBD, main = "Distribution of IBD by marker in BC3F2") 130 | -------------------------------------------------------------------------------- /04_Features/specifyDemography.R: -------------------------------------------------------------------------------- 1 | # Script name: Specifying species demography in AlphaSimR 2 | # 3 | # Authors: Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 4 | # 5 | # Date Created: 2023-01-23 6 | # 7 | # This script demonstrates how to specify your own demographic history 8 | # when using MaCS simulator of founders' genomes with AlphaSimR. 9 | # Parameters are chosen hypothetically and would normally be obtained 10 | # from literature. 11 | 12 | # ---- Clean environment and load packages ---- 13 | 14 | rm(list = ls()) 15 | # install.packages(pkgs = "AlphaSimR") 16 | library(package = "AlphaSimR") 17 | 18 | # Load in function to calculate Fst statistic 19 | 20 | # ---- Example 1: Specify simple demographic history ---- 21 | 22 | manualCommand = runMacs2( 23 | nInd = 100, 24 | nChr = 10, 25 | segSites = 1000, 26 | Ne = 100, 27 | bp = 1e+08, 28 | genLen = 1, 29 | mutRate = 3e-08, 30 | histNe = c(500, 1500, 6000, 12e3, 1e5), 31 | histGen = c(100, 1000, 10000, 1e5, 1e6), 32 | ploidy = 2L, 33 | inbred = T, 34 | returnCommand = TRUE 35 | ) 36 | manualCommand 37 | 38 | # Create founder haplotypes with desired demography 39 | founderPop = runMacs( 40 | nInd = 100, 41 | nChr = 10, 42 | segSites = 1000, 43 | inbred = TRUE, 44 | manualGenLen = 1, 45 | manualCommand = manualCommand 46 | ) 47 | 48 | # Set simulation parameters 49 | SP = SimParam$new(founderPop) 50 | 51 | # Create founder population 52 | pop = newPop(founderPop) 53 | 54 | # ---- Example 2: Specify demographic history of wheat as in AlphaSimR ---- 55 | 56 | manualCommand = runMacs2( 57 | nInd = 100, 58 | nChr = 10, 59 | segSites = 1000, 60 | Ne = 50, 61 | bp = 8e+08, 62 | genLen = 1.43, 63 | mutRate = 2e-09, 64 | histNe = c(50, 100, 200, 300, 400, 500, 600, 700, 800, 900, 1e3, 2e3, 3e3, 4e3, 5e3, 6e3, 7e3, 8e3, 9e3, 10e3, 12e3, 16e3, 20e3, 24e3, 28e3, 32e3), 65 | histGen = c( 5, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 200, 400, 600, 800, 1e3, 2e3, 4e3, 6e3, 8e3, 10e3, 20e3, 40e3, 60e3, 80e3, 10e4), 66 | ploidy = 2L, 67 | inbred = TRUE, 68 | # split = 100, # optional time of population split 69 | returnCommand = TRUE 70 | ) 71 | manualCommand 72 | 73 | # Create founder haplotypes with desired demography 74 | founderPop = runMacs( 75 | nInd = 100, 76 | nChr = 10, 77 | segSites = 1000, 78 | inbred = TRUE, 79 | manualGenLen = 1, 80 | manualCommand = manualCommand 81 | ) 82 | 83 | # The above call is equivalent to pre-defined "WHEAT" species call in AlphaSimR 84 | # founderPop = runMacs(nInd = 100, 85 | # nChr = 10, 86 | # segSites = 1000, 87 | # Ne = 50, 88 | # ploidy = 2L, 89 | # inbred = TRUE, 90 | # # split = 100, # optional time of population split 91 | # species = "WHEAT") 92 | 93 | # Set simulation parameters 94 | SP = SimParam$new(founderPop) 95 | SP$addTraitA(1000) 96 | 97 | # Create founder population 98 | pop = newPop(founderPop) 99 | pop1 = pop[1:50] # first half as Population 1 100 | pop2 = pop[51:100] # second half as Population 2 101 | calcFst(pop1, pop2) # Fst statistic ~ 0 since no split is specified 102 | 103 | # ---- Example 3: Modify a MaCS call ---- 104 | 105 | # Simple MaCS call 106 | manualCommand = runMacs2( 107 | nInd = 100, 108 | nChr = 10, 109 | segSites = 1000, 110 | Ne = 100, 111 | bp = 1e+08, 112 | genLen = 1, 113 | mutRate = 3e-08, 114 | histNe = c(500, 1500, 6000, 12e3, 1e5), 115 | histGen = c(100, 1000, 10000, 1e5, 1e6), 116 | ploidy = 2L, 117 | inbred = TRUE, 118 | returnCommand = TRUE 119 | ) 120 | manualCommand 121 | 122 | # This function creates a call for population split in which each 123 | # population has a different effective population size 124 | #' @param Ne effective population size 125 | #' @param histNe effective population size at the time of split 126 | #' @param split historic population split in terms of generations ago 127 | calcMacs <- function(Ne, histNe, split) { 128 | if (length(histNe) != 2) { 129 | "Works only for two subpopulatons" 130 | } 131 | return = paste0(" -ej ", split / (4 * Ne), 132 | " -n 1 ", c(histNe / Ne)[1], 133 | " -n 2 ", c(histNe / Ne)[2]) 134 | return(return) 135 | } 136 | newCommand = calcMacs(Ne = 100, 137 | histNe = c(100, 50), 138 | split = 50) 139 | newCommand 140 | 141 | # Merge commands 142 | paste0(manualCommand, newCommand) 143 | -------------------------------------------------------------------------------- /01_LineBreeding/01_PhenotypicSelection/03_PedigreeSelection/FillPipeline.R: -------------------------------------------------------------------------------- 1 | # Fill breeding pipeline 2 | 3 | # Set initial yield trials with unique individuals 4 | for(cohort in 1:9){ 5 | cat("FillPipeline stage:",cohort,"of 9\n") 6 | if(cohort < 10){ 7 | # Stage 1 8 | F1 = randCross(Parents, nCrosses) 9 | } 10 | if(cohort < 9){ 11 | # Stage 2 12 | F2 = vector("list",nCrosses) # Keep crosses seperate 13 | for(i in 1:nCrosses){ # Loop over crosses 14 | F2_i = self(F1[i], nProgeny = nF2) 15 | F2_i = setPheno(F2_i, varE = varE, reps = 1) 16 | F2[[i]] = selectInd(F2_i, nInd = nSelF2) 17 | } 18 | } 19 | if(cohort < 8){ 20 | # Stage 3 21 | F3 = vector("list",nCrosses) # Selected plants from each cross 22 | for(i in 1:nCrosses){ # Loop over crosses 23 | n = nInd(F2[[i]]) # Number of rows per cross 24 | F3rows = vector("list",n) # Rows in crosses 25 | F3pheno = numeric(n) # Row phenotypes 26 | for(j in 1:n){ 27 | F3rows[[j]] = self(F2[[i]][j],plantsPerRow) 28 | F3pheno[j] = meanP(F3rows[[j]]) 29 | } 30 | # Select "nRowF3" F3 rows per cross 31 | take = order(F3pheno,decreasing=TRUE)[1:nRowF3] 32 | F3rows = F3rows[take] 33 | # Select "nSelF3" plants per selected F3 row 34 | for(j in 1:nRowF3){ 35 | F3rows[[j]] = setPheno(F3rows[[j]], varE = varE, reps = 1) 36 | F3rows[[j]] = selectInd(F3rows[[j]],nSelF3) 37 | } 38 | F3[[i]] = mergePops(F3rows) 39 | } 40 | } 41 | if(cohort < 7){ 42 | # Stage 4 43 | # Grow selected plants in F4 rows 44 | F4 = vector("list",nCrosses) # Selected plants from each cross 45 | for(i in 1:nCrosses){ # Loop over crosses 46 | n = nInd(F3[[i]]) # Number of rows per cross 47 | F4rows = vector("list",n) # Rows in crosses 48 | F4pheno = numeric(n) # Row phenotypes 49 | for(j in 1:n){ 50 | F4rows[[j]] = self(F3[[i]][j],plantsPerRow) 51 | F4pheno[j] = meanP(F4rows[[j]]) 52 | } 53 | # Select "nRowF4" F4 rows per cross 54 | take = order(F4pheno,decreasing=TRUE)[1:nRowF4] 55 | F4rows = F4rows[take] 56 | # Select "nSelF4" plants per F4 row 57 | for(j in 1:nRowF4){ 58 | F4rows[[j]] = setPheno(F4rows[[j]], varE = varE, reps = 1) 59 | F4rows[[j]] = selectInd(F4rows[[j]],nSelF4) 60 | } 61 | F4[[i]] = mergePops(F4rows) 62 | } 63 | } 64 | if(cohort < 6){ 65 | # Stage 5 66 | # Grow selected plants in F5 rows 67 | F5 = vector("list",nCrosses) # Selected plants from each cross 68 | for(i in 1:nCrosses){ # Loop over crosses 69 | n = nInd(F4[[i]]) # Number of rows per cross 70 | F5rows = vector("list",n) # Rows in crosses 71 | F5pheno = numeric(n) # Row phenotypes 72 | for(j in 1:n){ 73 | F5rows[[j]] = self(F4[[i]][j],plantsPerRow) 74 | F5pheno[j] = meanP(F5rows[[j]]) 75 | } 76 | # Select "nSelF5" F5 rows per cross 77 | take = order(F5pheno,decreasing=TRUE)[1:nRowF5] 78 | F5rows = F5rows[take] 79 | # Select "nSelF5" plants per F5 row 80 | for(j in 1:nRowF5){ 81 | F5rows[[j]] = setPheno(F5rows[[j]], varE = varE, reps = 1) 82 | F5rows[[j]] = selectInd(F5rows[[j]],nSelF5) 83 | } 84 | F5[[i]] = mergePops(F5rows) 85 | } 86 | } 87 | if(cohort < 5){ 88 | # Stage 6 89 | # Grow selected plants in F6 rows 90 | F6 = vector("list",nCrosses) # Selected plants from each cross 91 | for(i in 1:nCrosses){ # Loop over crosses 92 | n = nInd(F5[[i]]) # Number of rows per cross 93 | F6lines = vector("list",n) # Rows in crosses 94 | F6pheno = numeric(n) # Row phenotypes 95 | for(j in 1:n){ 96 | F6lines[[j]] = F5[[i]][j] # No selfing due to deriving lines 97 | F6_j = self(F5[[i]][j],plantsPerRow) 98 | F6pheno[j] = meanP(F6_j) 99 | } 100 | # Select "nRowF6" F6 rows per cross 101 | take = order(F6pheno,decreasing=TRUE)[1:nRowF6] 102 | F6lines = F6lines[take] 103 | ##Derive new lines from rows 104 | F6[[i]] = mergePops(F6lines) 105 | } 106 | F6 = mergePops(F6) 107 | F6 = setPheno(F6, varE = varE, reps = repF6) 108 | } 109 | if(cohort < 4){ 110 | # Stage 7 111 | # Test newly derived lines in PYT 112 | PYT = selectInd(F6, nPYT) 113 | PYT = setPheno(PYT, varE = varE, reps = repPYT) 114 | } 115 | if(cohort < 3){ 116 | # Stage 8 117 | # AYT 118 | AYT = selectInd(PYT, nAYT) 119 | AYT = setPheno(AYT, varE = varE, reps = repAYT) 120 | } 121 | if(cohort < 2){ 122 | # Stage 9 123 | # EYT 124 | EYT = selectInd(AYT, nEYT) 125 | EYT = setPheno(EYT, varE = varE, reps = repEYT) 126 | } 127 | } 128 | -------------------------------------------------------------------------------- /03_HybridBreeding/03_TwoPartGS/00RUNME.R: -------------------------------------------------------------------------------- 1 | # Script name: Two-part genomic selection hybrid maize breeding program 2 | # 3 | # Authors: Initially developed by Chris Gaynor; exanded/polished for this 4 | # publication by Jon Bancic, Philip Greenspoon, Chris Gaynor, Gregor Gorjanc 5 | # 6 | # Date Created: 2023-01-23 7 | # 8 | # Uses two-part strategy with rapid cycling of parents in population improvement 9 | # and conventional breeding for product development. Applies GS to advance 10 | # individuals from DH to YT1 as well as in population improvement. 11 | 12 | # ---- Clean environment and load packages ---- 13 | rm(list = ls()) 14 | # install.packages(pkgs = "AlphaSimR") 15 | library(package = "AlphaSimR") 16 | 17 | # ---- Load global parameters ---- 18 | source(file = "GlobalParameters.R") 19 | scenarioName = "HybridGSTP" 20 | 21 | # ---- Create list to store results from reps ---- 22 | results = list() 23 | results_accPI = list() 24 | 25 | for(REP in 1:nReps){ 26 | cat("Working on REP:", REP,"\n") 27 | 28 | # ---- Create a data frame to track key parameters ---- 29 | output = data.frame(year = 1:nCycles, 30 | rep = rep(REP, nCycles), 31 | scenario = "", 32 | meanG_inbred = numeric(nCycles), 33 | varG_inbred = numeric(nCycles), 34 | meanG_hybrid = numeric(nCycles), 35 | varG_hybrid = numeric(nCycles), 36 | acc_sel = numeric(nCycles), 37 | cor = numeric(nCycles)) 38 | 39 | # ---- Create initial parents and set testers ---- 40 | source(file = "CreateParents.R") 41 | 42 | # ---- Fill breeding pipeline with unique individuals from initial parents ---- 43 | source(file = "FillPipeline.R") 44 | 45 | # ---- Simulate year effects ---- 46 | P = runif(nCycles) 47 | 48 | # ---- Burn-in phase ---- 49 | cat("--> Working on Burn-in \n") 50 | for(year in 1:nBurnin) { 51 | cat(" Working on burnin year:",year,"\n") 52 | source(file = "UpdateParents.R") # Pick new parents 53 | source(file = "UpdateTesters.R") # Pick new testers 54 | source(file = "AdvanceYear.R") # Advance yield trials by a year 55 | source(file = "StoreTrainPop.R") # Store training population 56 | # Report results 57 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 58 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 59 | tmpHybrids = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 60 | output$meanG_hybrid[year] = meanG(tmpHybrids) 61 | output$varG_hybrid[year] = varG(tmpHybrids) 62 | tmpHybrids = calcGCA(tmpHybrids, use = "gv") 63 | output$cor[year] = cor(c(tmpHybrids$GCAf[,2],tmpHybrids$GCAm[,2]), 64 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 65 | } 66 | 67 | # ---- Future phase: Two-Part Genomic selection program ---- 68 | cat("--> Working on Two-Part Genomic hybrid program \n") 69 | # Parameters for population improvement 70 | nCyclesPI = 2 # Number of cycles per year 71 | nParentsPI = 30 # Number of selected individuals per cycle 72 | nCrossMalePI = 100 # Number of male crosses per cycle 73 | nCrossFemalePI = 100 # Number of female crosses per cycle 74 | nProgenyPI = 10 # Number of progeny per cross 75 | maxFamPI = 1 # Maximum number of selected individuals per cross 76 | nMaleF1PI = 80 # Number of F1-PI to advance to PD 77 | nFemaleF1PI = 80 # Number of F1-PI to advance to PD 78 | # Create a data frame to track selection accuracy in every PI cycle 79 | accPI = data.frame(accPI = numeric(nFuture*nCyclesPI)) 80 | 81 | for(year in (nBurnin+1):(nBurnin+nFuture)) { 82 | cat(" Working on future year:",year,"\n") 83 | source(file = "RunGSModels.R") # Run genomic model 84 | source(file = "UpdateTesters.R") # Pick new testers 85 | source(file = "AdvanceYear_GSTP.R") # Advance yield trials by a year and cycle parents 86 | source(file = "StoreTrainPop.R") # Store training population 87 | # Report results 88 | output$meanG_inbred[year] = (meanG(MaleInbredYT3) + meanG(FemaleInbredYT3))/2 89 | output$varG_inbred[year] = (varG(MaleInbredYT3) + varG(FemaleInbredYT3))/2 90 | tmpHybrids = hybridCross(FemaleInbredYT3, MaleInbredYT3, returnHybridPop=TRUE) 91 | output$meanG_hybrid[year] = meanG(tmpHybrids) 92 | output$varG_hybrid[year] = varG(tmpHybrids) 93 | tmpHybrids = calcGCA(tmpHybrids, use = "gv") 94 | output$cor[year] = cor(c(tmpHybrids$GCAf[,2],tmpHybrids$GCAm[,2]), 95 | c(FemaleInbredYT3@gv[,1],MaleInbredYT3@gv[,1])) 96 | } 97 | 98 | # Save results from current replicate 99 | results = append(results, list(output)) 100 | results_accPI = append(results_accPI, list(accPI)) 101 | } 102 | 103 | # Save results 104 | saveRDS(results, file = paste0(scenarioName,".rds")) 105 | saveRDS(results_accPI, file = paste0(scenarioName,"_accPI.rds")) 106 | 107 | # ---- Analyze results ---- 108 | source(file = "ANALYZERESULTS.R") 109 | --------------------------------------------------------------------------------