In charlotte-ngs/lbgfs2020: Livestock Breeding and Genomics (Fall 2020)

cat(cnt$out(ps_suffix = "Numerator Relationship Matrix and Inbreeding"), "\n")

We are given the following pedigree.

\textit{Das folgende Pedigree ist gegeben.}

\begin{center}

knitr::kable(tbl_ped_nrm,
             booktabs = TRUE,
             escape = FALSE,
             format = 'latex')

\end{center}

\begin{enumerate} \item[a)] Compute the additive genetic relationship matrix $A$ for the above pedigree.

\textit{Berechnen Sie die additiv-genetische Verwandtschaftsmatrix $A$ für das oben angegebene Pedigree} \points{r lPointsQ1$TaskA} \end{enumerate}

\solstart

The numerator relationship matrix is computed using pedigreemm::getA(). In a first step, we have to extend the pedigree to contain the founder animals in the ID-column.

vec_founder_sire <- setdiff(tbl_ped_nrm$Sire, tbl_ped_nrm$ID)
n_nr_founder_sire <- length(vec_founder_sire)
vec_founder_dam <- setdiff(tbl_ped_nrm$Dam, tbl_ped_nrm$ID)
n_nr_founder_dam <- length(vec_founder_dam)

# check that founder_sire and founder_dam are not the same
if (length(intersect(vec_founder_sire, vec_founder_dam)) != 0) 
  stop(" * ERROR: Founder sires and founder dams are not exclusive")
tbl_ped_nrm_ext <- dplyr::bind_rows(
  tibble::tibble(ID = vec_founder_sire[order(vec_founder_sire)],
                 Sex = rep('M', n_nr_founder_sire),
                 Sire = rep(NA, n_nr_founder_sire),
                 Dam  = rep(NA, n_nr_founder_sire)),
  tibble::tibble(ID = vec_founder_dam[order(vec_founder_dam)],
                 Sex = rep('F', n_nr_founder_dam),
                 Sire = rep(NA, n_nr_founder_dam),
                 Dam  = rep(NA, n_nr_founder_dam)),
  tbl_ped_nrm)

ped_nrm <- pedigreemm::pedigree(sire = tbl_ped_nrm_ext$Sire, 
                                dam = tbl_ped_nrm_ext$Dam, 
                                label = as.character(tbl_ped_nrm_ext$ID))
(matA_nrm <- as.matrix(pedigreemm::getA(ped = ped_nrm)))

\solend

\clearpage \pagebreak

\begin{enumerate} \item[b)] Compute the inbreeding coefficients of all animals in the given pedigree. Complete the following table and indicate which of the animals are inbred.

\textit{Berechnen Sie die Inzuchtkoeffizienten aller Tiere im gegebenen Pedigree. Vervollständigen Sie die folgende Tabelle und geben an, welche Tiere ingezüchtet sind.} \points{r lPointsQ1$TaskB} \end{enumerate}

\vspace{3ex}

n_nr_animal <- max(tbl_ped_nrm$ID)
tbl_inb_empty <- tibble::tibble(ID = 1:n_nr_animal, 
                          `Inbreeding Coefficient` = rep('', n_nr_animal),
                          `Animal Inbred (TRUE/FALSE)` = rep('', n_nr_animal))

knitr::kable(tbl_inb_empty,
             booktabs = TRUE,
             escape = FALSE,
             format = 'latex')

\solstart

\vspace{5ex} The numeric solution is

vec_inbr_yn <- ifelse(diag(matA_nrm) > 1, "TRUE", "FALSE")
vec_inbr_coef <- diag(matA_nrm) - 1
# tibble for table
(tbl_inb_sol <- tibble::tibble(ID = tbl_ped_nrm_ext$ID, 
                          `Inbreeding Coefficient` = round(vec_inbr_coef, digits = 3),
                          `Animal Inbred (TRUE/FALSE)` = vec_inbr_yn))

\solend

\clearpage \pagebreak

\begin{enumerate} \item[c)] Assume that dam r dam_id and sire r sire_id are mated. What is the inbreeding coefficient of their offspring?

\textit{Wir nehmen an, dass die Mutter r dam_id mit dem Vater r sire_id angepaart wird. Wie gross ist der Inzuchtkoeffizient des Nachkommens aus dieser Paarung?} \points{r lPointsQ1$TaskC} \end{enumerate}

\solstart

The inbreeding coefficient of the offspring of dam r dam_id and sire r sire_id is half of the relationship between the parents.