In charlotte-ngs/ZLHS2016:

knitr::opts_chunk$set(echo = FALSE, results = 'asis')

r6obj_docstat <- rmddochelper::R6ClassDocuStatus$new()
r6obj_docstat$set_current_status(psVersion = "0.0.901",
                                 psStatus  = "Initialisation",
                                 psProject = "ZL_HS_2016")
r6obj_docstat$include_doc_stat(psTitle = "## Document Status")

r6ob_abbrtable <- rmddochelper::R6ClassTableAbbrev$new()
### # include table of abbreviations only, if there are any
if (!r6ob_abbrtable$is_empty_abbr())
  r6ob_abbrtable$include_abbr_table(psAbbrTitle = "## Abbreviations")

Aufgabe 1: LDL-Zerlegung der Verwandtschaftsmatrix

Gegeben ist das folgende Pedigree

suppressPackageStartupMessages(require(pedigreemm))
nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,4),dam = c(NA,NA,2,NA,2), label = as.character(1:nNrAni))
print(ped)

a) Stellen Sie die Verwandtschaftsmatrix $A$ auf b) Ermitteln Sid die LDL-Zerlegung von $A$ c) Berechnen Sie die Inverse der Verwandtschaftsmatrix

Hinweise:

Für Pedigrees ohne Inzucht, können die Diagonalelemente $d_{ii}$ nur drei verschiedene Werte annehmen. Diese sind entweder $1$, falls das Tier ein Foundertier ist ohne bekannte Eltern, $3/4$ falls ein Elternteil bekannt ist, oder $1/2$ falls beide Eltern bekannt sind.
Ohne Berücksichtigung der Inzucht kann die Inverse $A^{-1}$ einfach aufgrund folgender Regeln aufgestellt werden.
- Initialisiere alle Elemente der Matrix $A^{-1}$ mit $0$
- Für Tier $i$ mit Eltern $s$ und $d$,
  - addiere $\delta_i$ zum Element $(i,i)$,
  - addiere $-\delta_i/2$ zu den Elementen $(s,i)$, $(i,s)$, $(d,i)$ und $(i,d)$ und
  - addiere $\delta_i/4$ zu den Elementen $(s,s)$, $(s,d)$, $(d,s)$ und $(d,d)$
- Für Tier $i$ mit bekanntem Elternteil $d$,
  - addiere $\delta_i$ zum Element $(i,i)$,
  - addiere $-\delta_i/2$ zu den Elementen $(d,i)$ und $(i,d)$ und
  - addiere $\delta_i/4$ zu den Elementen $(d,d)$
- Für Tier $i$ mit unbekannten Eltern
  - addiere $\delta_i$ zum Element $(i,i)$

wobei $\delta_i$ das $i$-te Element auf der Diagonalen von $D^{-1}$ ist.

\pagebreak

Aufgabe 2: Zuchtwert aufgrund Nachkommenleistung

### # Annahmen
nNrOffspring <- 10
nMeanWwg <- 1.25
nSdWwg <- 0.3
nPopMean <- 1
nH2 <- 0.35
k <- (4-nH2)/nH2
nPhenSd <- 1.1
### # Daten generieren
set.seed(123)
dfWeanWeightGain = data.frame(Tier=1:nNrOffspring, Zuwachs = round(rnorm(nNrOffspring, mean=nMeanWwg, sd=nSdWwg), digits = 2))
nMeanZuw <- mean(dfWeanWeightGain$Zuwachs)
### # ComputeHatA
nHatA <- 2*nNrOffspring/(nNrOffspring + k) * (nMeanZuw-nPopMean)
### # CompSigmaHatA
nSigmaHatA <- (2*nNrOffspring)/(nNrOffspring + k) * sqrt(0.25*nH2 + (1-0.25*nH2)/nNrOffspring) * nPhenSd
### # Obere Grenze
nPvalHatA <- 0.025
nOgHatA <- nHatA + qnorm(nPvalHatA, lower.tail = FALSE) * nSigmaHatA

Stier Elvis hat $r nNrOffspring$ Nachkommen. Von diesen Nachkommen wurden der tägliche Zuwachs (in kg) bis zum Absetzen aufgezeichnet. Das Merkmal hat ein Populationsmittel von $r nPopMean$ kg pro Tag. Die Heritabilität $h^2$ beträgt $r nH2$ und die phänotypische Standardabweichung $\sigma_y$ ist r nPhenSd kg pro Tag.

knitr::kable(dfWeanWeightGain)

a) Schätzen Sie den Zuchtwert von Elvis für das Merkmal tägliche Zunahme bis zum Absetzen aufgrund der Nachkommenleistung b) Wie gross ist das Bestimmtheitsmass des unter a) geschätzten Zuchtwertes c) Berechnen Sie aufgrund der Standardabweichung des geschätzten Zuchtwertes die Wahrscheinlichkeit, dass der Zuchtwert von Elvis grösser oder gleich $+r round(nOgHatA, digits = 2)$ kg pro Tag ist.

Aufgabe 3: Bedingungen und Schleifen (Loops) in R

Schleifen (Loops) erlauben es uns gewissen Statements wiederholt ausführen zu lassen. Will man als Beispiel alle natürlichen Zahlen zwischen $r nLowerLimit$ und $r nUpperLimit$ ausgeben, dann kann das mit folgendem Loop gemacht werden.

nLowerLimit <- 1
nUpperLimit <- 10
for (nIdx in (nLowerLimit:nUpperLimit)){
  cat(nIdx,"\n")
}

Die sogenannten if-Bedingungen können verwendet werden um den Programmablauf zu steuern. Sollen zum Beispiel in der Schleife, welche oben gezeigt wurde, nur die geraden Zahlen ausgegeben werden kann das mit der folgenden Bedingung machen.

nLowerLimit <- 1
nUpperLimit <- 10
for (nIdx in (nLowerLimit:nUpperLimit)){
  if (identical(nIdx %% 2, 0)) {
    cat(nIdx," ist gerade\n")
  }
}

Ihre Aufgabe

Finden Sie in folgendem Pedigree alle Tiere, die keine Mutter haben. Verwenden Sie dazu einen Loop über alle Tiere und testen Sie mit einer if-Bedingung, ob die Mutter bekannt ist.

print(ped)

Hinweise: - Am einfachsten beginnen Sie, indem Sie das Pedigree mit folgendem Statement der Variablen ped zuweisen.

library(pedigreemm)
nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,4),dam = c(NA,NA,2,NA,2), label = as.character(1:nNrAni))

In unseren Pedigrees werden die unbekannten Eltern mit NA kodiert. Verwenden Sie die Funktion is.na() für die Überprüfung, ob die Mutter bekannt ist.
Angenommen, sie weisen das Pedigree der Variablen ped zu, dann finden sie die Anzahl Tiere im Pedigree mit dem Ausdruck length(ped@label)
Die Mutter des Tieres $i$ bekommen Sie mit dem Ausdruck ped@dam[i]

suppressPackageStartupMessages(require(pedigreemm))
nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,4),dam = c(NA,NA,2,NA,2), label = as.character(1:nNrAni))