In dewittpe/pedbp: Pediatric Blood Pressure

################################################################################
#                        !!! DO NOT EDIT .Rmd files !!!                        #
#                                                                              #
# .Rmd files are generated by their corresponding .R files found in the        #
# vignette-spinners/ directory.  Any changes needed to the .Rmd file need to   #
# be made in the .R file                                                       #
################################################################################
knitr::opts_chunk$set(collapse = TRUE, fig.align = "center")
library(pedbp)

Growth Charts

Using the Percentile Data Files with LMS values provided by the CDC, and Child Growth Standards provided by the World Health Organization (WHO), we provide tools for finding quantiles, percentiles, or z-scores, for:

BMI for age,
head circumference for age,
stature for age,
weight for age, and 5, weight for stature.

All lengths/heights are in centimeters, ages in months, and weights in kilograms. Stature is used to refer both height and length; Specific methods are provided for each.

Method - LMS

All methods use the published LMS parameters to define z-scores, percentiles, and quantiles for skewed distributions. L is a $\lambda$ parameter, the Box-Cox transformation power; $M$ the median value, and $S$ a generalized coefficient of variation. For a given percentile or z-score, the corresponding physical measurement, $X,$ is defined as

$$X = \begin{cases} M \left(1 + \lambda S Z \right)^{\frac{1}{\lambda}} & \lambda \neq 0 \ M \exp\left( S Z \right) & \lambda = 0. \end{cases}$$

From this we can get the z-score for a given measurement $X:$

$$ Z = \begin{cases} \frac{\left(\frac{X}{M}\right)^{\lambda} - 1}{\lambda S} & \lambda \neq 0 \ \frac{\log\left(\frac{X}{M}\right) }{ S } & \lambda = 0. \end{cases}$$

Percentiles are determined using the standard normal distribution of z-scores.

For all eight of the noted methods we provide a distribution function, quantile function, and function that returns z-scores.

Growth Standards

All the growth standard functions have a quantile, percentile, and z-scores version.

GS_DATA <-
  pedbp:::lms_data |>
  lapply(lapply, data.table::rbindlist) |>
  lapply(data.table::rbindlist, use.names = TRUE, fill = TRUE) |>
  data.table::rbindlist(use.names = TRUE, fill = TRUE)

GS_DATA <- GS_DATA[, .(source, metric, male, age, height, length)]
GS_DATA <- unique(GS_DATA)

build_metric_plotting_data <- function(metric) {
  idx <- GS_DATA$metric == metric
  rtn <-
    merge(x = GS_DATA[idx, ],
          y = data.table::CJ(metric = metric, p = c(0.01, 0.05, 0.10, 0.25, 0.50, 0.75, 0.90, 0.95, 0.99)),
          by = "metric",
          all = TRUE,
          allow.cartesian = TRUE
    )
  rtn[, plab := factor(p,
         levels = c(0.01, 0.05, 0.10, 0.25, 0.50, 0.75, 0.90, 0.95, 0.99),
         labels = c("1st", "5th", "10th", "25th", "50th", "75th", "90th", "95th", "99th")
         )]
  rtn[, malelab := factor(male, 0:1, c("Female", "Male"))]
  rtn[]
  rtn
}

BMI for Age

bmi_for_age_data <- build_metric_plotting_data("bmi_for_age")
bmi_for_age_data[, q := q_bmi_for_age(p = p, male = male, age = age, source = source)]
ggplot2::ggplot(data = bmi_for_age_data) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = age, y = q, linetype = source, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_wrap( ~ malelab) +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Age"
                              , breaks = seq(0, max(bmi_for_age_data$age), by = 36)
                              , minor_breaks = seq(0, max(bmi_for_age_data$age), by = 12)
                              , labels = paste(
                                                 paste0(seq(0, max(bmi_for_age_data$age), by = 36), "m")
                                               , paste0(seq(0, max(bmi_for_age_data$age), by = 36) / 12, "yr")
                                               , sep = "\n")
                              ) +
  ggplot2::scale_y_continuous(name = "BMI") +
  ggplot2::scale_linetype(name = "Source") +
  ggplot2::theme(legend.position = "bottom")

The median BMI quantile for a 48 month old female is:

q_bmi_for_age(p = 0.5, male = 0, age = 48) # default is CDC
q_bmi_for_age(p = 0.5, male = 0, age = 48, source = c("CDC", "WHO"))

