R/calculateSexRatio.R

In rmsharp/nprcmanager: Genetic Tools for Colony Management

#' Calculates the sex ratio (number of non-males / number of males) given
#' animal Ids and their pedigree
## Copyright(c) 2017-2020 R. Mark Sharp
## This file is part of nprcgenekeepr
#'
#' @description The Males are counted when the \code{ped$sex} value is
#' \code{"M"}.
#' When females are counted when the \code{ped$sex} value is not
#' \code{"M"}. This means animals with ambiguous sex are counted with the
#' females.
#'
#' @return Numeric value of sex ratio of the animals provided.
#'
#' @examples
#' \donttest{
#' library(nprcgenekeepr)
#' data("qcBreeders")
#' data("pedWithGenotype")
#' available <- c("JGPN6K", "8KM1MP", "I9TQ0T", "Q0RGP7", "VFS0XB", "CQC133",
#'                "2KULR3", "HOYW0S", "FHV13N", "OUM6QF", "6Z7MD9", "CFPEEU",
#'                "HLI95R", "RI0O7F", "7M51X5", "DR5GXB", "170ZTZ", "C1ICXL")
#' nonMales <- c("JGPN6K", "8KM1MP", "I9TQ0T", "Q0RGP7", "CQC133",
#'               "2KULR3", "HOYW0S", "FHV13N", "OUM6QF", "6Z7MD9", "CFPEEU",
#'               "HLI95R", "RI0O7F", "7M51X5", "DR5GXB", "170ZTZ", "C1ICXL")
#' male <- "VFS0XB"
#' calculateSexRatio(ids = male, ped = pedWithGenotype)
#' calculateSexRatio(ids = nonMales, ped = pedWithGenotype)
#' calculateSexRatio(ids = available, ped = pedWithGenotype)
#' calculateSexRatio(ids = available, ped = pedWithGenotype,
#'                         additionalMales = 1)
#' calculateSexRatio(ids = available, ped = pedWithGenotype,
#'                   additionalFemales = 1)
#' calculateSexRatio(ids = available, ped = pedWithGenotype,
#'                   additionalMales = 1, additionalFemales = 1)
#' calculateSexRatio(ids = nonMales, ped = pedWithGenotype,
#'                   additionalMales = 1, additionalFemales = 0)
#' calculateSexRatio(ids = character(0), ped = pedWithGenotype,
#'                 additionalMales = 1, additionalFemales = 0)
#' }
#'
#' @param ids character vector of animal Ids
#' @param ped datatable that is the `Pedigree`. It contains pedigree
#' information including the IDs listed in \code{candidates}.
#' @param additionalMales Integer value of males to add to those within the
#' group when calculating the ratio. Ignored if calculated ratio is 0 or Inf.
#' Default is 0.
#' @param additionalFemales Integer value of females to add to those within the
#' group when calculating the ratio. Ignored if calculated ratio is 0 or Inf.
#'Default is 0.
#' @export
calculateSexRatio <- function(ids, ped, additionalMales = 0,
                              additionalFemales = 0) {
  if (length(ids) == 0) {
    if (additionalFemales > 0) {
      if (additionalMales == 0) {
        ratio <- Inf
      } else if (additionalMales > 0) {
        ratio <- getSexRatioWithAdditions(ids, ped, additionalMales,
                                          additionalFemales)
      }
    } else if (additionalFemales == 0) {
      if (additionalMales == 0) {
        ratio <- NA
      } else {
        ratio <- 0.0
      }
    }
  } else if (length(ped$sex[ped$id %in% ids & ped$sex == "M"]) == 0) { #no males
    if (additionalMales > 0) {
      ratio <- getSexRatioWithAdditions(ids, ped, additionalMales,
                                        additionalFemales)
    } else {
      ratio <- Inf
    }
  } else {
    ratio <- getSexRatioWithAdditions(ids, ped, additionalMales,
                                      additionalFemales)
  }

  ratio
}