R/who2005_functions.R

In nlapidus/anthro: Indicators of the attained growth standards

# empty src file

# https://stackoverflow.com/questions/10346810/clone-repository-into-github
# $ cd your_local_repo
# $ git remote add origin git@github.com:USERNAME/REPO_NAME.git
# $ git push origin master


calc_z_weight_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  weight, weight_unit = "kg",
  edema = NULL, edema_code = c(yes = 1, no = 0),
  verbose = T) {
  value <- weight
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 weight-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 weight-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 weight-for-age Z-scores.")
  if (is.null(weight)) stop("Error: weight missing to compute WHO 2005 weight-for-age Z-scores.")
  if (!is.numeric(weight)) stop("Error: weight must be numeric to compute WHO 2005 weight-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(weight))
  if (!any(length(sex), length(age), length(weight)) %in% c(1L, length_max))
    stop("Error: sex, age and weight must be same length or length 1 to compute WHO 2005 weight-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(weight) == 1L) weight <- rep(weight, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 0 | age >= 1856.5))) {
    warning("Age must be < 1857 days (< 61 months) to compute WHO 2005 standards. Values out of range are set to NA.")
    age[age < 0 | age >= 1856.5] <- NA
  }
  if (!is.null(edema)) {
    if (!length(edema) %in% c(1L, length_max))
      stop("Error: edema must be same length as sex, age and weight or length 1 to compute WHO 2005 weight-for-age Z-scores.")
    if (length(edema) == 1L) edema <- rep(edema, length_max)
    if (!any(unique(edema) %in% c(edema_code[["yes"]], edema_code[["yes"]], NA))) stop(str_c("Error: all values for edema must be ", edema_code[["yes"]], ", ", edema_code[["no"]], " or NA. Change argument 'edema_code' to set other values."))
    if (!is.null(edema)) edema <- case_when(edema == edema_code[["yes"]] ~ 1L, edema == edema_code[["no"]] ~ 0L)
  }
  if (is.null(edema) || any(is.na(edema)))
    warning("Absence of edema assumed when missing information.")
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_weight_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(z = ((value / m)^l - 1) / (s * l))
  if (!is.null(edema)) z_mat <- z_mat %>% mutate(z = ifelse(edema == 1L, NA, z))
  z_mat %>% pull(z)
}


# Length-for-age Z-scores: measures assumed to be 'length' up to 2 years and 'height' otherwise.
calc_z_length_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  length, length_unit = "cm",
  verbose = T) {
  value <- length
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 length-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 length-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 length-for-age Z-scores.")
  if (is.null(length)) stop("Error: length missing to compute WHO 2005 length-for-age Z-scores.")
  if (!is.numeric(length)) stop("Error: length must be numeric to compute WHO 2005 length-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(length))
  if (!any(length(sex), length(age), length(length)) %in% c(1L, length_max))
    stop("Error: sex, age and length must be same length or length 1 to compute WHO 2005 length-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(weight) == 1L) weight <- rep(weight, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 0 | age >= 1856.5))) {
    age[age < 0 | age >= 1856.5] <- NA
    warning("Age must be < 1857 days (< 61 months) to compute WHO 2005 standards. Values out of range are set to NA.")
  }
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_length_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(z = ((value / m)^l - 1) / (s * l))
  z_mat %>% pull(z)
}


calc_z_ss_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  ss, ss_unit = "mm",
  verbose = T) {
  value <- ss
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  if (is.null(ss)) stop("Error: ss missing to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  if (!is.numeric(ss)) stop("Error: subscapular skinfold must be numeric to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(ss))
  if (!any(length(sex), length(age), length(ss)) %in% c(1L, length_max))
    stop("Error: sex, age and subscapular skinfold must be same length or length 1 to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(ss) == 1L) ss <- rep(ss, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 91 | age >= 1856.5))) {
    warning("Age must be between 91 days (3 months) and 1856 days (61 months) to compute WHO 2005 subscapular skinfold-for-age Z-scores. Values out of range are set to NA.")
    age[age < 91 | age >= 1856.5] <- NA
  }
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_ss_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(z = ((value / m)^l - 1) / (s * l))
  z_mat %>% pull(z)
}


