In charlotte-ngs/asmss2022: Applied Statistical Methods in Animal Science - Spring Semester 2022

\newcommand{\points}[1] {\begin{flushright}\textbf{#1}\end{flushright}}

# knitr::opts_chunk$set(echo = FALSE, results = 'hide')
#knitr::opts_chunk$set(concordance=TRUE)
knitr::knit_hooks$set(hook_convert_odg = rmdhelp::hook_convert_odg)
# write the parameters to file
b_params_to_file <- FALSE
# check whether seed is set and output it to a file
s_this_rmd_file = basename(ifelse(rstudioapi::isAvailable(), 
                         rstudioapi::getSourceEditorContext()$path, 
                         whereami::thisfile()))
if (is.null(params$seed)){
  stop(" ** Error parameter seed has not been set.")
} else {
  set.seed(params$seed)
  s_params_file <- paste0(format(Sys.time(), '%Y%m%d%H%M%S'), "_params_", s_this_rmd_file, ".txt", collapse = "")
  if (b_params_to_file) dput(params, file = s_params_file)
}

# Assign Points for Q1
lPointsQ1 <- list(TaskA = 2,
                  TaskB = 4,
                  TaskC = 9,
                  TaskD = 0)
nPointQ1Total <- sum(unlist(lPointsQ1))

# Assign Points for Q2
lPointsQ2 <- list(TaskA = 2,
                  TaskB = 4,
                  TaskC = 0,
                  TaskD = 0)
nPointQ2Total <- sum(unlist(lPointsQ2))

# Assign Points for Q3
lPointsQ3 <- list(TaskA = 6,
                  TaskB = 3,
                  TaskC = 0,
                  TaskD = 0)
nPointQ3Total <- sum(unlist(lPointsQ3))

# Assign Points for Q4
lPointsQ4 <- list(TaskA = 15,
                  TaskB = 15,
                  TaskC = 3,
                  TaskD = 0)
nPointQ4Total <- sum(unlist(lPointsQ4))

# Assign Points for Q4
lPointsQ5 <- list(TaskA = 15,
                  TaskB = 15,
                  TaskC = 0,
                  TaskD = 0)
nPointQ5Total <- sum(unlist(lPointsQ5))

nPointOverallTotal <- nPointQ1Total + nPointQ2Total + nPointQ3Total + nPointQ4Total + nPointQ5Total

\thispagestyle{empty}

\fcolorbox{white}{white}{ \centering \parbox[t]{1.0\linewidth}{ \fontsize{12pt}{20pt}\selectfont % \vspace*{0.5cm} %

Peter von Rohr \\ Institute of Agricultural Sciences\\ D-USYS\\ ETH Zurich

    \vspace*{0.5cm} 
}

}

\vspace*{2cm}

\fcolorbox{white}{white}{ \parbox[t]{1.0\linewidth}{ \centering \fontsize{25pt}{40pt}\selectfont % \vspace*{0.2cm} 751-7602-00 V \ Exam in \ Applied Statistical Methods \ in Animal Sciences \ Summer Semester 2022

    \vspace*{0.7cm} % Space between the end of the title and the bottom of the grey box
}

}

\vspace*{1cm}

\begin{tabular}{p{3cm}p{6cm}} Date: & r params$examdate \ & \ & \ Name: & \ & \ & \ Legi-Nr: & \ \end{tabular}

\vspace{5ex} \begin{center} \begin{tabular}{|p{3cm}|c|c|} \hline Problem & Maximum Number of Points & Number of Points Reached\ \hline 1 & r nPointQ1Total & \ \hline 2 & r nPointQ2Total & \ \hline 3 & r nPointQ3Total & \ \hline 4 & r nPointQ4Total & \ \hline 5 & r nPointQ5Total & \ \hline Total & r nPointOverallTotal & \ \hline \end{tabular} \end{center}

\vspace{0.5cm}

\textit{Questions in German are in italics}

\clearpage \pagebreak

s_asm_data_url <- "https://charlotte-ngs.github.io/asmss2022/data"

Problem 1: Fixed Linear Effects Model

s_p01_data_path <- paste(s_asm_data_url, "asm_exam_p01.csv", sep = "/")
tbl_sw_p01 <- readr::read_csv(s_p01_data_path)

The following dataset on the slaughter weight and the sex of r nrow(tbl_sw_p01) beef animals is given.

Gegeben ist der folgende Datensatz zum Schlachtgewicht und zum Geschlecht von r nrow(tbl_sw_p01) Fleischrindern.

\vspace{1cm}

knitr::kable(tbl_sw_p01,
             booktabs = TRUE,
             longtable = TRUE)

The data is available from the address below and can be read by the function readr::read_csv()

Die Daten sind unter der nachfolgenden Adresse verfügbar und können mit der Funktion readr::read_csv() gelesen werden.

cat(s_p01_data_path, "\n")

\vspace{1cm} \begin{enumerate} \item[a)] Do an F-test with the data above to answer the question whether the fixed effect of the Sex of the animal has any influence at all on the slaugher weight.

\textit{Verwenden Sie einen F-Test zur Beantwortung der Frage ob der fixe Effekt des Geschlechts des Tieres überhaupt einen Einfluss auf das Schlachtgewicht hat.}

\end{enumerate} \points{r lPointsQ1$TaskA}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[b)] Fit the linear fixed effects model showing the effects of the different levels of Sex on Slaughter Weight. What is the order of the different levels of the factor Sex when ordering them according to the size of the effect obtained from the fitted model?

