# NOT RUN {
######################################################
# Example 1: Advanced OCS using pedigree data #
######################################################
### Prepare pedigree data
data(PedigWithErrors)
data(Phen)
Pedig <- prePed(PedigWithErrors, keep=Phen$Indiv,
thisBreed="Hinterwaelder", lastNative=1970)
Pedig$NC <- pedBreedComp(Pedig, thisBreed="Hinterwaelder")$native
Phen <- merge(Pedig, Phen[,c("Indiv", "BV")], by="Indiv")
pKin <- pedIBD(Pedig, keep.only=Phen$Indiv)
pKinatN <- pedIBDatN(Pedig, thisBreed="Hinterwaelder", keep.only=Phen$Indiv)
cand <- candes(phen=Phen, pKin=pKin, pKinatN=pKinatN)
head(cand$phen)
######################################################
# Objective: Maximize genetic gain in Angler cattle #
# Constraints: #
# - mean kinship #
# - mean kinship at native alleles #
# - genetic contributions from other breeds #
######################################################
# Define constraints for the next generation
Ne <- 100
con <- list(uniform="female")
con$ub.pKin <- cand$mean$pKin + (1-cand$mean$pKin )*(1/(2*Ne))
con$ub.pKinatN <- cand$mean$pKinatN + (1-cand$mean$pKinatN)*(1/(2*Ne))
con$lb.NC <- 1.03*cand$mean$NC
# Compute the genetic progress achievable
Offspring <- opticont("max.BV", cand, con, trace=FALSE)
# Check if the optimization problem is solved
Offspring$info
# valid solver status
#1 TRUE cccp2 optimal
# Average values of traits and kinships
Offspring$mean
# NC BV pKin pKinatN
#1 0.4362558 0.5140699 0.02573526 0.07993624
Offspring$mean$BV
# Value of the objective function
Offspring$obj.fun
# BV
#0.5140699
# Data frame with optimum contributions
head(Offspring$parent)
# See how much the values deviate from the constraints
Offspring$summary
######################################################
# Further Examples: Advanced OCS using genotype data #
######################################################
# }
# NOT RUN {
### Prepare genotype data
library("optiSel")
data(map)
data(Cattle)
dir <- system.file("extdata", package = "optiSel")
files<- file.path(dir, paste("Chr", 1:2, ".phased", sep=""))
### Compute genomic kinship and genomic kinship at native segments
G <- segIBD(files, map, minL=2.0)
GN <- segIBDatN(files, Cattle, map, thisBreed="Angler", refBreeds="others", minL=2.0)
### Compute migrant contributions of selection candidates
Haplo<- haplofreq(files, Cattle, map, thisBreed="Angler", refBreeds="others",
minL=2.0, what="match")
Comp <- segBreedComp(Haplo$match, map)
Cattle$NC <- NA
Cattle[rownames(Comp), "NC"] <- Comp$native
apply(Comp[,-1],2,mean)
# native F H R
#0.43798759 0.02997242 0.24603493 0.28600506
######################################################
# Objective: Minimize inbreeding in Angler cattle #
# Constraints: #
# - breeding values #
# - mean kinship at native alleles #
# - genetic contributions from other breeds #
######################################################
cand <- candes(phen=Cattle[Cattle$Breed=="Angler",], sKin=G, sKinatN=GN)
# Define Constraints for the next generation
Ne <- 100
con <- list(uniform="female")
con$ub.sKinatN <- cand$mean$sKinatN + (1-cand$mean$sKinatN)*(1/(2*Ne))
con$lb.NC <- 1.03*cand$mean$NC
con$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
Offspring$mean
# Value of the objective function
Offspring$obj.fun
# sKin
#0.03977612
######################################################
# Objective: Maximize breeding value in Angler #
# Constraints: #
# - kinship at native alleles #
# - kinship across breeds #
######################################################
cand <- candes(phen=Cattle, sKin=G, sKinatN.Angler=GN)
Unif <- c("Angler.female", "Fleckvieh", "Holstein", "Rotbunt")
con <- list(uniform=Unif, ub.sKin=0.027, ub.sKinatN.Angler=0.06)
Offspring <- opticont("max.BV", cand, con, trace=FALSE)
Offspring$mean
Offspring$obj.fun
# BV
#0.4986473
######################################################
# Objective: Minimize kinship across breeds #
# Constraints: #
# - native contributions #
# - breeding values #
# by optimizing contributions of Angler males #
######################################################
Unif <- c("Angler.female", "Fleckvieh", "Holstein", "Rotbunt")
con <- list(uniform=Unif, ub.sKinatN.Angler=0.06, lb.NC=0.7, lb.BV=0.5)
Offspring <- opticont("min.sKin", cand, con, trace=FALSE)
Offspring$mean
Offspring$obj.fun
# sKin
#0.02953495
######################################################
# Objective: Maximize breeding values in all breeds #
# Constraints: #
# - average kinships within each breed #
# - average kinships across breeds #
# - average native kinship of Angler #
# - average native contribution in Angler #
# by optimizing contributions of males from all breeds#
######################################################
set.seed(1)
Phen <- Cattle
Phen[Phen$Breed!="Angler","BV"] <- rnorm(sum(Phen$Breed!="Angler")) #simulate BV
cand <- candes(phen=Phen, sKin=G, sKinatN.Angler=GN)
Unif <- paste0(c("Angler", "Fleckvieh", "Holstein", "Rotbunt"), ".female")
con <- list(uniform = Unif,
ub.sKin = cand$mean$sKin - 0.002,
ub.sKin.Angler = cand$mean$sKin.Angler + 0.005,
ub.sKin.Holstein = cand$mean$sKin.Holstein + 0.005,
ub.sKin.Rotbunt = cand$mean$sKin.Rotbunt + 0.005,
ub.sKin.Fleckvieh= cand$mean$sKin.Fleckvieh+ 0.005,
ub.sKinatN.Angler= cand$mean$sKinatN.Angler+ 0.005,
lb.NC = cand$mean$NC + 0.05)
Offspring <- opticont("max.BV", cand, con, trace=FALSE)
Offspring$mean
Offspring$obj.fun
# BV
#0.6440849
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab