In fbzwsqualitasag/qpdt: Consistency Checks For Animal Pedigrees

knitr::opts_chunk$set(echo = TRUE)

# parameter settings for current pedigree
if (params$pedigreeType == 'gnm'){
  l_settings <- qpdt::get_gnm_prp_settings()  
} else if (params$pedigreeType == 'argus'){
  l_settings <- qpdt::get_argus_prp_settings()
} else {
  l_settings <- qpdt::get_generic_settings()
}

# initialise variables that influence the inculsion of junks
nr_sire_incon_bd <- 0
nr_dam_incon_bd <- 0
nr_sire_eqid <- 0
nr_dam_eqid <- 0
nr_sire_wrongsex <- 0
nr_dam_wrongsex <- 0
# initialise loop check result
l_loop_check_result <- list(PedFile = params$pedigreePath,
                            HasCycle = NA,
                            TblCycle = NULL)

# check computation required for the summary table
# ID - check
l_pedig_id_result <- qpdt::check_pedig_id(ps_pedig_path = params$pedigreePath, 
                                          ps_id_col     = l_settings$id_col,
                                          ps_delim      = l_settings$col_delim)
# number of duplicates
n_nr_dupl <- ifelse(is.null(l_pedig_id_result$TblDuplicates), 0, nrow(l_pedig_id_result$TblDuplicates))
# get the results for the data type check
l_dtp_check_result <- qpdt::check_pedigree_datatypes(ps_pedig_path = params$pedigreePath, pl_dtype = l_settings$l_dtype)
# number of data type mismatches
n_nr_mismatch <- sum(l_dtp_check_result$ReqDType$dtp != l_dtp_check_result$CurDType$dtp)

if (n_nr_mismatch == 0){
  l_parent_result <- qpdt::check_pedig_parent(ps_pedig_path = params$pedigreePath,
                                              ps_id_col        = l_settings$id_col,
                                              ps_sire_col      = l_settings$sire_col,
                                              ps_dam_col       = l_settings$dam_col,
                                              ps_bd_col        = l_settings$bd_col,
                                              ps_sex_col       = l_settings$sex_col)
  # number of inconsistent birthdates
  nr_sire_incon_bd <- nrow(l_parent_result$TblSireBdate)
  nr_dam_incon_bd <- nrow(l_parent_result$TblDamBdate)
  # number of equal ids between parents and animals
  nr_sire_eqid <- nrow(l_parent_result$TblSireEqID)
  nr_dam_eqid <- nrow(l_parent_result$TblDamEqID)
  # number of parents with wrong sex
  nr_sire_wrongsex <- nrow(l_parent_result$TblSireWrongSex)
  nr_dam_wrongsex <- nrow(l_parent_result$TblDamWrongSex)

  # checking loops
  if (params$checkLoop == 'yes'){
    l_loop_check_result <- qpdt::check_cycle_pedigree(ps_pedig_path = params$pedigreePath,
                                                      pb_report_cycle = TRUE,
                                                      pn_id_col = l_settings$id_col_idx,
                                                      pn_sire_col = l_settings$sire_col_idx,
                                                      pn_dam_col = l_settings$dam_col_idx)

  }

}

Summary

The following table gives an overview of the reported pedigree checks.

tbl_summary <- tibble::tibble(Property = c("Pedigree Input File",
                                           "Number of duplicate IDs",
                                           "Number of data type mismatches",
                                           "Number of birthdate inconsistencies",
                                           "Number of equal IDs",
                                           "Number of parents with wrong sex",
                                           "Has Pedigree Cycles"),
                              Value    = c(basename(l_pedig_id_result$PedFile),
                                           n_nr_dupl,
                                           n_nr_mismatch,
                                           nr_sire_incon_bd+nr_dam_incon_bd,
                                           nr_sire_eqid+nr_dam_eqid,
                                           nr_sire_wrongsex+nr_dam_wrongsex,
                                           ifelse(is.null(l_loop_check_result), NA, l_loop_check_result$HasCycle)))
knitr::kable(tbl_summary)

Disclaimer

This document contains the report for the pedigree: r params$pedigreeName. The report is generated by the function qpdt::create_report(). The report should show potential problems with the input pedigrees.

General Properties

It is assumed that the pedigree to be checked in this report is given by a tabular representation. Each row in the table specifies for each animal the available information, such as sire, dam, date of birth and further information.

Animals in a pedigree must be identified by unique identifiers. These identifiers are also used to assign parents to animals. The check for the uniqueness of the identifiers yields the following result.

The currently checked pedigree is imported from: r l_pedig_id_result$PedFile.

The results of the uniqueness check of the identifiers is shown in the table below.

tbl_uni_id <- tibble::tibble(Property = c('Number of records',
                                          'Number of animals',
                                          'Number of duplicate IDs'),
                             Value    = c(l_pedig_id_result$NrRecord,
                                          l_pedig_id_result$NrAnimals,
                                          n_nr_dupl))
knitr::kable(tbl_uni_id)

The pedigree contains r paste0(n_nr_dupl, ' duplicate ID', ifelse(n_nr_dupl != 1, 's', ''), collapse = ''). r if (n_nr_dupl > 0) "In case the above check found some duplicate identifiers, they are shown in the table below."

 knitr::kable(l_pedig_id_result$TblDuplicates)

Data Types

Entries in the same column must all be of a certain data type. The data type can either be specified at reading time or it is automatically determined when reading the pedigree from the file. The determined data types are then compared to the required data types specified as input. The following table compares the required data types to the data types found in the input file.