\textit{Passen Sie ein lineares fixes Modell an die Daten an, welches den Einfluss des Geschlechts auf das Schlachgewicht zeigt. Wie lautet die Reihenfolge der Effektstufen des Faktors Geschlecht, wenn diese nach der Effektgrösse aus dem geschätzten Modell sortiert werden?}

\end{enumerate} \points{r lPointsQ1$TaskB}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[c)] Show how the different effect estimates (Intercept and factor levels of Sex) are computed from a solution to the least squares normal equations using the data on slaughter weight and sex when treatment contrasts are used.

\textit{Zeigen Sie wie die Schätzwerte der verschiedenen Effekte (Achsenabschnitt und die Faktoren des Geschlechteffekts) aus einer Lösung der Least Squares-Normalgleichungen berechnet werden für die Daten zum Schlachtgewicht und Geschlecht unter der Verwendung von Treatment-Kontrasten.}

\end{enumerate} \points{r lPointsQ1$TaskC}

Solution

\clearpage \pagebreak

Problem 2: Linear Regression

s_p02_data_path <- paste(s_asm_data_url, "asm_exam_p02.csv", sep = "/")
tbl_ch4_p02 <- readr::read_csv(s_p02_data_path)

The following dataset contains the logarithm of methane emission (lCH4) and the logarithm of dry matter intake (lDMI) of r nrow(tbl_ch4_p02) cows.

Der folgende Datensatz enthält die logarithmierten Werte der Methanemmissionen (lCH4) und der täglichen Futteraufnahme (lDMI) für r nrow(tbl_ch4_p02) Kühe.

\vspace{1cm}

knitr::kable(tbl_ch4_p02,
             booktabs = TRUE,
             longtable = TRUE)

The data is available from the address below and can be read by the function readr::read_csv()

Die Daten sind unter der nachfolgenden Adresse verfügbar und können mit der Funktion readr::read_csv() gelesen werden.

cat(s_p02_data_path, "\n")

\clearpage \pagebreak

\begin{enumerate} \item[a)] Fit the linear regression model of lCH4 on lDMI.

\textit{Passen Sie ein lineares Regressionsmodell von lCH4 auf lDMI an.}

\end{enumerate} \points{r lPointsQ2$TaskA}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[b)] Show in the plot below, the estimates of the model coefficients obtained from the linear regression in Problem 2a. For a selected example observation, show the fitted value and the residual belonging to that selected observation.

