This document will show how to specify traits with dominance in AlphaSimR. It will also introduce how the choice dominance degree of parameters effects dominance variance and inbreeding depression, before concluding with a demonstration of the properties of breeding values.

Specifying a trait with dominance

The below script shows how to specify a trait with dominance in AlphaSimR and shows how dominance degree information can be accessed.

Inbreeding depression

The below code demonstrates inbreeding depression using a single generation of selfing.

meanG(pop2)
   Trait1 
-6.239667 

Directional dominance (\(\mu_\delta>0\)) is required for the presence of inbreeding depression. This is showed below first by using a simulation without directional dominance show the absence of inbreeding depression.

# Assign variables to store 
domVar = meanSelf = numeric(100)

# Perform 100 replicates of the above selfing experiment without directional dominance
# The variance of dominance degree is set to a high value for high dominance variance
for(i in 1:100){
  founderPop = quickHaplo(nInd=100, nChr=10, segSites=1000)
  
  SP = SimParam$
    new(founderPop)$
    addTraitAD(nQtlPerChr=1000,
               meanDD=0,
               varDD=2)$
    setVarE(H2=1)
  
  pop = newPop(founderPop)
  
  pop2 = self(pop)
  
  domVar[i] = varD(pop)
  meanSelf[i] = meanG(pop2)
}

# Plot a histogram for dominance variance
hist(domVar, 
     main="Dominance variance Gen 0",
     xlab="Dominance variance")


# Plot a histogram for inbreeding depression
hist(meanSelf, 
     main="Mean after selfing",
     xlab="Mean genetic value")

The script below shows the presence of directional dominance results in inbreeding depression. This happens even though dominance genetic variance is considerably lower in this second scenario.

# Assign variable to store the mean and variance
domVar = meanSelf = numeric(100)

# Perform 100 replicates of the selfing experiment using modest directional dominance
for(i in 1:100){
  founderPop = quickHaplo(nInd=100, nChr=10, segSites=1000)
  
  SP = SimParam$
    new(founderPop)$
    addTraitAD(nQtlPerChr=1000,
               meanDD=0.2,
               varDD=0)$
    setVarE(H2=1)
  
  pop = newPop(founderPop)
  
  pop2 = self(pop)
  
  domVar[i] = varD(pop)
  meanSelf[i] = meanG(pop2)
}

hist(domVar, 
     main="Dominance variance Gen 0",
     xlab="Dominance variance")


hist(meanSelf, 
     main="Mean after selfing",
     xlab="Mean genetic value")

Demonstrate breeding value properties

The below code shows the relationship between progeny testing and breeding values under ideal circumstances. The resulting plots illustrate why it is said that parents contribute half of their breeding value to their progeny.

cor(pheno(pop), gv(pop))
       Trait1