# get the number of parse problems
n_nr_parse_problem <- ifelse(is.null(l_dtp_check_result$DTypeProblems), 0, nrow(l_dtp_check_result$DTypeProblems))
# create table with comparison of data types
tbl_datatypes <- tibble::tibble(Column = l_settings$l_dtype$col,
                                `Required Data Type` = l_settings$l_dtype$dtp,
                                `Found Data Type`    = l_dtp_check_result$CurDType$dtp)
knitr::kable(tbl_datatypes)

The comparison between the required and the number of found data types resulted in r paste0(n_nr_mismatch, ' mismatch', ifelse(n_nr_mismatch != 1, 'es', ''), collapse = ''). r if(n_nr_mismatch > 0) "In case where mismatches could be found, the respective parse problems are shown in the table below."

cat("\n<!--\n")

Pedigree Input Parse Problems

The following table shows problems when parsing the pedigree input file.

knitr::kable(l_dtp_check_result$DTypeProblems)

Note

In case the above table shows problems with parsing the given pedigree input file, then all subsequent R-code junks cannot be evaluated and the ouput of the rest of the report is suppressed. To see the remainer of the report, the parsing problems must be fixed first.

cat("\n-->\n\n")

# in case where parse problems were found, the following junks can no longer be evaluated
knitr::opts_chunk$set(eval = (n_nr_parse_problem == 0))
cat('\n<!--\n\n')

Parents

Parents of animals must fullfill certain properties. The following properties are checked

• number of animals without parents
• number of parents which do not appear as animals
• number of parents with inconsistent birthdates
• number of parents that have the same ID as their offspring
• number of parents which have the wrong sex

The following table shows the numbers of all the checked properties.

tbl_parent_result <- tibble::tibble(Property = c('Animals with missing sires',
                                                 'Animals with missing dams',
                                                 'Sires not occuring as animals',
                                                 'Dams not occurding as animals',
                                                 'Sires with inconsistent birthdates',
                                                 'Dams with inconsistent birthdates',
                                                 'Sires with same ID as offspring',
                                                 'Dams with same ID as offspring',
                                                 'Sires with wrong sex',
                                                 'Dams with wrong sex'),
                                    `Count Values` = c(l_parent_result$NrMissingSire,
                                                       l_parent_result$NrMissingDam,
                                                       l_parent_result$NrSireNotAnimal,
                                                       l_parent_result$NrDamNotAnimal,
                                                       nr_sire_incon_bd,
                                                       nr_dam_incon_bd,
                                                       nr_sire_eqid,
                                                       nr_dam_eqid,
                                                       nr_sire_wrongsex,
                                                       nr_dam_wrongsex))
knitr::kable(tbl_parent_result)

In case that there are pedigree records with inconsistent information concerning parents of animals, the respective records are shown in the table below.

# number of inconsistent birthdates with sires
cat("\n<!--\n")

Inconsistent Birthdates for Sires

The records with inconsistent birthdates between animals and sires are shown in the table below.

knitr::kable(l_parent_result$TblSireBdate)

cat("\n-->\n\n")

# number of inconsistent birthdates with dams
cat("\n<!--\n")

Inconsistent Birthdates for Dams

The records with inconsistent birthdates between animals and dams are shown in the table below.

knitr::kable(l_parent_result$TblDamBdate)

cat("\n-->\n\n")

# number of equal ids between sire and animals
cat("\n<!--\n")

Inconsistent IDs of Sires and Offspring

The following animals have the same ID as their sires.

knitr::kable(l_parent_result$TblSireEqID)

cat("\n-->\n\n")

# number of equal ids between dam and animals
cat("\n<!--\n")

Inconsistent IDs of Dams and Offspring

The following animals have the same ID as their dams.

knitr::kable(l_parent_result$TblDamEqID)

cat("\n-->\n\n")

# number sires with wrong sex
cat("\n<!--\n")

Sires with wrong sex

The following sires have the wrong sex.

knitr::kable(l_parent_result$TblSireWrongSex)

cat("\n-->\n\n")

# number dams with wrong sex
cat("\n<!--\n")

Dams with wrong sex

The following dams have the wrong sex.

knitr::kable(l_parent_result$TblDamWrongSex)

cat("\n-->\n\n")

# inclusion of loop checks
cat("\n<!--\n")

Loops

Pedigrees can be represented as directed acyclic graphs (DAG) and as such they must not contain any loops. In the context of a pedigree, a loop is a path of recursive parent-offspring relationships where an animal occurs more than once. The following table contains the result whether the given pedigree contains a loop.

tbl_loop_result <- tibble::tibble(Pedigree = c('Input File',
                                               'Has Cycles'),
                                  Value = c(l_loop_check_result$PedFile,
                                            l_loop_check_result$HasCycle))
knitr::kable(tbl_loop_result)

r if(is.na(l_loop_check_result$HasCycle)){"The pedigree could not be checked for loops."} else{ if(l_loop_check_result$HasCycle){"The pedigree contains loops. The animals that constitute the loop are shown in the table below."}else{"The pedigree does not contain any loops."}}

knitr::kable(l_loop_check_result$TblCycle)

cat("\n -->\n\n")

cat("\n -->\n\n")

cat("\n\n---\n", "_Latest Changes: ", format(Sys.time(), format = "%Y-%m-%d %H:%M:%S"), " (", Sys.info()[['user']], ")_")

fbzwsqualitasag/qpdt documentation built on April 5, 2021, 9:28 p.m.