\textit{Zeigen Sie im nachfolgenden Plot die geschätzten Modellkoeffizienten der linearen Regression aus der Aufgabe 2a). Für einen bestimmten Beobachtungswert zeigen Sie den Modellschätzwert und das Residuum, welches zur ausgewählten Beobachtung gehört.}

\end{enumerate} \points{r lPointsQ2$TaskB}

library(ggplot2)
ggplot(data = tbl_ch4_p02, aes(x = lDMI, y = lCH4)) + 
  geom_point() + 
  geom_smooth(method = "lm", se = FALSE, aes(color = "red"), show.legend = FALSE)

Solution

\clearpage \pagebreak

Problem 3: Model Selection

s_p03_data_path <- paste(s_asm_data_url, "asm_exam_p03.csv", sep = "/")
tbl_milk_p03 <- readr::read_csv(s_p03_data_path)

The following dataset contains fat yield (fat) of dairy cows as a response variable. Lactation number (lact), days in milk (dim) and height of the cow (hei) are avilable as predictor variables.

Der folgende Datensatz enhält Fettleistung (fat) von Milchkühen als eine Zielvariable. Laktationsnummer (lact), Laktationslänge in Tagen (dim) und Grösse der Kuh (hei) sind verfügbar als beschreibende Variablen.

\vspace{1cm}

knitr::kable(tbl_milk_p03,
             booktabs = TRUE,
             longtable = TRUE)

The data is available from the address below and can be read by the function readr::read_csv()

Die Daten sind unter der nachfolgenden Adresse verfügbar und können mit der Funktion readr::read_csv() gelesen werden.

cat(s_p03_data_path, "\n")

\clearpage \pagebreak

\begin{enumerate} \item[a)] Use model selection based on the $C_p$-value on the above dataset to find the best model. Which predictor variables are included in the best model based on the $C_p$-value? Which are the parameter estimates of the best model?

\textit{Verwenden Sie Modellselektion basierend auf dem $C_p$-Wert für den oben gegebenen Datensatz. Welche beschreibenden Variablen sind im besten Modell nach $C_p$-Wert enthalten? Wie lauten die geschätzten Parameter des besten Modells?}

\end{enumerate} \points{r lPointsQ3$TaskA}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[b)] Verify the result of the model selection using an analysis of variance (aov()) on the full model. Are you getting the same result as shown in Problem 3a?

\textit{Verifizieren Sie das Resultat der Modellselektion mit einer Varianzanalyse (aov()) auf dem vollen Modell. Erhalten Sie das gleiche Resultat, wie in Aufgabe 3a?}

\end{enumerate} \points{r lPointsQ3$TaskB}

Solution

\clearpage \pagebreak

Problem 4: Pedigree-Based BLUP

s_p04_data_path <- paste(s_asm_data_url, "asm_exam_p04.csv", sep = "/")
tbl_data_p04 <- readr::read_csv(s_p04_data_path)
sigma_u2 <- 16
sigma_p2 <- 80
h2 <- sigma_u2 / sigma_p2
sigma_s2 <- sigma_u2 / 4
lambda_u <- (sigma_p2 - sigma_u2) / sigma_u2
lambda_s <- (sigma_p2 - sigma_s2) / sigma_s2

The dataset shown below shows observations of a trait called P for r nrow(tbl_data_p04) animals. The phenotypic variance is assumed to be $r sigma_p2$. The heritability is $r h2$.

Der unten gezeigte Datensatz zeigt Beobachtungen eines Merkmals namens P für r nrow(tbl_data_p04) Tiere. Die phänotypische Varianz beträgt $r sigma_p2$. _Die Erblichkeit ist _ $r h2$.

\vspace{1cm}

knitr::kable(tbl_data_p04,
             booktabs = TRUE,
             longtable = TRUE)

The data is available from the address below and can be read by the function readr::read_csv()