A BMI of 17.2 for a 149 month old male is in the following percentiles by source:

p_bmi_for_age(q = 17.2, male = 1, age = 149, source = c("CDC", "WHO"))

If you would prefer to have the z-score for a BMI of 17.2 for a 149 month old male is in the following percentiles by source:

z_bmi_for_age(q = 17.2, male = 1, age = 149, source = c("CDC", "WHO"))

Head Circumference for Age

head_circumference_for_age_data <- build_metric_plotting_data("head_circumference_for_age")
head_circumference_for_age_data[, q := q_head_circumference_for_age(p = p, male = male, age = age, source = source)]
ggplot2::ggplot(data = head_circumference_for_age_data) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = age, y = q, linetype = source, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_wrap( ~ malelab) +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Age"
                              , breaks = seq(0, max(head_circumference_for_age_data$age), by = 24)
                              , minor_breaks = seq(0, max(head_circumference_for_age_data$age), by = 12)
                              , labels = paste(
                                                 paste0(seq(0, max(head_circumference_for_age_data$age), by = 24), "m")
                                               , paste0(seq(0, max(head_circumference_for_age_data$age), by = 24) / 12, "yr")
                                               , sep = "\n")
                              ) +
  ggplot2::scale_y_continuous(name = "Head Circumference (cm)") +
  ggplot2::scale_linetype(name = "Source") +
  ggplot2::theme(legend.position = "bottom")

Stature for Age

Stature is either height or length. Functions for both are provided.

The image below is the growth chart by data source and by height or length.

lfa <- build_metric_plotting_data("length_for_age")
lfa[, q := q_length_for_age(p = p, male = male, age = age, source = source)]
hfa <- build_metric_plotting_data("height_for_age")
hfa[, q := q_height_for_age(p = p, male = male, age = age, source = source)]
sfa <- rbind(lfa, hfa)
sfa[, metriclab := factor(metric, c("height_for_age", "length_for_age"), c("Height for Age", "Length for Age"))]

ggplot2::ggplot(data = sfa) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = age, y = q, linetype = source, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_grid(metriclab ~ malelab, scales = "free_y") +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Age"
                              , breaks = seq(0, max(sfa$age), by = 36)
                              , minor_breaks = seq(0, max(sfa$age), by = 12)
                              , labels = paste(
                                                 paste0(seq(0, max(sfa$age), by = 36), "m")
                                               , paste0(seq(0, max(sfa$age), by = 36) / 12, "yr")
                                               , sep = "\n")
                              ) +
  ggplot2::scale_y_continuous(name = "Stature (cm)") +
  ggplot2::scale_linetype(name = "Source") +
  ggplot2::theme(legend.position = "bottom")

The following image shows the difference in the quantile values between height and length for the same age.

ggplot2::ggplot(data = sfa[age <= 72]) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = age, y = q, linetype = metriclab, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_grid(source ~ malelab, scales = "free_y") +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Age"
                              , breaks = seq(0, max(sfa$age), by = 36)
                              , minor_breaks = seq(0, max(sfa$age), by = 12)
                              , labels = paste(
                                                 paste0(seq(0, max(sfa$age), by = 36), "m")
                                               , paste0(seq(0, max(sfa$age), by = 36) / 12, "yr")
                                               , sep = "\n")
                              ) +
  ggplot2::scale_y_continuous(name = "Stature (cm)") +
  ggplot2::scale_linetype(name = "Metric") +
  ggplot2::theme(legend.position = "bottom")

Length for Age

Length for age quantiles are found via r paste0(qwraps2::backtick(q_length_for_age), ".") For example, the median length for a 1.5 year old male, based on CDC data is:

q_length_for_age(p = 0.5, age = 1.5 * 12, male = 1, source = "CDC")

A 90 cm long 28 month old female is in the r paste0(qwraps2::frmt(p_length_for_age(q = 90, age = 28, male = 0, source = "CDC") * 100, 0), "th") percentile:

p_length_for_age(q = 90, age = 28, male = 0, source = "CDC")

or the equivalent z-score:

z_length_for_age(q = 90, age = 28, male = 0, source = "CDC")

Height for Age

Height for age quantiles are found via r paste0(qwraps2::backtick(q_height_for_age), ".") For example, the median height for a 11 year old male, based on CDC data is:

