R/targetHeight.R

In CrescNet/GrowthSDS: Utility Functions for Growth SDS Calculations

#' Calculate target height
#'
#' @param sex sex of the subject, must correspond to the sex of the reference
#' @param motherHeight height of the mother
#' @param fatherHeight height of the father
#' @param targetAge age when target height is reached
#' @param measurement name of the measurement in the reference (default: 'height')
#' @param method method to be used to calculate the target height,
#'   possible values are 'Tanner' (default), 'Molinari' and 'Hermanussen'
#' @param refName name of the reference to be used to calculate the SDS values, defaults to 'kromeyer-hauschild_et_al'
#' @param ref reference object to be used to calculate the SDS, either ref or refName must be given
#' @param hermanussen.coef coefficiant of Hermanussen target height formula
#' @param tanner.coef list of coefficiants of Tanner target height formula (key-value-pairs where the key is sex)
#' @param molinari.coef list of coefficiants of Molinari target height formula (key-value-pairs where the key is sex)
#' @return list containing height, sds and method
#' @examples
#' targetHeight(
#'   sex = 'female',
#'   motherHeight = 175,
#'   fatherHeight = 180,
#'   method = 'Hermanussen',
#'   refName = 'cdc'
#' )
#' @export
targetHeight <- function(
  sex,
  motherHeight,
  fatherHeight,
  targetAge   = 18,
  measurement = 'height',
  method      = 'Tanner',
  refName,
  ref = GrowthSDS::kromeyerHauschild,
  hermanussen.coef = .72,
  tanner.coef      = list(male = 6.5,  female = -6.5),
  molinari.coef    = list(male = 10.2, female = -2.6)
) {
  if (missing(sex))          stop("required argument 'sex' is missing")
  if (missing(motherHeight)) stop("required argument 'motherHeight' is missing")
  if (missing(fatherHeight)) stop("required argument 'fatherHeight' is missing")
  if (missing(refName) & is.null(ref)) stop("no reference provided, please specify 'ref' or 'refName'")
  if (!missing(refName)) ref <- get(refName)
  if (class(ref) != 'Reference') stop("'ref' must be of class 'Reference'")

  if (!measurement %in% names(ref@values))
    stop(sprintf("reference '%s' has no measurement '%s'", ref@title, measurement))

  if (!method %in% c('Tanner', 'Molinari', 'Hermanussen'))
    stop("'method' must be one of 'Tanner', 'Molinari' or 'Hermanussen'")


  targetHeight <- purrr::pmap_dbl(list(sex, motherHeight, fatherHeight), function(sex, motherHeight, fatherHeight) {
    if (method == 'Hermanussen') {
      fatherHeightSds <- sds(targetAge, fatherHeight, 'male',   measurement, ref)
      motherHeightSds <- sds(targetAge, motherHeight, 'female', measurement, ref)
      sds <- (fatherHeightSds + motherHeightSds) / 2 * hermanussen.coef
      return(centile(targetAge, sds, sex, measurement, ref))
    }

    if (method == 'Tanner') {
      targetHeight = (motherHeight + fatherHeight) / 2 + tanner.coef[[sex]]
    } else {
      targetHeight = (motherHeight + fatherHeight) / 2 + molinari.coef[[sex]]
    }
  })

  list(
    height = targetHeight,
    sds    = sds(targetAge, targetHeight, sex, measurement, ref),
    method = method
  )
}