Die Daten sind unter der nachfolgenden Adresse verfügbar und können mit der Funktion readr::read_csv() gelesen werden.

cat(s_p04_data_path, "\n")

\clearpage \pagebreak

\begin{enumerate} \item[a)] Use the above shown dataset to predict breeding values using a sire model. In that model include \verb+SEX+ as a fixed effect. Specify all model components with expected values and variance-covariance matrices for all random effects in the model. The ratio between residual variance and sire variance can be assumed as $r lambda_s$.

\textit{Schätzen Sie Zuchtwerte mit dem oben gezeigten Datensatz mit einem Vatermodell. In diesem Modell soll } \verb+SEX+ \textit{ als fixer Effekt modelliert werden. Geben Sie alle Modellkomponenten an und spezifizieren Sie Erwartungswerte und Varianz-Kovarianzmatrizen für alle zufälligen Effekte im Modell. Das Verhältnis zwischen Restvarianz und Vatervarianz kann angenommen werden als } $r lambda_s$.

\end{enumerate} \points{r lPointsQ4$TaskA}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[b)] Predict breeding values for all animals using an animal model. \verb+SEX+ is modelled as fixed effect. Specify all model components with expected values and variance-covariance matrices for all random effects in the model.

\textit{Schätzen Sie Zuchtwerte für alle Tiere mit dem Tiermodell.} \verb+SEX+ \textit{soll als fixer Effekt modelliert werden. Geben Sie alle Modellkomponenten an und spezifizieren Sie Erwartungswerte und Varianz-Kovarianzmatrizen für alle zufälligen Effekte im Modell.}

\end{enumerate} \points{r lPointsQ4$TaskB}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[c)] Compare the order of the sires according to the predicted breeding values from Problem 4a and 4b.

\textit{Vergleichen Sie die Reihenfolge der Stiere aufgrund der geschätzten Zuchtwerte aus den Aufgaben 4a und 4b.}

\end{enumerate} \points{r lPointsQ4$TaskC}

Solution

\clearpage \pagebreak

Problem 5: Genomic Prediction of Breeding Values

s_p05_data_path <- paste(s_asm_data_url, "asm_exam_p05.csv", sep = "/")
tbl_data_p05 <- readr::read_csv(s_p05_data_path)
lambda_q <- 1
lambda_g <- 1

The following dataset is used to predict genomic breeding values.

Der nachfolgende Datensatz wird zur Schätzung von genomischen Zuchtwerten verwendet.

\vspace{1cm}

knitr::kable(tbl_data_p05,
             booktabs = TRUE,
             longtable = TRUE)

The data is available from the address below and can be read by the function readr::read_csv()

Die Daten sind unter der nachfolgenden Adresse verfügbar und können mit der Funktion readr::read_csv() gelesen werden.

cat(s_p05_data_path, "\n")

\clearpage \pagebreak

\begin{enumerate} \item[a)] Predict genomic breeding values based on the dataset shown above using a marker effect model. The ratio between residual variance and marker effect is $r lambda_q$.

\textit{Schätzen Sie genomische Zuchtwerte aufgrund des oben gezeigten Datensatzes mit einem Markereffektmodell. Das Verhältnis zwischen Restvarianz und Markervarianz beträgt} $r lambda_q$.

\end{enumerate} \points{r lPointsQ5$TaskA}

Solution

\clearpage \pagebreak

\begin{enumerate} \item[b)] Predict genomic breeding values based on the dataset shown above using a breeding value-based model. The ratio between residual variance and genomic variance is $r lambda_g$.

\textit{Schätzen Sie genomische Zuchtwerte aufgrund des oben gezeigten Datensatzes mit einem Zuchtwertmodell. Das Verhältnis der Restvarianz zur genomischen Varianz beträgt }$r lambda_g$.

\end{enumerate} \points{r lPointsQ5$TaskB}

Solution

charlotte-ngs/asmss2022 documentation built on June 7, 2022, 1:33 p.m.