Problem 1: Marker Effects Model
Predict genomic breeding values using a marker effects model. The dataset is available from
https://charlotte-ngs.github.io/asmss2022/data/asm_geno_sim_data.csv
Hints
- The variance \(\sigma_q^2\) of the marker effect is \(3\).
- The residual variance \(\sigma_e^2\) is \(36\)
- The sex of each animal can be modelled as a fixed effect
Your Solution
- Read the data
- Setup mixed model equations to predict marker effects for all the SNP-loci
- Compute predicted genomic breeding values based on the estimated marker effects
Problem 2: Breeding Value Based Model
Use the same dataset as in Problem 1 to predict genomic breeding values based on a breeding-value model. The dataset is available from
https://charlotte-ngs.github.io/asmss2022/data/asm_geno_sim_data.csv
Hints
- The genomic variance \(\sigma_g^2\) of the marker effect is \(9\).
- The residual variance \(\sigma_e^2\) is \(36\)
- The sex of each animal can be modelled as a fixed effect
- Use the following function to compute the genomic relationship matrix \(G\) based on the matrix of genotypes
computeMatGrm <- function(pmatData) {
matData <- pmatData
# check the coding, if matData is -1, 0, 1 coded, then add 1 to get to 0, 1, 2 coding
if (min(matData) < 0) matData <- matData + 1
# Allele frequencies, column vector of P and sum of frequency products
freq <- apply(matData, 2, mean) / 2
P <- 2 * (freq - 0.5)
sumpq <- sum(freq*(1-freq))
# Changing the coding from (0,1,2) to (-1,0,1) and subtract matrix P
Z <- matData - 1 - matrix(P, nrow = nrow(matData),
ncol = ncol(matData),
byrow = TRUE)
# Z%*%Zt is replaced by tcrossprod(Z)
return(tcrossprod(Z)/(2*sumpq))
}
- If the genomic relationship matrix \(G\) which is computed by the function above cannot be inverted, add \(0.05 * I\) to \(G\) which results in \(G^*\) and use \(G^*\) as genomic relationship matrix.
Your Solution
- Read the data
- Compute the inverse genomic relationship matrix using the given function for the genomic relationship matrix
- Setup mixed model equations to predict genomic breeding values
Latest Changes: 2022-05-23 08:40:47 (pvr)
LS0tCnRpdGxlOiBBcHBsaWVkIFN0YXRpc3RpY2FsIE1ldGhvZHMgLSBOb3RlYm9vayAxMQphdXRob3I6IFBldGVyIHZvbiBSb2hyCmRhdGU6ICcyMDIyLTA1LTIyJwpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKcGFyYW1zOgogIGRvY3R5cGU6CiAgICBsYWJlbDogRG9jdW1lbnQgVHlwZQogICAgdmFsdWU6IHNvbHV0aW9uCiAgICBjaG9pY2VzOgogICAgLSBleGVyY2lzZQogICAgLSBzb2x1dGlvbgogICAgLSBub3RlYm9vawogIGlzb25saW5lOgogICAgbGFiZWw6IE9ubGluZSAoeS9uKQogICAgdmFsdWU6IHRydWUKICAgIGNob2ljZXM6CiAgICAtIHRydWUKICAgIC0gZmFsc2UKLS0tCgoKCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAoKCiMjIFByb2JsZW0gMTogTWFya2VyIEVmZmVjdHMgTW9kZWwKYGBge3IgZXgxMXAwMS1zZXR1cCwgZWNobz1GQUxTRX0Kc19leDExX3AwMV9kYXRhX3BhdGggPC0gImh0dHBzOi8vY2hhcmxvdHRlLW5ncy5naXRodWIuaW8vYXNtc3MyMDIyL2RhdGEvYXNtX2dlbm9fc2ltX2RhdGEuY3N2IgppZiAoIXBhcmFtcyRpc29ubGluZSkKICBzX2V4MTFfcDAxX2RhdGFfcGF0aCA8LSBmaWxlLnBhdGgoaGVyZTo6aGVyZSgpLCAiZG9jcyIsICJkYXRhIiwgImFzbV9nZW5vX3NpbV9kYXRhLmNzdiIpCgpzaWdtYV9xMiA8LSAzCnNpZ21hX2UyIDwtIDM2CmBgYAoKUHJlZGljdCBnZW5vbWljIGJyZWVkaW5nIHZhbHVlcyB1c2luZyBhIG1hcmtlciBlZmZlY3RzIG1vZGVsLiBUaGUgZGF0YXNldCBpcyBhdmFpbGFibGUgZnJvbQoKYGBge3IsIGVjaG89RkFMU0V9CmNhdChzX2V4MTFfcDAxX2RhdGFfcGF0aCwgIlxuIikKYGBgCgojIyMgSGludHMKCiogVGhlIHZhcmlhbmNlICRcc2lnbWFfcV4yJCBvZiB0aGUgbWFya2VyIGVmZmVjdCBpcyAkYHIgc2lnbWFfcTJgJC4KKiBUaGUgcmVzaWR1YWwgdmFyaWFuY2UgJFxzaWdtYV9lXjIkIGlzICRgciBzaWdtYV9lMmAkCiogVGhlIHNleCBvZiBlYWNoIGFuaW1hbCBjYW4gYmUgbW9kZWxsZWQgYXMgYSBmaXhlZCBlZmZlY3QKCiMjIyBZb3VyIFNvbHV0aW9uCgoqIFJlYWQgdGhlIGRhdGEKKiBTZXR1cCBtaXhlZCBtb2RlbCBlcXVhdGlvbnMgdG8gcHJlZGljdCBtYXJrZXIgZWZmZWN0cyBmb3IgYWxsIHRoZSBTTlAtbG9jaQoqIENvbXB1dGUgcHJlZGljdGVkIGdlbm9taWMgYnJlZWRpbmcgdmFsdWVzIGJhc2VkIG9uIHRoZSBlc3RpbWF0ZWQgbWFya2VyIGVmZmVjdHMKCgoKCgojIyBQcm9ibGVtIDI6IEJyZWVkaW5nIFZhbHVlIEJhc2VkIE1vZGVsCmBgYHtyIGV4MTFwMDItc2V0dXAsIGVjaG89RkFMU0V9CnNfZXgxMV9wMDJfZGF0YV9wYXRoIDwtICJodHRwczovL2NoYXJsb3R0ZS1uZ3MuZ2l0aHViLmlvL2FzbXNzMjAyMi9kYXRhL2FzbV9nZW5vX3NpbV9kYXRhLmNzdiIKaWYgKCFwYXJhbXMkaXNvbmxpbmUpCiAgc19leDExX3AwMl9kYXRhX3BhdGggPC0gZmlsZS5wYXRoKGhlcmU6OmhlcmUoKSwgImRvY3MiLCAiZGF0YSIsICJhc21fZ2Vub19zaW1fZGF0YS5jc3YiKQoKc2lnbWFfcTIgPC0gMwpzaWdtYV9nMiA8LSAzKnNpZ21hX3EyCnNpZ21hX2UyIDwtIDM2CmBgYAoKVXNlIHRoZSBzYW1lIGRhdGFzZXQgYXMgaW4gUHJvYmxlbSAxIHRvIHByZWRpY3QgZ2Vub21pYyBicmVlZGluZyB2YWx1ZXMgYmFzZWQgb24gYSBicmVlZGluZy12YWx1ZSBtb2RlbC4gVGhlIGRhdGFzZXQgaXMgYXZhaWxhYmxlIGZyb20KCmBgYHtyLCBlY2hvPUZBTFNFfQpjYXQoc19leDExX3AwMl9kYXRhX3BhdGgsICJcbiIpCmBgYAoKIyMjIEhpbnRzCgoqIFRoZSBnZW5vbWljIHZhcmlhbmNlICRcc2lnbWFfZ14yJCBvZiB0aGUgbWFya2VyIGVmZmVjdCBpcyAkYHIgc2lnbWFfZzJgJC4KKiBUaGUgcmVzaWR1YWwgdmFyaWFuY2UgJFxzaWdtYV9lXjIkIGlzICRgciBzaWdtYV9lMmAkCiogVGhlIHNleCBvZiBlYWNoIGFuaW1hbCBjYW4gYmUgbW9kZWxsZWQgYXMgYSBmaXhlZCBlZmZlY3QKKiBVc2UgdGhlIGZvbGxvd2luZyBmdW5jdGlvbiB0byBjb21wdXRlIHRoZSBnZW5vbWljIHJlbGF0aW9uc2hpcCBtYXRyaXggJEckIGJhc2VkIG9uIHRoZSBtYXRyaXggb2YgZ2Vub3R5cGVzCgpgYGB7cn0KY29tcHV0ZU1hdEdybSA8LSBmdW5jdGlvbihwbWF0RGF0YSkgewogIG1hdERhdGEgPC0gcG1hdERhdGEKICAjIGNoZWNrIHRoZSBjb2RpbmcsIGlmIG1hdERhdGEgaXMgLTEsIDAsIDEgY29kZWQsIHRoZW4gYWRkIDEgdG8gZ2V0IHRvIDAsIDEsIDIgY29kaW5nCiAgaWYgKG1pbihtYXREYXRhKSA8IDApIG1hdERhdGEgPC0gbWF0RGF0YSArIDEKICAjIEFsbGVsZSBmcmVxdWVuY2llcywgY29sdW1uIHZlY3RvciBvZiBQIGFuZCBzdW0gb2YgZnJlcXVlbmN5IHByb2R1Y3RzCiAgZnJlcSA8LSBhcHBseShtYXREYXRhLCAyLCBtZWFuKSAvIDIKICBQIDwtIDIgKiAoZnJlcSAtIDAuNSkKICBzdW1wcSA8LSBzdW0oZnJlcSooMS1mcmVxKSkKICAjIENoYW5naW5nIHRoZSBjb2RpbmcgZnJvbSAoMCwxLDIpIHRvICgtMSwwLDEpIGFuZCBzdWJ0cmFjdCBtYXRyaXggUAogIFogPC0gbWF0RGF0YSAtIDEgLSBtYXRyaXgoUCwgbnJvdyA9IG5yb3cobWF0RGF0YSksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgIG5jb2wgPSBuY29sKG1hdERhdGEpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICBieXJvdyA9IFRSVUUpCiAgIyBaJSolWnQgaXMgcmVwbGFjZWQgYnkgdGNyb3NzcHJvZChaKQogIHJldHVybih0Y3Jvc3Nwcm9kKFopLygyKnN1bXBxKSkKfQpgYGAKCiogSWYgdGhlIGdlbm9taWMgcmVsYXRpb25zaGlwIG1hdHJpeCAkRyQgd2hpY2ggaXMgY29tcHV0ZWQgYnkgdGhlIGZ1bmN0aW9uIGFib3ZlIGNhbm5vdCBiZSBpbnZlcnRlZCwgYWRkICQwLjA1ICogSSQgdG8gJEckIHdoaWNoIHJlc3VsdHMgaW4gJEdeKiQgYW5kIHVzZSAkR14qJCBhcyBnZW5vbWljIHJlbGF0aW9uc2hpcCBtYXRyaXguCgoKIyMjIFlvdXIgU29sdXRpb24KCiogUmVhZCB0aGUgZGF0YQoqIENvbXB1dGUgdGhlIGludmVyc2UgZ2Vub21pYyByZWxhdGlvbnNoaXAgbWF0cml4IHVzaW5nIHRoZSBnaXZlbiBmdW5jdGlvbiBmb3IgdGhlIGdlbm9taWMgcmVsYXRpb25zaGlwIG1hdHJpeAoqIFNldHVwIG1peGVkIG1vZGVsIGVxdWF0aW9ucyB0byBwcmVkaWN0IGdlbm9taWMgYnJlZWRpbmcgdmFsdWVzCgoKCgoKCmBgYHtyLCBlY2hvPUZBTFNFLCByZXN1bHRzPSdhc2lzJ30KY2F0KCdcbi0tLVxuXG4gX0xhdGVzdCBDaGFuZ2VzOiAnLCBmb3JtYXQoU3lzLnRpbWUoKSwgJyVZLSVtLSVkICVIOiVNOiVTJyksICcgKCcsIFN5cy5pbmZvKClbJ3VzZXInXSwgJylfXG4nLCBzZXAgPSAnJykKYGBgCiAK