q_height_for_age(p = 0.5, age = 11 * 12, male = 1, source = "CDC")

A 125 cm tall 108 month old female is in the r paste0(qwraps2::frmt(p_height_for_age(q = 125, age = 108, male = 0, source = "CDC") * 100, 0), "th") percentile:

p_height_for_age(q = 125, age = 108, male = 0, source = "CDC")

or the equivalent z-score:

z_height_for_age(q = 125, age = 108, male = 0, source = "CDC")

Weight for Age

wfa <- build_metric_plotting_data("weight_for_age")
wfa[, q := q_weight_for_age(p = p, male = male, age = age, source = source)]

ggplot2::ggplot(data = wfa) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = age, y = q, linetype = source, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_wrap( ~ malelab, scales = "free_y") +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Age"
                              , breaks = seq(0, max(sfa$age), by = 36)
                              , minor_breaks = seq(0, max(sfa$age), by = 12)
                              , labels = paste(
                                                 paste0(seq(0, max(sfa$age), by = 36), "m")
                                               , paste0(seq(0, max(sfa$age), by = 36) / 12, "yr")
                                               , sep = "\n")
                              ) +
  ggplot2::scale_y_continuous(name = "Weight (kg)") +
  ggplot2::scale_linetype(name = "Source") +
  ggplot2::theme(legend.position = "bottom")

Find the 80th quantile for 56 month old females

q_weight_for_age(p = 0.80, age = 56, male = 0, source = c("CDC", "WHO"))

The percentiles for 42 kg 9 year old males:

p_weight_for_age(q = 42, age = 9 * 12, male = 0, source = c("CDC", "WHO"))
z_weight_for_age(q = 42, age = 9 * 12, male = 0, source = c("CDC", "WHO"))

Weight for Stature

wfl <- build_metric_plotting_data("weight_for_length")
wfl[, q := q_weight_for_length(p = p, male = male, length = length, source = source)]
wfh <- build_metric_plotting_data("weight_for_height")
wfh[, q := q_weight_for_height(p = p, male = male, height = height, source = source)]
wfs <- rbind(wfl, wfh)
wfs[, metriclab := factor(metric, c("weight_for_height", "weight_for_length"), c("Weight for Height", "Weight for Length"))]
wfs[is.na(height), stature := length]
wfs[is.na(length), stature := height]

ggplot2::ggplot(data = wfs) +
  ggplot2::theme_bw() +
  ggplot2::aes(x = stature, y = q, linetype = source, color = plab) +
  ggplot2::geom_line() +
  ggplot2::facet_grid(metriclab ~ malelab, scales = "free_y") +
  ggplot2::scale_color_brewer(name = "Percentile", type = "qual", palette = "Paired") +
  ggplot2::scale_x_continuous(name = "Stature (cm)") +
  ggplot2::scale_y_continuous(name = "Weight (kg)") +
  ggplot2::scale_linetype(name = "Source") +
  ggplot2::theme(legend.position = "bottom")

The 60th weight quantile for a 1.2 meter tall male is

q_weight_for_height(p = 0.60, male = 1, height = 120, source = "CDC")
q_weight_for_height(p = 0.60, male = 1, height = 120, source = "WHO")

There are slight differences in the quantiles for length and height

q_weight_for_length(p = 0.60, male = 1, length = 97, source = "CDC")
q_weight_for_height(p = 0.60, male = 1, height = 97, source = "WHO")

q_weight_for_length(p = 0.60, male = 1, length = 97, source = "CDC")
q_weight_for_length(p = 0.60, male = 1, length = 97, source = "WHO")

Percentiles and standard scores for a 14 kg, 88 cm tall/long male

p_weight_for_height(q = 14, male = 1, height = 88, source = "CDC")
p_weight_for_height(q = 14, male = 1, height = 88, source = "WHO")
p_weight_for_length(q = 14, male = 1, length = 88, source = "CDC")
p_weight_for_length(q = 14, male = 1, length = 88, source = "WHO")

Corresponding standard scores

z_weight_for_height(q = 14, male = 1, height = 88, source = "CDC")
z_weight_for_height(q = 14, male = 1, height = 88, source = "WHO")
z_weight_for_length(q = 14, male = 1, length = 88, source = "CDC")
z_weight_for_length(q = 14, male = 1, length = 88, source = "WHO")