R/maternal.R

In purgeR: Inbreeding-Purging Estimation in Pedigreed Populations

#' Maternal effects
#'
#' For every individual in the pedigree, it will assign them their maternal (or
#' paternal) value for an observed variable of interest.
#'
#' @template ped-arg
#' @template valuefrom-arg
#' @template nameto-arg
#' @param use_dam Extract maternal values. If false, parental values are returned.
#' @param set_na When maternal values are unknown, NA values are generated by default. This option allows to set a different value.
#' @return The input dataframe, plus an additional column with maternal (or paternal) values of a variable of interest.
#' @examples
#' # To assign maternal inbreeding as a new variable, we can do as follows:
#' data(dama)
#' dama <- ip_F(dama)
#' dama <- ped_maternal(dama, value_from = "Fi", name_to = "Fdam")
#' tail(dama)
#' @export
ped_maternal <- function(ped, value_from, name_to, use_dam = TRUE, set_na = NULL) {

  # Check input errors
  check_basic(ped, "id", "dam", "sire")
  check_col(base::colnames(ped), value_from)
  check_not_col(base::colnames(ped), name_to)
  check_bool(use_dam)
  check_length(set_na)

  # Return maternal effect
  idx <- ifelse(ped[["dam"]] == 0, NA, ped[["dam"]])
  x <- ifelse(is.na(idx), NA, ped[[value_from]][idx])
  if (!use_dam) {
    idx <- ifelse(ped[["sire"]] == 0, NA, ped[["sire"]])
    x <- ifelse(is.na(idx), NA, ped[[value_from]][idx])
  }
  if (!is.null(set_na)) x <- ifelse(is.na(x), set_na, x)
  ped[name_to] <- x
  ped
}