calc_z_hc_age_who2005 <- function(
  sex = NULL, sex_code = c(male = 1L, female = 0L),
  age = NULL, age_unit = "m",
  hc, hc_unit = "cm",
  verbose = T) {
  value <- hc
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 head circumference-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 head circumference-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 head circumference-for-age Z-scores.")
  if (is.null(hc)) stop("Error: hc missing to compute WHO 2005 head circumference-for-age Z-scores.")
  if (!is.numeric(hc)) stop("Error: head circumference must be numeric to compute WHO 2005 subscapular skinfold-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(hc))
  if (!any(length(sex), length(age), length(hc)) %in% c(1L, length_max))
    stop("Error: sex, age and subscapular skinfold must be same length or length 1 to compute WHO 2005 head circumference-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(hc) == 1L) hc <- rep(hc, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 0 | age >= 1856.5))) {
    warning("Age must be < 1857 days (< 61 months) to compute WHO 2005 standards. Values out of range are set to NA.")
    age[age < 0 | age >= 1856.5] <- NA
  }
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_hc_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(z = ((value / m)^l - 1) / (s * l))
  z_mat %>% pull(z)
}


calc_z_ts_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  ts, ts_unit = "mm",
  verbose = T) {
  value <- ts
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  if (is.null(ts)) stop("Error: ss missing to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  if (!is.numeric(ts)) stop("Error: triceps skinfold-for-age must be numeric to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(ts))
  if (!any(length(sex), length(age), length(ts)) %in% c(1L, length_max))
    stop("Error: sex, age and triceps skinfold-for-age must be same length or length 1 to compute WHO 2005 triceps skinfold-for-age-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(ts) == 1L) ts <- rep(ts, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 91 | age >= 1856.5))) {
    warning("Age must be between 91 days (3 months) and 1856 days (61 months) to compute WHO 2005 triceps skinfold-for-age Z-scores. Values out of range are set to NA.")
    age[age < 91 | age >= 1856.5] <- NA
  }
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_ts_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(
      z = ((value / m)^l - 1) / (s * l),
      sd3 = m * ((1 + l * s * (sign(z) * 3))^(1 / l)),
      sd23 = (sd3 - m * ((1 + l * s * (sign(z) * 2))^(1 / l))) * sign(z),
      z = ifelse(abs(z) > 3, (sign(z) * 3) + ((ts - sd3) / sd23), z)
    )
  z_mat %>% pull(z)
}


calc_z_ac_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  ac, ac_unit = "cm",
  verbose = T) {
  value <- ac
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 arm circumference-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 arm circumference-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 arm circumference-for-age Z-scores.")
  if (is.null(ac)) stop("Error: ss missing to compute WHO 2005 arm circumference-for-age Z-scores.")
  if (!is.numeric(ac)) stop("Error: arm circumference-for-age must be numeric to compute WHO 2005 triceps skinfold-for-age Z-scores.")
  length_max <- max(length(sex), length(age), length(ac))
  if (!any(length(sex), length(age), length(ac)) %in% c(1L, length_max))
    stop("Error: sex, age and arm circumference-for-age must be same length or length 1 to compute WHO 2005 arm circumference-for-age-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(ac) == 1L) ac <- rep(ac, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & (any(age < 91 | age >= 1856.5))) {
    warning("Age must be between 91 days (3 months) and 1856 days (61 months) to compute WHO 2005 arm circumference-for-age Z-scores. Values out of range are set to NA.")
    age[age < 91 | age >= 1856.5] <- NA
  }
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_ac_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(
      z = ((value / m)^l - 1) / (s * l),
      sd3 = m * ((1 + l * s * (sign(z) * 3))^(1 / l)),
      sd23 = (sd3 - m * ((1 + l * s * (sign(z) * 2))^(1 / l))) * sign(z),
      z = ifelse(abs(z) > 3, (sign(z) * 3) +((ac - sd3) / sd23), z)
    )
  z_mat %>% pull(z)
}


