The document will demonstrate the use of a new function for defining traits with dominance effects by supplying inbreeding depression and dominance variance. The function uses R’s optim function to attempt to find values for mean and variance of dominance degrees that satisfy the user’s request subject to limits on the range of these values. If a solution is not found, the closest solution is return. This function has not been thoroughly tested and is still somewhat experimental.

library(AlphaSimR)
Loading required package: R6
founderPop = runMacs(nInd=1000, nChr=10, segSites=1000)

SP = SimParam$new(founderPop)

# New function for specifying a trait with dominance effects
SP$altAddTraitAD(nQtlPerChr = 1000, 
                 mean = 0, 
                 varA = 1, 
                 varD = 0.2, 
                 inbrDepr = 2)
A new trait called Trait1 was added. 
   varD = 0.1983316 
   inbrDepr = 2.000026 
   meanDD = 0.06184431 
   varDD = 0.5 
pop = newPop(founderPop)

gp = genParam(pop)

gp$varA
       Trait1
Trait1      1
gp$varD
          Trait1
Trait1 0.1983316
# Inbreeding depression (F=current - F=1)
mean(gp$gv_d) - gp$mu 
 Trait1 
2.00724 
# Inbreeding depression (F=0 - F=1)
# This is the definition of inbreeding depression used in the function above
mean(gp$gv_d) - gp$mu + gp$mu_HW
  Trait1 
2.000026 
# Manually compute inbreeding depression (F=0 - F=1)
p = colMeans( pullQtlGeno(pop) ) / 2
q = 1-p
d = SP$traits[[1]]@domEff

sum(2*p*q*d)
[1] 2.000026

The below script shows how changing the number of QTL may be necessary to achieve a desired scenario.

founderPop = runMacs(nInd=1000, nChr=10, segSites=1000)

SP = SimParam$new(founderPop)

SP$altAddTraitAD(nQtlPerChr = 100, 
                 mean = 0, 
                 varA = 1, 
                 varD = 0.3, 
                 inbrDepr = 10, 
                 limMeanDD = c(0, 0.6), 
                 limVarDD = c(0, 0.5))
A new trait called Trait1 was added. 
   varD = 0.2852178 
   inbrDepr = 7.617085 
   meanDD = 0.6 
   varDD = 0 
SP$altAddTraitAD(nQtlPerChr = 1000, 
                 mean = 0, 
                 varA = 1, 
                 varD = 0.3, 
                 inbrDepr = 10, 
                 limMeanDD = c(0, 0.6), 
                 limVarDD = c(0, 0.5))
A new trait called Trait2 was added. 
   varD = 0.3002842 
   inbrDepr = 9.999977 
   meanDD = 0.2342512 
   varDD = 0.0755601 
