R/getFocalAnimalPed.R

In nprcgenekeepr: Genetic Tools for Colony Management

#' Get pedigree based on list of focal animals
#'
## Copyright(c) 2017-2024 R. Mark Sharp
## This file is part of nprcgenekeepr
#'
#' @return A pedigree file compatible with others in this package.
#'
#' @param fileName character vector of temporary file path.
#' @param sep column separator in CSV file
#' @import futile.logger
#' @importFrom readxl excel_format
#' @importFrom utils read.table
#' @export
#' @examples
#' library(nprcgenekeepr)
#' siteInfo <- getSiteInfo(FALSE)
#' source <- " generated by getFocalAnimalPed: "
#' tryCatch(getFocalAnimalPed(fileName = "breeding file.csv"),
#'   warning = function(wCond) {
#'     cat(paste0("Warning", source, wCond),
#'       name = "nprcgenekeepr"
#'     )
#'     return(NULL)
#'   },
#'   error = function(eCond) {
#'     cat(paste0("Error", source, eCond),
#'       name = "nprcgenekeepr"
#'     )
#'     return(NULL)
#'   }
#' )
getFocalAnimalPed <- function(fileName, sep = ",") {
  flog.debug(paste0("in getFocalAnimalPed\n"),
    name = "nprcgenekeepr"
  )
  if (excel_format(fileName) %in% c("xls", "xlsx")) {
    focalAnimals <- readExcelPOSIXToCharacter(fileName)
    flog.debug(paste0(
      "in getFocalAnimalPed after readxl, ",
      "nrow(focalAnimals) = ",
      nrow(focalAnimals), "\n"
    ), name = "nprcgenekeepr")
  } else {
    focalAnimals <- read.csv(fileName,
      header = TRUE,
      sep = sep,
      stringsAsFactors = FALSE,
      na.strings = c("", "NA"),
      check.names = FALSE
    )
    flog.debug(paste0(
      "in getFocalAnimalPed after read.csv, ",
      "nrow(focalAnimals) = ",
      nrow(focalAnimals), "\n"
    ), name = "nprcgenekeepr")
  }
  focalAnimals <- as.character(focalAnimals[, 1L])
  ped <- getLkDirectRelatives(ids = focalAnimals)
  if (is.null(ped)) {
    flog.debug(paste0(
      "in getFocalAnimalPed after getLkDirectRelatives, which ",
      "returned NULL.\n"
    ), name = "nprcgenekeepr")
    errorLst <- getEmptyErrorLst()
    errorLst$failedDatabaseConnection <-
      "Database connection failed: configuration or permissions are invalid."
    return(errorLst)
  }
  flog.debug(
    paste0(
      "in getFocalAnimalPed after getLkDirectRelatives, which ",
      "returned ped with ", nrow(ped), "rows.\n"
    ),
    name = "nprcgenekeepr"
  )
  names(ped) <- c("id", "sex", "birth", "death", "departure", "dam", "sire")
  ped <- ped[!is.na(ped$id), ]
  ped$birth <- format(ped$birth, format = "%Y-%m-%d")
  ped$death <- format(ped$death, format = "%Y-%m-%d")
  ped$departure <- format(ped$departure, format = "%Y-%m-%d")
  ped
}