### Simulations of breeding programs for a monogenic trait ### ### JWM Bastiaansen et al, The impact of genome editing on the introduction of monogenic traits in livestock ### ### Genetics, Selection, Evolution, 2018 ### rm(list = ls()) require(pedigree) setwd("/home/") ### functions makeOffspring <- function(sires = NA , dams = NA, ped = NA , littersize = NA , currYear = NA, heritability = NA , reliability = NA){ nOffspring <- length(dams$ident)*littersize last <- ped[ped$ident == max(ped$ident),] ped$F <- calcInbreeding(ped) offspring <- data.frame( ident = (last$ident+1):(last$ident+nOffspring) , sire = rep(sample(sires$ident, replace = TRUE, size = length(dams$ident)), littersize) , dam = rep(dams$ident, littersize), sex = sample(c("m","f"), replace = TRUE, size = nOffspring), bDay = currYear , BV = NA , PE = rnorm(nOffspring, mean = 0 , sd = (1/reliability -1)) , all1 = NA , all2 = NA) offspring$BV <- (ped$BV[match(offspring$sire, ped$ident)]/2 + ped$BV[match(offspring$dam , ped$ident)]/2 + rnorm(nOffspring , mean = 0 , sd = sqrt(0.5*(1-0.5*(ped$F[match(offspring$sire, ped$ident)] + ped$F[match(offspring$dam , ped$ident)]))))) offspring$all1 <- apply(ped[match(offspring$sire, ped$ident),match(c("all1","all2"),names(ped))], 1, function(x) sample(x, size =1)) offspring$all2 <- apply(ped[match(offspring$dam, ped$ident),match(c("all1","all2"),names(ped))], 1, function(x) sample(x, size =1)) return(offspring) } #### START Populations scenarios <- read.table(file = "GEscenarios_fish.csv", sep = "," , stringsAsFactors = FALSE, header = TRUE) outFile <- paste(format(Sys.time(),"%y%m%d_%H_%M") , "_GEoutput", ".csv" , sep = "") writeLines( paste(names(scenarios) , collapse = ",") , con = outFile ) for(s in 1:nrow(scenarios)){ simPar <- scenarios[s,] for(r in 1:simPar$replicates){ nPairsEdited <- vector() #### founder generations startYears <- seq(from = -max(c(simPar$mAgeMax,simPar$fAgeMax)), to = -min(c(simPar$mAgeMin,simPar$fAgeMin)), by = simPar$interval) + simPar$interval startYears <- startYears[startYears %% simPar$interval == 0] nFounders <- simPar$nFemale*simPar$littersize*length(startYears) ped <- data.frame(ident = 1:nFounders, sire = NA, dam = NA, sex = sample(c("m","f"), replace = TRUE, size = nFounders) , bDay = rep(startYears , nFounders/length(startYears)), BV = rnorm( n = nFounders , mean = 0 , sd = 1) , PE = rnorm( n = nFounders , mean = 0 , sd = (1/simPar$reliability -1)) , all1 = sample(c(0,1), replace = TRUE , prob = c((1-simPar$p1),simPar$p1) , size = nFounders) , all2 = sample(c(0,1), replace = TRUE , prob = c((1-simPar$p1),simPar$p1) , size = nFounders) ) ### reproduction and selection before GE for(cycle in 1:(simPar$nYears1/simPar$interval)){ ## cycle <- 3 ; cycle <- 1 currYear <- max(ped$bDay) + simPar$interval # retrieve parents in reproductive age sires <- ped[ ped$sex == "m" & ped$bDay <= (currYear - simPar$mAgeMin) & ped$bDay >= (currYear - simPar$mAgeMax),] dams <- ped[ ped$sex == "f" & ped$bDay <= (currYear - simPar$fAgeMin) & ped$bDay >= (currYear - simPar$fAgeMax),] # check if parents are available if(nrow(dams) < simPar$nFemale) warning(paste("fewer dams than required nFemale in year", currYear)) if(nrow(sires) < simPar$nMale) warning(paste("fewer sires than required nMale in year", currYear)) if(nrow(dams)>0 & nrow(sires)>0){ ### Selection is on the EBV of the quantitative trait only. if(simPar$selectionMethod_phase1 == "EBV"){ sires <- sires[order( (sires$BV + sires$PE), decreasing = TRUE) , ][ 1:min(simPar$nMale,nrow(sires)),] dams <- dams[order( ( dams$BV + dams$PE), decreasing = TRUE) , ][ 1:min(simPar$nFemale,nrow(dams)),] } ### Selection is at random. if(simPar$selectionMethod_phase1 == "random"){ sires <- sires[order( rnorm(nrow(sires)), decreasing = TRUE) , ][ 1:min(simPar$nMale,nrow(sires)),] dams <- dams[order( rnorm(nrow( dams)), decreasing = TRUE) , ][ 1:min(simPar$nFemale,nrow(dams)),] } ### Selection is on an index of the EBV and the monogenic genotype. if(simPar$selectionMethod_phase1 == "index"){ sires <- sires[order( simPar$indexEBV*(sires$BV + sires$PE) + simPar$indexMonogenic*(sires$all1+sires$all2) , decreasing = TRUE) , ][ 1:min(simPar$nMale,nrow(sires)),] dams <- dams[order( simPar$indexEBV*( dams$BV + dams$PE) + simPar$indexMonogenic*( dams$all1+ dams$all2) , decreasing = TRUE) , ][ 1:min(simPar$nFemale,nrow(dams)),] } # Make offspring of selected parents offspring <- makeOffspring(sires = sires, dams = dams, ped = ped, littersize = simPar$littersize, currYear = currYear, heritability = simPar$heritability, reliability = simPar$reliability) ped <- rbind(ped, offspring) } } ### reproduction and selection after start of GE for(cycle in 1:(simPar$nYears2/simPar$interval)){ currYear <- max(ped$bDay) + simPar$interval # retrieve parents in reproductive age sires <- ped[ ped$sex == "m" & ped$bDay <= (currYear - simPar$mAgeMin) & ped$bDay >= (currYear - simPar$mAgeMax),] dams <- ped[ ped$sex == "f" & ped$bDay <= (currYear - simPar$fAgeMin) & ped$bDay >= (currYear - simPar$fAgeMax),] # check if parents are available if(nrow(dams)>0 & nrow(sires)>0){ ### Selection is on the EBV of the quantitative trait only. if(simPar$selectionMethod_phase2 == "EBV"){ sires <- sires[order( (sires$BV + sires$PE), decreasing = TRUE) , ][ 1:min(simPar$nMale,nrow(sires)),] dams <- dams[order( ( dams$BV + dams$PE), decreasing = TRUE) , ][ 1:min(simPar$nFemale,nrow(dams)),] } ### Selection is on an index of the EBV and the monogenic genotype. if(simPar$selectionMethod_phase2 == "index"){ sires <- sires[order( simPar$indexEBV*(sires$BV + sires$PE) + simPar$indexMonogenic*(sires$all1+sires$all2) , decreasing = TRUE) , ][ 1:min(simPar$nMale,nrow(sires)),] dams <- dams[order( simPar$indexEBV*( dams$BV + dams$PE) + simPar$indexMonogenic*( dams$all1+ dams$all2) , decreasing = TRUE) , ][ 1:min(simPar$nFemale,nrow(dams)),] } # Make offspring of selected parents offspring <- makeOffspring(sires = sires, dams = dams, ped = ped, littersize = simPar$littersize, currYear = currYear, heritability = simPar$heritability, reliability = simPar$reliability) # Editing of offspring if(simPar$editOffspring){ ## Select litters targetted for editing based on parent average if(simPar$editTopNpairs == 0) nPairsEdited <- c(nPairsEdited, 0) if(simPar$editTopNpairs > 0){ ### which pairs pairs4editedOffspring <- offspring[,names(offspring) %in% c("sire" , "dam")] ## keep each parent pair once pairs4editedOffspring <- pairs4editedOffspring[!duplicated(pairs4editedOffspring),] ## add sire BV etc. pairs4editedOffspring <- merge(pairs4editedOffspring, ped[, names(ped) %in% c("ident", "BV" , "PE" , "all1", "all2")], by.x = "sire", by.y = "ident", all.x = TRUE, all.y = FALSE) names(pairs4editedOffspring)[3:6] <- paste ("s" , names(pairs4editedOffspring)[3:6], sep = "") ## add dam BV etc. pairs4editedOffspring <- merge(pairs4editedOffspring, ped[, names(ped) %in% c("ident", "BV" , "PE" , "all1", "all2")], by.x = "dam", by.y = "ident", all.x = TRUE, all.y = FALSE) names(pairs4editedOffspring)[7:10] <- paste ("d" , names(pairs4editedOffspring)[7:10], sep = "") ## calculate parent average pairs4editedOffspring$pa <- with(pairs4editedOffspring, sBV + sPE + dBV + dPE) ## calculate parent allele frequency pairs4editedOffspring$pf <- with(pairs4editedOffspring, sall1 + sall2 + dall1 + dall2) ## ranking and selecting N litters to become GE target # on GENOTYPE (increasing pf) AND Parent AVERAGE (decreasing pa) pairs4editedOffspring <- pairs4editedOffspring[order( pairs4editedOffspring$pf, -pairs4editedOffspring$pa) , ][ 1:simPar$editTopNpairs,] ## count pairs were editing is needed nPairsEdited <- c(nPairsEdited, sum(pairs4editedOffspring$pf < 4)) ## remove pairs where editing is not needed pairs4editedOffspring <- pairs4editedOffspring[(pairs4editedOffspring$pf < 4) ,] ## only keep the names of the parents in pairs4..etc pairs4editedOffspring <- paste(pairs4editedOffspring$sire, pairs4editedOffspring$dam, sep = "_") ### perform the edits ### editing of all1 offspring$all1[which(offspring$all1 == 0 & paste(offspring$sire, offspring$dam, sep = "_") %in% pairs4editedOffspring & sample(c(FALSE,TRUE), size = nrow(offspring), replace = TRUE, prob = c( (1-simPar$editSuccess) , simPar$editSuccess)))] <- 1 ### editing of all2 offspring$all2[which(offspring$all2 == 0 & paste(offspring$sire, offspring$dam, sep = "_") %in% pairs4editedOffspring & sample(c(FALSE,TRUE), size = nrow(offspring), replace = TRUE, prob = c( (1-simPar$editSuccess) , simPar$editSuccess)))] <- 1 ### remove animals due to editing mortalities offspring <- offspring[!(paste(offspring$sire, offspring$dam, sep = "_") %in% pairs4editedOffspring & sample(c(TRUE,FALSE), size = nrow(offspring), replace = TRUE, prob = c(simPar$editMortality , ( 1- simPar$editMortality)))),] } } ped <- rbind(ped, offspring) } } #### summarizing of results years <- unique(ped$bDay) BVmean <- tapply(ped$BV, ped$bDay, mean) BVvar <- tapply(ped$BV, ped$bDay, var) monogenicFreq <- tapply( (ped$all1 + ped$all2) , ped$bDay, function(x){sum(x)/(2*length(x))}) ped$F <- calcInbreeding(ped) Fmean <- tapply(ped$F, ped$bDay, mean) Rg <- tapply(1:nrow(ped) , ped$bDay, function(x){cor(ped$BV[x],(ped$all1[x] + ped$all2[x]))}) GEout <- paste( paste( simPar , collapse = ",") , paste(round(years,0) , collapse = ",") , paste(round(BVmean,5) , collapse = ",") , paste(round(BVvar,5) , collapse = ",") , paste(round(monogenicFreq,5) , collapse = ",") , paste(round(Fmean,5) , collapse = ",") , paste(round(Rg,5) , collapse = ",") , paste(nSiresEdited , collapse = ",") , paste(nDamsEdited , collapse = ",") , paste(nPairsEdited , collapse = ",") , sep = ",") write.table(GEout, file = outFile , append = TRUE , col.names = FALSE, row.names = FALSE, quote = FALSE) } }