R/getLkDirectAncestors.R

In rmsharp/nprcmanager: Genetic Tools for Colony Management

#' Get the direct ancestors of selected animals
#'
## Copyright(c) 2017-2020 R. Mark Sharp
## This file is part of nprcgenekeepr
#' Gets direct ancestors from labkey \code{study} schema and \code{demographics}
#' table.
#'
#' @return data.frame with pedigree structure having all of the direct ancestors
#' for the Ids provided.
#'
#' @examples
#' \donttest{
#' library(nprcgenekeepr)
#' ## Have to a vector of focal animals
#' focalAnimals <- c("1X2701", "1X0101")
#' suppressWarnings(getLkDirectAncestors(ids = focalAnimals))
#' }
#'
#' @param ids character vector with Ids.
#' @import futile.logger
#' @importFrom stringi stri_c
#' @export
getLkDirectAncestors <- function(ids) {
  siteInfo <- getSiteInfo()
  colSet <- siteInfo$lkPedColumns
  source <- " generated by getDemographics in getLkDirectAncestors: "
  pedSourceDf <- tryCatch(getDemographics(colSelect = colSet),
                          warning = function(wCond) {
                            flog.debug(stri_c("Warning", source, wCond),
                                       name = "nprcgenekeepr")
                            return(NULL)},
                          error = function(eCond) {
                            flog.debug(stri_c("Error", source, eCond),
                                       name = "nprcgenekeepr")
                            return(NULL)}
  )
  if (is.null(pedSourceDf))
    return(NULL)
  names(pedSourceDf) <- siteInfo$mapPedColumns
  parents <- ids
  len <- length(parents)
  ancestorsDf <- pedSourceDf[pedSourceDf$id %in% ids, ]
  while (len > 0) {
    parents <- getParents(pedSourceDf, parents)
    len <- length(parents)
    if (len > 0) {
      ancestorsDf <- rbind(ancestorsDf,
                           pedSourceDf[pedSourceDf$id %in% parents, ],
                           stringsAsFactors = FALSE)
    }
  }
  ancestorsDf[!duplicated(ancestorsDf$id), ]
}