[1,] 0.815338
LS0tCnRpdGxlOiAiUXVhbnRpdGF0aXZlIEdlbmV0aWNzOiBEb21pbmFuY2UgRWZmZWN0cywgUGFydCAxIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpUaGlzIGRvY3VtZW50IHdpbGwgc2hvdyBob3cgdG8gc3BlY2lmeSB0cmFpdHMgd2l0aCBkb21pbmFuY2UgaW4gQWxwaGFTaW1SLiBJdCB3aWxsIGFsc28gaW50cm9kdWNlIGhvdyB0aGUgY2hvaWNlIGRvbWluYW5jZSBkZWdyZWUgb2YgcGFyYW1ldGVycyBlZmZlY3RzIGRvbWluYW5jZSB2YXJpYW5jZSBhbmQgaW5icmVlZGluZyBkZXByZXNzaW9uLCBiZWZvcmUgY29uY2x1ZGluZyB3aXRoIGEgZGVtb25zdHJhdGlvbiBvZiB0aGUgcHJvcGVydGllcyBvZiBicmVlZGluZyB2YWx1ZXMuCgojIyBTcGVjaWZ5aW5nIGEgdHJhaXQgd2l0aCBkb21pbmFuY2UKClRoZSBiZWxvdyBzY3JpcHQgc2hvd3MgaG93IHRvIHNwZWNpZnkgYSB0cmFpdCB3aXRoIGRvbWluYW5jZSBpbiBBbHBoYVNpbVIgYW5kIHNob3dzIApob3cgZG9taW5hbmNlIGRlZ3JlZSBpbmZvcm1hdGlvbiBjYW4gYmUgYWNjZXNzZWQuCgpgYGB7cn0KbGlicmFyeShBbHBoYVNpbVIpCgpmb3VuZGVyUG9wID0gcXVpY2tIYXBsbyhuSW5kPTEwMCwgbkNocj0xMCwgc2VnU2l0ZXM9MTAwMCkKClNQID0gU2ltUGFyYW0kCiAgbmV3KGZvdW5kZXJQb3ApJAogIGFkZFRyYWl0QUQoblF0bFBlckNocj0xMDAwLAogICAgICAgICAgICAgbWVhbkREPTAuMiwKICAgICAgICAgICAgIHZhckREPTAuMSkkCiAgc2V0VmFyRShIMj0xKQoKcG9wID0gbmV3UG9wKGZvdW5kZXJQb3ApCgojIEV4YW1pbmUgdGhlIHBhcnRpdGlvbmluZyBvZiBnZW5ldGljIHZhcmlhbmNlCnZhckcocG9wKQp2YXJBKHBvcCkgIyBTZXQgdG8gMSBieSBTaW1QYXJhbSBkZWZhdWx0cwp2YXJEKHBvcCkKCiMgQWNjZXNzIHRoZSBhZGRpdGl2ZSBhbmQgZG9taW5hbmNlIGVmZmVjdHMgYW5kIGJhY2stc29sdmUgZm9yIGRvbWluYW5jZSBkZWdyZWUKYSA9IFNQJHRyYWl0c1tbMV1dQGFkZEVmZgpkID0gU1AkdHJhaXRzW1sxXV1AZG9tRWZmCmRlbHRhID0gZC9hYnMoYSkKCm1lYW4oZGVsdGEpCnZhcihkZWx0YSkKaGlzdChkZWx0YSkKYGBgCgojIyBJbmJyZWVkaW5nIGRlcHJlc3Npb24KClRoZSBiZWxvdyBjb2RlIGRlbW9uc3RyYXRlcyBpbmJyZWVkaW5nIGRlcHJlc3Npb24gdXNpbmcgYSBzaW5nbGUgZ2VuZXJhdGlvbiBvZiBzZWxmaW5nLgoKYGBge3J9CnBvcDIgPSBzZWxmKHBvcCkKCm1lYW5HKHBvcDIpCmBgYAoKRGlyZWN0aW9uYWwgZG9taW5hbmNlICgkXG11X1xkZWx0YT4wJCkgaXMgcmVxdWlyZWQgZm9yIHRoZSBwcmVzZW5jZSBvZiBpbmJyZWVkaW5nIGRlcHJlc3Npb24uIFRoaXMgaXMgc2hvd2VkIGJlbG93IGZpcnN0IGJ5IHVzaW5nIGEgc2ltdWxhdGlvbiB3aXRob3V0IGRpcmVjdGlvbmFsIGRvbWluYW5jZSBzaG93IHRoZSBhYnNlbmNlIG9mIGluYnJlZWRpbmcgZGVwcmVzc2lvbi4KCmBgYHtyfQojIEFzc2lnbiB2YXJpYWJsZXMgdG8gc3RvcmUgCmRvbVZhciA9IG1lYW5TZWxmID0gbnVtZXJpYygxMDApCgojIFBlcmZvcm0gMTAwIHJlcGxpY2F0ZXMgb2YgdGhlIGFib3ZlIHNlbGZpbmcgZXhwZXJpbWVudCB3aXRob3V0IGRpcmVjdGlvbmFsIGRvbWluYW5jZQojIFRoZSB2YXJpYW5jZSBvZiBkb21pbmFuY2UgZGVncmVlIGlzIHNldCB0byBhIGhpZ2ggdmFsdWUgZm9yIGhpZ2ggZG9taW5hbmNlIHZhcmlhbmNlCmZvcihpIGluIDE6MTAwKXsKICBmb3VuZGVyUG9wID0gcXVpY2tIYXBsbyhuSW5kPTEwMCwgbkNocj0xMCwgc2VnU2l0ZXM9MTAwMCkKICAKICBTUCA9IFNpbVBhcmFtJAogICAgbmV3KGZvdW5kZXJQb3ApJAogICAgYWRkVHJhaXRBRChuUXRsUGVyQ2hyPTEwMDAsCiAgICAgICAgICAgICAgIG1lYW5ERD0wLAogICAgICAgICAgICAgICB2YXJERD0yKSQKICAgIHNldFZhckUoSDI9MSkKICAKICBwb3AgPSBuZXdQb3AoZm91bmRlclBvcCkKICAKICBwb3AyID0gc2VsZihwb3ApCiAgCiAgZG9tVmFyW2ldID0gdmFyRChwb3ApCiAgbWVhblNlbGZbaV0gPSBtZWFuRyhwb3AyKQp9CgojIFBsb3QgYSBoaXN0b2dyYW0gZm9yIGRvbWluYW5jZSB2YXJpYW5jZQpoaXN0KGRvbVZhciwgCiAgICAgbWFpbj0iRG9taW5hbmNlIHZhcmlhbmNlIEdlbiAwIiwKICAgICB4bGFiPSJEb21pbmFuY2UgdmFyaWFuY2UiKQoKIyBQbG90IGEgaGlzdG9ncmFtIGZvciBpbmJyZWVkaW5nIGRlcHJlc3Npb24KaGlzdChtZWFuU2VsZiwgCiAgICAgbWFpbj0iTWVhbiBhZnRlciBzZWxmaW5nIiwKICAgICB4bGFiPSJNZWFuIGdlbmV0aWMgdmFsdWUiKQpgYGAKClRoZSBzY3JpcHQgYmVsb3cgc2hvd3MgdGhlIHByZXNlbmNlIG9mIGRpcmVjdGlvbmFsIGRvbWluYW5jZSByZXN1bHRzIGluIGluYnJlZWRpbmcgZGVwcmVzc2lvbi4gVGhpcyBoYXBwZW5zIGV2ZW4gdGhvdWdoIGRvbWluYW5jZSBnZW5ldGljIHZhcmlhbmNlIGlzIGNvbnNpZGVyYWJseSBsb3dlciBpbiB0aGlzIHNlY29uZCBzY2VuYXJpby4KCgpgYGB7cn0KIyBBc3NpZ24gdmFyaWFibGUgdG8gc3RvcmUgdGhlIG1lYW4gYW5kIHZhcmlhbmNlCmRvbVZhciA9IG1lYW5TZWxmID0gbnVtZXJpYygxMDApCgojIFBlcmZvcm0gMTAwIHJlcGxpY2F0ZXMgb2YgdGhlIHNlbGZpbmcgZXhwZXJpbWVudCB1c2luZyBtb2Rlc3QgZGlyZWN0aW9uYWwgZG9taW5hbmNlCmZvcihpIGluIDE6MTAwKXsKICBmb3VuZGVyUG9wID0gcXVpY2tIYXBsbyhuSW5kPTEwMCwgbkNocj0xMCwgc2VnU2l0ZXM9MTAwMCkKICAKICBTUCA9IFNpbVBhcmFtJAogICAgbmV3KGZvdW5kZXJQb3ApJAogICAgYWRkVHJhaXRBRChuUXRsUGVyQ2hyPTEwMDAsCiAgICAgICAgICAgICAgIG1lYW5ERD0wLjIsCiAgICAgICAgICAgICAgIHZhckREPTApJAogICAgc2V0VmFyRShIMj0xKQogIAogIHBvcCA9IG5ld1BvcChmb3VuZGVyUG9wKQogIAogIHBvcDIgPSBzZWxmKHBvcCkKICAKICBkb21WYXJbaV0gPSB2YXJEKHBvcCkKICBtZWFuU2VsZltpXSA9IG1lYW5HKHBvcDIpCn0KCmhpc3QoZG9tVmFyLCAKICAgICBtYWluPSJEb21pbmFuY2UgdmFyaWFuY2UgR2VuIDAiLAogICAgIHhsYWI9IkRvbWluYW5jZSB2YXJpYW5jZSIpCgpoaXN0KG1lYW5TZWxmLCAKICAgICBtYWluPSJNZWFuIGFmdGVyIHNlbGZpbmciLAogICAgIHhsYWI9Ik1lYW4gZ2VuZXRpYyB2YWx1ZSIpCgpgYGAKCiMjIERlbW9uc3RyYXRlIGJyZWVkaW5nIHZhbHVlIHByb3BlcnRpZXMKClRoZSBiZWxvdyBjb2RlIHNob3dzIHRoZSByZWxhdGlvbnNoaXAgYmV0d2VlbiBwcm9nZW55IHRlc3RpbmcgYW5kIGJyZWVkaW5nIHZhbHVlcyB1bmRlciBpZGVhbCBjaXJjdW1zdGFuY2VzLiBUaGUgcmVzdWx0aW5nIHBsb3RzIGlsbHVzdHJhdGUgd2h5IGl0IGlzIHNhaWQgdGhhdCBwYXJlbnRzIGNvbnRyaWJ1dGUgaGFsZiBvZiB0aGVpciBicmVlZGluZyB2YWx1ZSB0byB0aGVpciBwcm9nZW55LgoKYGBge3J9CmZvdW5kZXJQb3AgPSBxdWlja0hhcGxvKG5JbmQ9MTAwLCBuQ2hyPTEwLCBzZWdTaXRlcz0xMDAwKQoKU1AgPSBTaW1QYXJhbSQKICBuZXcoZm91bmRlclBvcCkkCiAgYWRkVHJhaXRBRChuUXRsUGVyQ2hyPTEwMDAsCiAgICAgICAgICAgICBtZWFuREQ9MC4yLAogICAgICAgICAgICAgdmFyREQ9MC42LAogICAgICAgICAgICAgbWVhbj0xMCkkCiAgc2V0VmFyRShIMj0xKQoKcG9wID0gbmV3UG9wKGZvdW5kZXJQb3ApCgojIFBsb3QgYnJlZWRpbmcgdmFsdWUgYWdhaW5zdCBnZW5ldGljIHZhbHVlCnBsb3QoZ3YocG9wKSwgYnYocG9wKSwKICAgICB4bGFiPSJHZW5ldGljIFZhbHVlIiwKICAgICB5bGFiPSJCcmVlZGluZyBWYWx1ZSIpCmNvcihndihwb3ApLCBidihwb3ApKQoKIyBBc3NpZ24gcGhlbm90eXBlcyBjb25zaXN0ZW50IHdpdGggYSBwcm9nZW55IHRlc3QKIyBVc2luZyBhIGxhcmdlIG51bWJlciBvZiBtYXRpbmcgaGlnaCBhY2N1cmFjeQpwb3AgPSBzZXRQaGVub1Byb2dUZXN0KHBvcD1wb3AsIAogICAgICAgICAgICAgICAgICAgICAgIHRlc3RQb3A9cG9wLCAKICAgICAgICAgICAgICAgICAgICAgICBuTWF0ZVBlckluZD0xMDApCgojIFBsb3QgZ2VuZXRpYyB2YWx1ZSBhZ2FpbnN0IHByb2dlbnkgdGVzdCBtZWFucwpwbG90KHBoZW5vKHBvcCksIGd2KHBvcCksCiAgICAgeGxhYj0iUHJvZ2VueSBUZXN0IE1lYW4iLAogICAgIHlsYWI9IkdlbmV0aWMgVmFsdWUiKQpjb3IocGhlbm8ocG9wKSwgZ3YocG9wKSkKCiMgUGxvdCBicmVlZGluZyB2YWx1ZSBhZ2FpbnN0IHByb2dlbnkgdGVzdCBtZWFucwpwbG90KHBoZW5vKHBvcCksIGJ2KHBvcCksIAogICAgIHhsYWI9IlByb2dlbnkgVGVzdCBNZWFuIiwKICAgICB5bGFiPSJCcmVlZGluZyBWYWx1ZSIpCmNvcihndihwb3ApLCBidihwb3ApKQoKYGBgCgo=