# \donttest{
set.seed(101)
library(nadiv)
# create pedigree
warcolak <- simPedDFC(U = 75, gpn = 4, fsn = 4, s = 2)
names(warcolak)[1:3] <- c("ID", "Dam", "Sire")
warcolak$trait2 <- warcolak$trait1 <- NA
# Define covariance matrices for random effects:
## Autosomal additive genetic (trait1)
Ga_t1 <- matrix(c(0.4, rep(0.399999, 2), 0.4), 2, 2)
## Autosomal additive genetic (trait2)
Ga_t2 <- matrix(c(0.3, rep(0.299999, 2), 0.3), 2, 2)
## Sex-chromosomal additive genetic (trait2)
Gs_t2 <- matrix(c(0.1, rep(0.099999, 2), 0.1), 2, 2)
## Autosomal dominance genetic
Gd <- matrix(c(0.3, rep(0.299999, 2), 0.3), 2, 2)
## Environmental (or residual)
### Assumes no correlated environmental effects between sexes
R <- diag(c(0.3, 0.3))
## define variables to be re-used
pedn <- nrow(warcolak)
# Female (homogametic sex chromosomes) in first column
# Male (heterogametic sex chromosomes) in second column
sexcol <- as.integer(warcolak$sex)
# Create random effects
## Additive genetic
### trait1 autosomal
tmp_a <- grfx(pedn, G = Ga_t1, incidence = makeA(warcolak[, 1:3]))
var(tmp_a)
warcolak$t1_a <- tmp_a[cbind(seq(pedn), sexcol)]
### trait2 autosomal
tmp_a <- grfx(pedn, G = Ga_t2, incidence = makeA(warcolak[, 1:3]))
var(tmp_a)
warcolak$t2_a <- tmp_a[cbind(seq(pedn), sexcol)]
### trait2 sex-chromosomal
tmp_s <- grfx(pedn, G = Gs_t2, incidence = makeS(warcolak[, 1:4],
heterogametic = "M", DosageComp = "ngdc", returnS = TRUE)$S)
matrix(c(var(tmp_s[which(sexcol == 1), 1]),
rep(cov(tmp_s)[2, 1], 2), var(tmp_s[which(sexcol == 2), 2])), 2, 2)
# NOTE above should be: covar = male var = 0.5* female var
warcolak$t2_s <- tmp_s[cbind(seq(pedn), sexcol)]
## Dominance genetic
### trait1
tmp_d <- grfx(pedn, G = Gd, incidence = makeD(warcolak[, 1:3], invertD = FALSE)$D)
var(tmp_d)
warcolak$t1_d <- tmp_d[cbind(seq(pedn), sexcol)]
### trait2
tmp_d <- grfx(pedn, G = Gd, incidence = makeD(warcolak[, 1:3], invertD = FALSE)$D)
var(tmp_d)
warcolak$t2_d <- tmp_d[cbind(seq(pedn), sexcol)]
## Residual
### trait1
tmp_r <- grfx(pedn, G = R, incidence = NULL) # warning of identity matrix
var(tmp_r)
warcolak$t1_r <- tmp_r[cbind(seq(pedn), sexcol)]
### trait2
tmp_r <- grfx(pedn, G = R, incidence = NULL) # warning of identity matrix
var(tmp_r)
warcolak$t2_r <- tmp_r[cbind(seq(pedn), sexcol)]
# Sum random effects and add sex-specific means to get phenotypes
## females have slightly greater mean trait values
warcolak$trait1 <- 1 + (-1*sexcol + 2) + rowSums(warcolak[, c("t1_a", "t1_d", "t1_r")])
warcolak$trait2 <- 1 + (-1*sexcol + 2) + rowSums(warcolak[, c("t2_a", "t2_s", "t2_d", "t2_r")])
# }
Run the code above in your browser using DataLab