calc_z_bmi_age_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age, age_unit = "m",
  weight = NULL, weight_unit = "kg",
  length = NULL, length_unit = "cm",
  bmi = NULL,
  edema = NULL, edema_code = c(yes = 1, no = 0),
  verbose = T) {
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 bmi-for-age Z-scores.")
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  if (is.null(age)) stop("Error: age missing to compute WHO 2005 bmi-for-age Z-scores.")
  if (!is.numeric(age)) stop("Error: age must be numeric to compute WHO 2005 bmi-for-age Z-scores.")
  if (!is.null(bmi)) {
    if (!is.numeric(bmi)) stop("Error: bmi must be numeric to compute WHO 2005 bmi-for-age Z-scores.")
    value <- bmi
  } else {
    if (is.null(weight) | is.null(length)) stop("Error: either bmi or weight/length missing to compute WHO 2005 bmi-for-age Z-scores.")
    if (!is.numeric(weight)) stop("Error: weight must be numeric to compute WHO 2005 bmi-for-age Z-scores.")
    if (!is.numeric(length)) stop("Error: length must be numeric to compute WHO 2005 bmi-for-age Z-scores.")
    if (!length(length) %in% c(length(weight), 1L)) stop("Error: weight and length must be the same length or length 1 to compute WHO 2005 bmi-for-age Z-scores.")
    value <- weight / length^2 * 1e4
  }
  length_max <- max(length(sex), length(age), length(bmi))
  if (!any(length(sex), length(age), length(bmi)) %in% c(1L, length_max))
    stop("Error: sex, age and bmi must be same length or length 1 to compute WHO 2005 bmi-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(age) == 1L) age <- rep(age, length_max)
  if (length(bmi) == 1L) bmi <- rep(bmi, length_max)
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (age_unit == "m") age <- age * 30.4375
  age <- round(age)
  if (verbose & any(!is.na(age) & (age < 0 | age >= 1856.5))) {
    warning("Age must be < 1857 days (< 61 months) to compute WHO 2005 standards. Values out of range are set to NA.")
    age[age < 0 | age >= 1856.5] <- NA
  }
  if (!is.null(edema)) {
    if (!length(edema) %in% c(1L, max(length(sex), length(age), length(bmi))))
      stop("Error: edema must be same length as sex, age and bmi or length 1 to compute WHO 2005 bmi-for-age Z-scores.")
    if (!any(unique(edema) %in% c(edema_code[["yes"]], edema_code[["yes"]], NA))) stop(str_c("Error: all values for edema must be ", edema_code[["yes"]], ", ", edema_code[["no"]], " or NA. Change argument 'edema_code' to set other values."))
    if (!is.null(edema)) edema <- case_when(edema == edema_code[["yes"]] ~ 1L, edema == edema_code[["no"]] ~ 0L)
  }
  if (is.null(edema) || any(is.na(edema)))
    warning("Absence of edema assumed when missing information.")
  z_mat <- pmap_df(list(ref_age = age, ref_sex = sex), function(ref_age, ref_sex) {
    if (is.na(ref_age) | is.na(ref_sex)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      ref_data <- who2005_bmi_age %>% filter(age == ref_age, sex_m == ref_sex)
    }
    return(ref_data)
  }) %>%
    mutate(z = ((value / m)^l - 1) / (s * l))
  if (!is.null(edema)) z_mat <- z_mat %>% mutate(z = ifelse(edema == 1L, NA, z))
  z_mat %>% pull(z)
}

calc_z_weight_lenhei_who2005 <- function(
  sex, sex_code = c(male = 1L, female = 0L),
  age = NULL, age_unit = "m",
  weight = NULL, weight_unit = "kg",
  lenhei = NULL, lenhei_unit = "cm",
  measure = NULL, measure_code = c(length = 1L, height = 0L),
  edema = NULL, edema_code = c(yes = 1, no = 0),
  measure_from_age = FALSE, measure_from_lenhei = FALSE,
  switch_lenhei = F, diff_lenhei = .7,
  verbose = TRUE) {
  value <- weight
  if (is.null(sex)) stop("Error: sex missing to compute WHO 2005 weight-for-length/height Z-scores.")
  if (!any(length(sex), length(lenhei), length(weight)) %in% c(1L, length_max))
  if (is.null(lenhei)) stop("Error: lenhei missing to compute WHO 2005 weight-for-length/height Z-scores.")
  if (!is.numeric(lenhei)) stop("Error: lenhei must be numeric to compute WHO 2005 weight-for-length/height Z-scores.")
  if (is.null(weight)) stop("Error: weight missing to compute WHO 2005 weight-for-length/height Z-scores.")
  if (!is.numeric(weight)) stop("Error: weight must be numeric to compute WHO 2005 weight-for-length/height Z-scores.")
  length_max <- max(length(sex), length(lenhei), length(weight))
    stop("Error: sex, lenhei and weight must be same length or length 1 to compute WHO 2005 weight-for-age Z-scores.")
  if (length(sex) == 1L) sex <- rep(sex, length_max)
  if (length(lenhei) == 1L) lenhei <- rep(lenhei, length_max)
  if (verbose & any(!is.na(lenhei) & (lenhei < 45 | lenhei >= 120))) {
    warning("Length/height must be between 45 and 120 cm to compute WHO 2005 weight-for-age Z-scores. Values out of range are set to NA.")
    lenhei[lenhei < 45 | lenhei >= 120] <- NA
  }
  if (length(weight) == 1L) weight <- rep(weight, length_max)
  if (!any(unique(sex) %in% c(sex_code[["male"]], sex_code[["female"]], NA))) stop(str_c("Error: all values for sex must be ", sex_code[["male"]], ", ", sex_code[["female"]], " or NA. Change argument 'sex_code' to set other values."))
  sex <- case_when(sex == sex_code[["male"]] ~ 1L, sex == sex_code[["female"]] ~ 0L)
  if (!is.null(measure)) {
    if (!length(measure) %in% c(1L, length_max)) stop("Error: sex, lenhei, measure and weight must be same length or length 1 to compute WHO 2005 weight-for-age Z-scores.")
    if (!any(unique(measure) %in% c(measure_code[["length"]], measure_code[["height"]], NA))) stop(str_c("Error: all values for measure must be ", measure_code[["length"]], ", ", measure_code[["height"]], " or NA. Change argument 'measure_code' to set other values."))
    measure <- case_when(measure == measure_code[["length"]] ~ 1L, measure == measure_code[["height"]] ~ 0L)
  } else {
    if (!measure_from_age & !measure_from_lenhei) stop("Error: if measure_from_age = FALSE and measure_from_lenhei = FALSE, measure must be provided to compute WHO 2005 weight-for-age Z-scores.")
    measure <- rep(NA, length_max) %>% as.integer
  }
  if ((is.null(measure) || any(is.na(measure))) & measure_from_age) {
    if (is.null(age)) stop("Error: if measure_from_age = TRUE, age needed to compute WHO 2005 weight-for-length/height Z-scores.") else if (!length(age) %in% c(length_max, 1L))
      stop("Error: if measure_from_age = TRUE, age must be same length as lenhei or length 1 to compute WHO 2005 weight-for-length/height Z-scores.")
    if (!is.numeric(age)) stop("Error: if measure_from_age = TRUE, age must be numeric to compute WHO 2005 weight-for-length/height Z-scores.")
    if (age_unit == "m") age <- age * 30.4375
    if (verbose & any(!is.na(age) & (age < 0 | age >= 1856.5))) {
      warning(" If measure_from_age = TRUE, age must be < 1857 days (< 61 months) to compute WHO 2005 standards. Values out of range are set to NA.")
      age[age < 0 | age >= 1856.5] <- NA
    }
    measure <- case_when(
      !is.na(measure) ~ measure,
      age < 731 ~ 1L,
      age >= 731 ~ 0L
    )
  }
  if ((is.null(measure) || any(is.na(measure))) & measure_from_lenhei) {
    measure <- case_when(
      !is.na(measure) ~ measure,
      lenhei < 87 ~ 1L,
      lenhei >= 87 ~ 0L
    )
  }
  if (!is.null(edema)) {
    if (!length(edema) %in% c(1L, length_max))
      stop("Error: edema must be same length as sex, age and weight or length 1 to compute WHO 2005 weight-for-length/height Z-scores.")
    if (length(edema) == 1L) edema <- rep(edema, length_max)
    if (!any(unique(edema) %in% c(edema_code[["yes"]], edema_code[["yes"]], NA))) stop(str_c("Error: all values for edema must be ", edema_code[["yes"]], ", ", edema_code[["no"]], " or NA. Change argument 'edema_code' to set other values."))
    if (!is.null(edema)) edema <- case_when(edema == edema_code[["yes"]] ~ 1L, edema == edema_code[["no"]] ~ 0L)
  }
  if (is.null(edema) || any(is.na(edema)))
    warning("Absence of edema assumed when missing information.")
  lenhei <- round(lenhei * 1e3) / 1e3
  lenhei <- lenhei + case_when(
    measure == 1L & lenhei > 110 & switch_lenhei ~ - diff_lenhei,
    measure == 0L & lenhei < 65 & switch_lenhei ~ diff_lenhei,
    T ~ 0
  )
  measure <- case_when(
    measure == 1L & lenhei > 110 & switch_lenhei ~ 0L,
    measure == 1L & lenhei > 110 & !switch_lenhei ~ NA_integer_,
    measure == 0L & lenhei < 65 & switch_lenhei ~ 1L,
    measure == 0L & lenhei < 65 & !switch_lenhei ~ NA_integer_,
    T ~ measure
  )
  z_mat <- pmap_df(list(ref_lenhei = lenhei, ref_sex = sex, ref_measure = measure), function(ref_lenhei, ref_sex, ref_measure) {
    if (is.na(ref_lenhei) | is.na(ref_sex) | is.na(ref_measure)) {
      ref_data <- data_frame(l = NA, m = NA, s = NA, sex = NA)
    } else {
      low <- floor(ref_lenhei * 10) / 10
      if (abs(ref_lenhei - low) < 1e-3) {
        ref_data <- if (ref_measure == 1L) {
          who2005_weight_length %>% filter(length == low, sex_m == ref_sex)
        } else {
          who2005_weight_height %>% filter(height == low, sex_m == ref_sex)
        }
      } else {
        upp <- low + .1
        ref_data <- if (ref_measure == 1L) {
          who2005_weight_length %>% filter(length %in% c(low, upp), sex_m == ref_sex)
        } else {
          who2005_weight_height %>% filter(height %in% c(low, upp), sex_m == ref_sex)
        } %>%
          select(l, m, s) %>%
          map_df(function(v) (v + (x - low) * 10 * (lead(v) - v))[1]) %>%
          cbind(sex = df_sex)
      }
    }
    return(ref_data)
  }) %>%
    mutate(
      z = ((value / m)^l - 1) / (s * l),
      sd3 = m * ((1 + l * s * (sign(z) * 3))^(1 / l)),
      sd23 = (sd3 - m * ((1 + l * s * (sign(z) * 2))^(1 / l))) * sign(z),
      z = ifelse(abs(z) > 3, (sign(z) * 3) + ((weight - sd3) / sd23), z)
    )
  if (!is.null(edema)) z_mat <- z_mat %>% mutate(z = ifelse(edema == 1L, NA, z))
  z_mat %>% pull(z)
}

flag_z_who2005 <- function(z, standard) {
  if (!standard %in% c("weight_age", "length_age", "bmi-age", "hc-age", "ac-age", "ts-age", "ss-age")) stop(str_c("Error: ", standard,"is not a known WHO 2005 standard."))
  case_when(
    standard == "weight_age" & z < -6 ~ 1L,
    standard %in% c("weight_age", "length_age") & abs(z) > 6 ~ 1L,
    abs(z) > 5 ~ 1L,
    T ~ 0L
  )
}