## For other objective functions and constraints see the vignettes
######################################################
# Example 1: Advanced OCS with overlapping #
# generations using pedigree data #
# - maximize genetic gain (BV) #
# - restrict increase of mean kinship (pKin) #
# - restrict increase of native kinship (pKinatN)#
# - avoid decrease of native contribution (NC) #
######################################################
### Define object cand containing all required
### information on the individuals
data(PedigWithErrors)
Pedig <- prePed(PedigWithErrors, thisBreed="Hinterwaelder", lastNative=1970,
keep=PedigWithErrors$Born%in%1992)
Pedig$NC <- pedBreedComp(Pedig, thisBreed="Hinterwaelder")$native
use <- Pedig$Born %in% (1980:1990) & Pedig$Breed=="Hinterwaelder"
use <- use & summary(Pedig)$equiGen>=3
cont <- agecont(Pedig, use, maxAge=10)
Phen <- Pedig[use, ]
pKin <- pedIBD(Pedig, keep.only=Phen$Indiv)
pKinatN <- pedIBDatN(Pedig, thisBreed="Hinterwaelder", keep.only=Phen$Indiv)
Phen$isCandidate <- Phen$Born < 1990
cand <- candes(phen=Phen, pKin=pKin, pKinatN=pKinatN, cont=cont)
### Mean values of the parameters in the population:
cand$mean
# BV NC pKin pKinatN
#1 -0.5648208 0.5763161 0.02305245 0.0469267
### Define constraints for OCS
### Ne: Effective population size
### L: Generation interval
Ne <- 100
L <- 1/(4*cont$male[1]) + 1/(4*cont$female[1])
con <- list(uniform = "female",
ub.pKin = 1-(1-cand$mean$pKin)*(1-1/(2*Ne))^(1/L),
ub.pKinatN = 1-(1-cand$mean$pKinatN)*(1-1/(2*Ne))^(1/L),
lb.NC = cand$mean$NC)
### Solve the optimization problem
Offspring <- opticont("max.BV", cand, con, trace=FALSE)
### Expected average values of traits and kinships
### in the population now and at the next evaluation time
rbind(cand$mean, Offspring$mean)
# BV NC pKin pKinatN
#1 -0.5648208 0.5763161 0.02305245 0.04692670
#2 -0.4972679 0.5763177 0.02342014 0.04790944
### Data frame with optimum contributions
Candidate <- Offspring$parent
Candidate[Candidate$oc>0.01, c("Indiv", "Sex", "BV", "NC", "lb", "oc", "ub")]
######################################################
# Example 2: Advanced OCS with overlapping #
# generations using genotype data #
# - minimize mean kinship (sKin) #
# - restrict increase of native kinship (sKinatN)#
# - avoid decrease of breeding values (BV) #
# - cause increase of native contribution (NC) #
######################################################
if (FALSE) {
### Prepare genotype data
data(map)
data(Cattle)
### Compute genomic kinship and genomic kinship at native segments
dir <- system.file("extdata", package = "optiSel")
files <- file.path(dir, paste("Chr", 1:2, ".phased", sep=""))
sKin <- segIBD(files, map, minL=1.0)
sKinatN <- segIBDatN(files, Cattle, map, thisBreed="Angler", minL=1.0)
### Compute migrant contributions of selection candidates
Haplo <- haplofreq(files, Cattle, map, thisBreed="Angler", minL=1.0, what="match")
Comp <- segBreedComp(Haplo$match, map)
Cattle[Comp$Indiv, "NC"] <- Comp$native
Phen <- Cattle[Cattle$Breed=="Angler",]
cand <- candes(phen=Phen, sKin=sKin, sKinatN=sKinatN, cont=cont)
### Define constraints for OCS
### Ne: Effective population size
### L: Generation interval
Ne <- 100
L <- 4.7
con <- list(uniform = "female",
ub.sKinatN = 1-(1-cand$mean$sKinatN)*(1-1/(2*Ne))^(1/L),
lb.NC = 1.03*cand$mean$NC,
lb.BV = cand$mean$BV)
# Compute optimum contributions; the objective is to minimize mean kinship
Offspring <- opticont("min.sKin", cand, con=con)
# Check if the optimization problem is solved
Offspring$info
# Average values of traits and kinships
rbind(cand$mean, Offspring$mean)
# BV NC sKin sKinatN
#1 -0.07658022 0.4117947 0.05506277 0.07783431
#2 -0.07657951 0.4308061 0.04830328 0.06395410
# Value of the objective function
Offspring$obj.fun
# sKin
#0.04830328
### Data frame with optimum contributions
Candidate <- Offspring$parent
Candidate[Candidate$oc>0.01, c("Indiv", "Sex", "BV", "NC", "lb", "oc", "ub")]
#######################################################
# Example 3: Advanced OCS with overlapping #
# generations using genotype data #
# for multiple breeds or beeding lines #
# - Maximize breeding values in all breeds #
# - restrict increase of kinships within each breed #
# - reduce average kinship across breeds #
# - restrict increase of native kinship in Angler #
# - cause increase of native contribution in Angler #
# by optimizing contributions of males from all breeds#
#######################################################
cand <- candes(phen=Cattle, sKin=sKin, sKinatN.Angler=sKinatN, cont=cont)
L <- 5
Ne <- 100
con <- list(uniform = "female",
ub.sKin = cand$mean$sKin - 0.01/L,
ub.sKin.Angler = 1-(1-cand$mean$sKin.Angler)*(1-1/(2*Ne))^(1/L),
ub.sKin.Holstein = 1-(1-cand$mean$sKin.Holstein)*(1-1/(2*Ne))^(1/L),
ub.sKin.Rotbunt = 1-(1-cand$mean$sKin.Rotbunt)*(1-1/(2*Ne))^(1/L),
ub.sKin.Fleckvieh= 1-(1-cand$mean$sKin.Fleckvieh)*(1-1/(2*Ne))^(1/L),
ub.sKinatN.Angler= 1-(1-cand$mean$sKinatN.Angler)*(1-1/(2*Ne))^(1/L),
lb.NC = cand$mean$NC + 0.05/L)
Offspring <- opticont("max.BV", cand, con, trace=FALSE, solver="slsqp")
Offspring$mean
Candidate <- Offspring$parent[Offspring$parent$Sex=="male", ]
Candidate[Candidate$oc>0.01, c("Indiv", "Sex", "BV", "NC", "lb", "oc", "ub")]
}
Run the code above in your browser using DataLab