LS0tDQp0aXRsZTogIlF1YW50aXRhdGl2ZSBHZW5ldGljczogRG9taW5hbmNlIEVmZmVjdHMsIFBhcnQgMyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNClRoZSBkb2N1bWVudCB3aWxsIGRlbW9uc3RyYXRlIHRoZSB1c2Ugb2YgYSBuZXcgZnVuY3Rpb24gZm9yIGRlZmluaW5nIHRyYWl0cyB3aXRoIGRvbWluYW5jZSBlZmZlY3RzIGJ5IHN1cHBseWluZyBpbmJyZWVkaW5nIGRlcHJlc3Npb24gYW5kIGRvbWluYW5jZSB2YXJpYW5jZS4gVGhlIGZ1bmN0aW9uIHVzZXMgUidzIGBvcHRpbWAgZnVuY3Rpb24gdG8gYXR0ZW1wdCB0byBmaW5kIHZhbHVlcyBmb3IgbWVhbiBhbmQgdmFyaWFuY2Ugb2YgZG9taW5hbmNlIGRlZ3JlZXMgdGhhdCBzYXRpc2Z5IHRoZSB1c2VyJ3MgcmVxdWVzdCBzdWJqZWN0IHRvIGxpbWl0cyBvbiB0aGUgcmFuZ2Ugb2YgdGhlc2UgdmFsdWVzLiBJZiBhIHNvbHV0aW9uIGlzIG5vdCBmb3VuZCwgdGhlIGNsb3Nlc3Qgc29sdXRpb24gaXMgcmV0dXJuLiBUaGlzIGZ1bmN0aW9uIGhhcyBub3QgYmVlbiB0aG9yb3VnaGx5IHRlc3RlZCBhbmQgaXMgc3RpbGwgc29tZXdoYXQgZXhwZXJpbWVudGFsLg0KDQoNCmBgYHtyfQ0KbGlicmFyeShBbHBoYVNpbVIpDQoNCmZvdW5kZXJQb3AgPSBydW5NYWNzKG5JbmQ9MTAwMCwgbkNocj0xMCwgc2VnU2l0ZXM9MTAwMCkNCg0KU1AgPSBTaW1QYXJhbSRuZXcoZm91bmRlclBvcCkNCg0KIyBOZXcgZnVuY3Rpb24gZm9yIHNwZWNpZnlpbmcgYSB0cmFpdCB3aXRoIGRvbWluYW5jZSBlZmZlY3RzDQpTUCRhbHRBZGRUcmFpdEFEKG5RdGxQZXJDaHIgPSAxMDAwLCANCiAgICAgICAgICAgICAgICAgbWVhbiA9IDAsIA0KICAgICAgICAgICAgICAgICB2YXJBID0gMSwgDQogICAgICAgICAgICAgICAgIHZhckQgPSAwLjIsIA0KICAgICAgICAgICAgICAgICBpbmJyRGVwciA9IDIpDQoNCg0KcG9wID0gbmV3UG9wKGZvdW5kZXJQb3ApDQoNCmdwID0gZ2VuUGFyYW0ocG9wKQ0KDQpncCR2YXJBDQoNCmdwJHZhckQNCg0KIyBJbmJyZWVkaW5nIGRlcHJlc3Npb24gKEY9Y3VycmVudCAtIEY9MSkNCm1lYW4oZ3AkZ3ZfZCkgLSBncCRtdSANCg0KIyBJbmJyZWVkaW5nIGRlcHJlc3Npb24gKEY9MCAtIEY9MSkNCiMgVGhpcyBpcyB0aGUgZGVmaW5pdGlvbiBvZiBpbmJyZWVkaW5nIGRlcHJlc3Npb24gdXNlZCBpbiB0aGUgZnVuY3Rpb24gYWJvdmUNCm1lYW4oZ3AkZ3ZfZCkgLSBncCRtdSArIGdwJG11X0hXDQoNCiMgTWFudWFsbHkgY29tcHV0ZSBpbmJyZWVkaW5nIGRlcHJlc3Npb24gKEY9MCAtIEY9MSkNCnAgPSBjb2xNZWFucyggcHVsbFF0bEdlbm8ocG9wKSApIC8gMg0KcSA9IDEtcA0KZCA9IFNQJHRyYWl0c1tbMV1dQGRvbUVmZg0KDQpzdW0oMipwKnEqZCkNCg0KYGBgDQoNClRoZSBiZWxvdyBzY3JpcHQgc2hvd3MgaG93IGNoYW5naW5nIHRoZSBudW1iZXIgb2YgUVRMIG1heSBiZSBuZWNlc3NhcnkgdG8gYWNoaWV2ZSBhIGRlc2lyZWQgc2NlbmFyaW8uDQoNCmBgYHtyfQ0KZm91bmRlclBvcCA9IHJ1bk1hY3MobkluZD0xMDAwLCBuQ2hyPTEwLCBzZWdTaXRlcz0xMDAwKQ0KDQpTUCA9IFNpbVBhcmFtJG5ldyhmb3VuZGVyUG9wKQ0KDQpTUCRhbHRBZGRUcmFpdEFEKG5RdGxQZXJDaHIgPSAxMDAsIA0KICAgICAgICAgICAgICAgICBtZWFuID0gMCwgDQogICAgICAgICAgICAgICAgIHZhckEgPSAxLCANCiAgICAgICAgICAgICAgICAgdmFyRCA9IDAuMywgDQogICAgICAgICAgICAgICAgIGluYnJEZXByID0gMTAsIA0KICAgICAgICAgICAgICAgICBsaW1NZWFuREQgPSBjKDAsIDAuNiksIA0KICAgICAgICAgICAgICAgICBsaW1WYXJERCA9IGMoMCwgMC41KSkNCg0KU1AkYWx0QWRkVHJhaXRBRChuUXRsUGVyQ2hyID0gMTAwMCwgDQogICAgICAgICAgICAgICAgIG1lYW4gPSAwLCANCiAgICAgICAgICAgICAgICAgdmFyQSA9IDEsIA0KICAgICAgICAgICAgICAgICB2YXJEID0gMC4zLCANCiAgICAgICAgICAgICAgICAgaW5ickRlcHIgPSAxMCwgDQogICAgICAgICAgICAgICAgIGxpbU1lYW5ERCA9IGMoMCwgMC42KSwgDQogICAgICAgICAgICAgICAgIGxpbVZhckREID0gYygwLCAwLjUpKQ0KYGBgDQoNCg==