knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)

Problem 1: Own Performance

set.seed(4206)
n_nr_animal <- 12
n_weight_mean <- 283
n_weight_sd <- 3
vec_weight <- round(rnorm(n_nr_animal, mean = n_weight_mean, n_weight_sd), digits = 0)
tbl_weight <- tibble::tibble(Animal = c(1:n_nr_animal),
                             Weight = vec_weight)
n_weight_h2 <- 0.2025

Given is the dataset with weight observations for r n_nr_animal animals. The heritability ($h^2$) for the trait is r n_weight_h2. The population mean $\mu$ can assumed to be the mean of the weights in the table below.

`

knitr::kable(tbl_weight)

Your Tasks

Your Solution

Problem 2: Breeding Value Prediction Based on Repeated Observations

geb_gew <- 52
mu2 <- 170
rep <- 0.65
h2 <- 0.45
y <- 320
mu <- 250

Elsa has observations for her birth weight ($r geb_gew$ kg) and some more repeated measures for her weight. We assume the heritability to be $h^2 = r h2$. The population mean for the repeated observations of the weight is $r mu2$ kg. The repeatability of the weight measurements is $t = r rep$.

The following tables contains all observed values for the weight.

nr_measure <- 10
wean_weight <- y
slope <- (wean_weight-geb_gew)/(nr_measure-1)
measure <- c(1:nr_measure)
weight <- round(slope*(measure-1) + geb_gew, digits = 0)
mean_weight <- mean(weight)
dfWeightTable <- data.frame(Measurement = measure, Weight = weight)
knitr::kable(dfWeightTable)

a) Predict the breeding value for Elsa based on the repeated weight records. b) What is the reliability for the predicted breeding value from 2a)? c) Compare the reliability from 2b) with the reliability that would result from a prediction of breeding values based on own performance.

Your Solution

Problem 3: Predict Breeding Values Based on Progeny Records

n_nr_progeny <- 5

A few years later Elsa was the dam of r n_nr_progeny offspring. Each of the offspring has a record for weaning weight. Predict the breeding value of Elsa for weaning weight based on the offpsring records listed in the following table.

vec_ww_prog <- round(y + rnorm(n_nr_progeny, mean = 0, sd = 2), digits = 0)
tbl_prog_ww <- tibble::tibble(Offspring = c(1:n_nr_progeny),
                              `Weaning Weight` = vec_ww_prog)
knitr::kable(tbl_prog_ww)

The mean and the heritability can be taken the same as in Problems 1 and 2 resulting in

$h^2 = r h2$ and $\mu = r mu$

Your Solution



charlotte-ngs/lbgfs2021 documentation built on Dec. 19, 2021, 3:01 p.m.