R/findGeneration.R

In rmsharp/nprcmanager: Genetic Tools for Colony Management

#' Determines the generation number for each id.
#'
## Copyright(c) 2017-2020 R. Mark Sharp
## This file is part of nprcgenekeepr
#'
#' @return An integer vector indication the generation numbers for each id,
#' starting at 0 for individuals lacking IDs for both parents.
#'
#' @examples
#' \donttest{
#' library(nprcgenekeepr)
#' ped <- nprcgenekeepr::lacy1989Ped[ , c("id", "sire", "dam")]
#' ped$gen <- findGeneration(ped$id, ped$sire, ped$dam)
#' ped
#' }
#'
#' @param id character vector with unique identifier for an individual
#' @param sire character vector with unique identifier for an
#' individual's father (\code{NA} if unknown).
#' @param dam character vector with unique identifier for an
#' individual's mother (\code{NA} if unknown).
#' @export
findGeneration <- function(id, sire, dam) {
  parents <- c()
  gen <- rep(NA, length(id))
  i <- 0

  #' @description{This loops through the entire pedigree one generation at a
  #' time. It finds the zeroth generation during first loop.
  #' The first time through this loop no sire or dam is in parents.
  #' This means that the animals without a sire and without a dam are
  #' assigned to generation 0 and become the first parental generation.
  #' The second time through this loop finds all of the animals that do
  #' not have a sire or do not have a dam and at least one parent
  #' is in the vector of parents defined the first time through.
  #' The ids that were not assigned as parents in the previous loop
  #' are given the incremented generation number.}
  #'
  #' Subsequent trips in the loop repeat what was done the second time
  #' through until no further animals can be added to the \code{nextGen}
  #' vector.
  #'
  #' This does not work if the pedigree does not have all parent IDs as ego IDs.
  while (TRUE) {
    cumulativeParents <- id[(is.na(sire) | (sire %in% parents)) &
                               (is.na(dam) | (dam %in% parents))]
    nextGen <- setdiff(cumulativeParents, parents)

    if (isEmpty(nextGen)) {
      break
    }

    gen[id %in% nextGen] <- i
    i <- i + 1

    parents <- cumulativeParents
  }
  return(gen)
}