In charlotte-ngs/ZLHS2016:

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

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: Pedigree (Prüfungsaufgabe HS2015)

Gegeben ist folgendes Pedigree

suppressPackageStartupMessages( library(pedigreemm) )
nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,3), dam = c(NA,NA,2,2,4), label = 1:nNrAni)
print(ped)

\begin{enumerate} \item[a)] Stellen Sie die additive genetische Verwandtschaftsmatrix für das oben dargestellte Pedigree auf. \end{enumerate}

Lösung:

matA <- as.matrix(getA(ped))
cat("$$A = \\left[")
cat(paste(sGetTexMatrix(pmatAMatrix = matA, pnDigits = 4), collapse = "\n"))
cat("\\right]\n")
cat("$$\n")

\begin{enumerate} \item[b)] Welches der fünf Tiere im gezeigten Pedigree ist ingezüchtet und wie gross ist der Inzuchtkoeffizient $F_X$? (Bitte auch für nicht ingezüchtete Tiere den Inzuchtkoeffizienten angeben) \end{enumerate}

Lösung:

dfInbreedTable <- data.frame(TierId = c(1:nNrAni),
                             bInbred <- sapply(1:nNrAni,function(x) ifelse(matA[x,x]>1,"ja","nein")),
                             nInbreedCoeff <- sapply(1:nNrAni,function(x) matA[x,x]-1))
names(dfInbreedTable) <- c("Tier ID", "Ingezüchtet (ja/nein)", "Inzuchtkoeffizient")
knitr::kable(dfInbreedTable)

nSpecialAnimalIdx <- 5

\vspace{5ex} \begin{enumerate} \item[c)] Wir interessieren uns speziell für Tier $r nSpecialAnimalIdx$. Welche Elemente der additiv genetischen Verwandtschaftsmatrix enthalten den Inzuchtkoeffizienten von Tier $r nSpecialAnimalIdx$. Am besten geben Sie die Elemente der Matrix über die jeweiligen Zeilen- und Kolonnennummern an. \end{enumerate}

Lösung:

($r nSpecialAnimalIdx$,$r nSpecialAnimalIdx$), ($r ped@sire[nSpecialAnimalIdx]$,$r ped@dam[nSpecialAnimalIdx]$), ($r ped@dam[nSpecialAnimalIdx]$,$r ped@sire[nSpecialAnimalIdx]$)

Aufgabe 2: R-Package pedigreemm

Das R-Package pedigreemm enthält ein paar Funktionalitäten zu Berechnungen mit Pedigrees. Wie alle R-packages, welche nicht mit der Grundversion von R mitkommen muss pedigreemm mit dem Befehl

install.packages("pedigreemm")

installiert werden. Im Package pedigreemm gibt es die Funktion getA(), welche als Argument ein Objekt vom Typ pedigree übernimmt und daraus die Verwandtschaftsmatrix $A$ berechnet. Ein pedigree-Objekt wird mit der Funktion pedigree() erstellt. Die Funktion pedigree() braucht drei Vektoren als Argumente. Es sind dies die Vektoren

1. sire: gibt die Väter der Tiere an
2. dam: gibt die Mütter der Tiere an
3. label: gibt die TierIds an

Auf der Hilfeseite von der Funktion pedigree welche mit ?pedigree aufgerufen wird, ist ganz am Schluss ein Beispiel angegeben, wie ein Pedigree in ein pedigree-Objekt eingelesen wird.

Ihre Aufgabe: Überprüfen Sie die in Aufgabe 1 berechnete Verwandtschaftsmatrix $A$ mit der Funktion getA().

Lösung:

nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,3), dam = c(NA,NA,2,2,4), label = 1:nNrAni)
getA(ped = ped)

Aufgabe 3: Heatmap

Die sogenannte Heatmap kann als graphische Darstellung einer Verwandtschaftsmatrix verwendet werden. Die R-Statements sind in den Unterlagen beschrieben. Die Funktionen zur Erzeugung einer Heatmap sind im R-package lattice enthalten. Diese sollte schon mit der Basisversion von R dabei sein.

Versuchen Sie die Verwandtschaftsmatrix aus Aufgabe 1 als Heatmap darzustellen.

Hinweis: Falls Sie die Verwandtschaftsmatrix mit der Funktion getA() aus Package pedigreemm erzeugen, dann müssen Sie das Resultat aus getA() mit der Funktion as.matrix() in eine Matrix verwandeln.

\pagebreak

Lösung:

nNrAni <- 5
ped <- pedigree(sire = c(NA,NA,1,1,3), dam = c(NA,NA,2,2,4), label = 1:nNrAni)
matA <- as.matrix(getA(ped = ped))
library(lattice)
new.palette=colorRampPalette(c("black","red","yellow","white"),space="rgb")
levelplot(matA[1:ncol(matA),ncol(matA):1],col.regions=new.palette(20))

r6ob_abbrtable$writeToTsvFile()

charlotte-ngs/ZLHS2016 documentation built on May 13, 2019, 3:33 p.m.