diff --git a/R/calc_ibw.R b/R/calc_ibw.R index e90e324..ea4bfa8 100755 --- a/R/calc_ibw.R +++ b/R/calc_ibw.R @@ -25,12 +25,15 @@ #' IBW (male) = 50 + (2.3 x height in inches over 5 feet) #' IBW (female) = 45.5 + (2.3 x height in inches over 5 feet) #' -#' @param age age in years, can be vector -#' @param weight weight in kg, can be vector -#' @param height height in cm, can be vector -#' @param sex either `male` or `female`, can be vector -#' @param method_children method to use for children >1 and <18 years. Choose from `standard`, `mclaren` (McLaren DS, Read WWC. Lancet. 1972;2:146-148.), `moore` (Moore DJ et al. Nutr Res. 1985;5:797-799), `bmi` (), `ada` (American Dietary Association) -#' @param method_adults method to use for >=18 years. Choose from `devine` (default, Devine BJ. Drug Intell Clin Pharm. 1974;8:650-655). +#' @param age age in years +#' @param weight weight in kg +#' @param height height in cm +#' @param sex sex +#' @param method_children method to use for children >1 and <18 years. Currently +#' `"standard"` is the only method that is supported. +#' @param method_adults method to use for >=18 years. Currently `"devine"` is +#' the only method that is supported (Devine BJ. Drug Intell Clin Pharm. +#' 1974;8:650-655). #' @param digits number of decimals (can be NULL to for no rounding) #' @examples #' calc_ibw(weight = 70, height = 170, age = 40, sex = "female") @@ -45,75 +48,95 @@ calc_ibw <- function ( method_adults = "devine", digits = NULL ) { - available_methods_children <- c("standard") # c("moore", "mclaren", "bmi", "ada") - method_children <- tolower(method_children) - if(!(method_children %in% available_methods_children)) { - stop("Specified method for children not available.") - } - available_methods_adults <- c("devine") - method_adults <- tolower(method_adults) - if(!(method_adults %in% available_methods_adults)) { - stop("Specified method for adults not available.") - } + method_children <- match.arg(method_children) + method_adults <- match.arg(method_adults) if(is.null(age)) { stop("Age not specified!") } - if(length(weight > 1)) { - if(length(height) != length(weight)) { - message("Height and weight do not have same vector lenght, using only first height.") - height <- rep(height[1], length(weight)) - } - if(length(age) != length(weight)) { - message("Age and weight do not have same vector lenght, using only first age.") - age <- rep(age[1], length(weight)) - } - if(length(sex) != length(weight)) { - message("Sex and weight do not have same vector lenght, using only first sex.") - sex <- rep(sex[1], length(weight)) - } - } + stopifnot( + length(age) == 1, + length(height) <= 1, # these are not always + length(weight) <= 1, # required, so may be + length(sex) <= 1 # NULL or length 1 + ) ## babies - ibw <- rep(0, length(weight)) - if(any(age < 1)) { + if (age < 1) { if (is.null(weight)) { stop("Actual body weight is used as IBW for children < 1yr. Please supply a weight value.") } message("Note: using actual body weight as IBW for children < 1yr.") - ibw[age < 1] <- weight[age < 1] + return(weight) } - ## children - ht <- cm2inch(height) - if(any(age >= 1 & age < 18)) { - if(method_children == "standard") { - if(any(is.null(height) || is.null(age) || is.null(sex))) { - ibw[age >= 1 & age < 18 & (is.null(height) || is.null(age) || is.null(sex))] <- NA - message("Height, age and sex are required!") - } - ibw[age >= 1 & age < 18 & ht < 5*12] <- (height[age >= 1 & age < 18 & ht < 5*12]^2 * 1.65)/1000 - ibw[age >= 1 & age < 18 & ht >= 5*12] <- - (39 + 2.27 * (ht[age >= 1 & age < 18 & ht >= 5*12]-(5*12))) * (sex[age >= 1 & age < 18 & ht >= 5*12]=="male") + - (42.2 + 2.27 * (ht[age >= 1 & age < 18 & ht >= 5*12]-(5*12))) * (sex[age >= 1 & age < 18 & ht >= 5*12]=="female") - } + if (age >= 1 & age < 18) { + ibw <- switch( + method_children, + "standard" = ibw_standard(age = age, height = height, sex = sex) + ) + } else { + ibw <- switch( + method_adults, + "devine" = ibw_devine(age = age, height = height, sex = sex) + ) } - ## adults - if(any(age >= 18)) { - if(method_adults == "devine") { - if(any(is.null(height) || is.null(sex))) { - ibw[age >= 18 & (is.null(height) || is.null(sex))] <- NA - message("Height and sex are required to calculate!") - } - ibw[age >= 18] <- - (50 + (2.3 * (ht[age >= 18]-(5*12)))) * (sex[age >= 18] == "male") + - (45.5 + (2.3 * (ht[age >= 18]-(5*12)))) * (sex[age >= 18] == "female") - } + if (!is.null(digits)) { + ibw <- round(ibw, digits = digits) } - if(!is.null(digits)) { - ibw <- round(ibw, digits=digits) + return(ibw) +} + +#' Calculate IBW using "standard" equation +#' +#' @inheritParams calc_ibw +ibw_standard <- function(age, height = NULL, sex = NULL) { + if (is.null(age) || age >= 18 || age < 1) { + stop("Age must be >=1 and <18") + } + if (is.null(height) || is.na(height)) { + message("Height is required to calculate IBW") + return(NA) + } + height_in <- cm2inch(height) + if (height_in < 5 * 12) { + return((height^2 * 1.65) / 1000) } + if (is.null(sex) || is.na(sex) || !sex %in% c("male", "female")) { + message("The `standard` method for calculating IBW requires sex to be 'male' or 'female' for children 5 feet tall or taller.") + return(NA) + } + base_value <- switch( + sex, + "male" = 39, + "female" = 42.2 + ) + height_inches_over_5_feet <- height_in - (5 * 12) + base_value + (2.27 * height_inches_over_5_feet) +} - return(ibw) +#' Calculate IBW using "devine" equation +#' +#' @inheritParams calc_ibw +ibw_devine <- function(age, height = NULL, sex = NULL) { + if (age < 18) { + stop("Age must be >= 18 for the Devine equation") + } + if (is.null(height) || is.na(height)) { + message("Height is required to calculate IBW") + return(NA) + } + if (is.null(sex) || is.na(sex) || !sex %in% c("male", "female")) { + message("The `devine` method for calculating IBW requires sex to be 'male' or 'female'.") + return(NA) + } + base_value <- switch( + sex, + "male" = 50, + "female" = 45.5 + ) + height_in <- cm2inch(height) + height_inches_over_5_feet <- height_in - (5 * 12) + base_value + (2.3 * height_inches_over_5_feet) } diff --git a/man/calc_ibw.Rd b/man/calc_ibw.Rd index 7b62a10..b219ffc 100755 --- a/man/calc_ibw.Rd +++ b/man/calc_ibw.Rd @@ -15,17 +15,20 @@ calc_ibw( ) } \arguments{ -\item{weight}{weight in kg, can be vector} +\item{weight}{weight in kg} -\item{height}{height in cm, can be vector} +\item{height}{height in cm} -\item{age}{age in years, can be vector} +\item{age}{age in years} -\item{sex}{either `male` or `female`, can be vector} +\item{sex}{sex} -\item{method_children}{method to use for children >1 and <18 years. Choose from `standard`, `mclaren` (McLaren DS, Read WWC. Lancet. 1972;2:146-148.), `moore` (Moore DJ et al. Nutr Res. 1985;5:797-799), `bmi` (), `ada` (American Dietary Association)} +\item{method_children}{method to use for children >1 and <18 years. Currently +`"standard"` is the only method that is supported.} -\item{method_adults}{method to use for >=18 years. Choose from `devine` (default, Devine BJ. Drug Intell Clin Pharm. 1974;8:650-655).} +\item{method_adults}{method to use for >=18 years. Currently `"devine"` is +the only method that is supported (Devine BJ. Drug Intell Clin Pharm. +1974;8:650-655).} \item{digits}{number of decimals (can be NULL to for no rounding)} } diff --git a/man/ibw_devine.Rd b/man/ibw_devine.Rd new file mode 100644 index 0000000..a4009fc --- /dev/null +++ b/man/ibw_devine.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calc_ibw.R +\name{ibw_devine} +\alias{ibw_devine} +\title{Calculate IBW using "devine" equation} +\usage{ +ibw_devine(age, height = NULL, sex = NULL) +} +\arguments{ +\item{age}{age in years} + +\item{height}{height in cm} + +\item{sex}{sex} +} +\description{ +Calculate IBW using "devine" equation +} diff --git a/man/ibw_standard.Rd b/man/ibw_standard.Rd new file mode 100644 index 0000000..5d0d8cd --- /dev/null +++ b/man/ibw_standard.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calc_ibw.R +\name{ibw_standard} +\alias{ibw_standard} +\title{Calculate IBW using "standard" equation} +\usage{ +ibw_standard(age, height = NULL, sex = NULL) +} +\arguments{ +\item{age}{age in years} + +\item{height}{height in cm} + +\item{sex}{sex} +} +\description{ +Calculate IBW using "standard" equation +} diff --git a/tests/testthat/test_calc_ibw.R b/tests/testthat/test_calc_ibw.R index cf7095c..ea0b290 100644 --- a/tests/testthat/test_calc_ibw.R +++ b/tests/testthat/test_calc_ibw.R @@ -1,4 +1,4 @@ -test_that("IBW errors when no height specified", { +test_that("IBW errors when no age specified", { expect_error(calc_ibw(weight = 80)) expect_error(calc_ibw(weight = NULL)) }) @@ -11,3 +11,92 @@ test_that("IBW calculation works", { test_that("calc_ibw() throws error if weight is missing but needed", { expect_error(calc_ibw(age = 0.03, height = 40)) }) + +test_that("calc_ibw() errors if method doesn't match allowed", { + expect_error(calc_ibw(method_children = "foo")) + expect_error(calc_ibw(method_adults = "foo")) +}) + +test_that("calc_ibw errors if passed a vector", { + expect_error( + calc_ibw(age = c(10, 20), sex = c("male", "female"), height = 100, 130) + ) +}) + +test_that("calc_ibw() uses weight when age < 1", { + expect_equal( + expect_message(calc_ibw(age = 0.5, weight = 7)), + 7 + ) +}) + +test_that("calc_ibw() can round output", { + expect_equal( + calc_ibw(age = 40, height = 180, sex = "female", digits = 1), + 70.5 + ) +}) + +test_that("ibw_standard only supports children and requires age", { + expect_error(ibw_standard(age = 25)) + expect_error(ibw_standard(age = NULL)) +}) + +test_that("ibw_standard returns NA and message if missing data", { + res1 <- expect_message(ibw_standard(age = 10, height = NA)) + res2 <- expect_message(ibw_standard(age = 10, height = NULL)) + expect_true(is.na(res1)) + expect_true(is.na(res2)) + + res3 <- expect_message(ibw_standard(age = 17, height = 165)) + res4 <- expect_message( + ibw_standard(age = 17, height = 165, sex = "unknown") + ) + expect_true(is.na(res3)) + expect_true(is.na(res4)) +}) + +test_that("ibw_standard doesn't require sex if height < 5ft", { + expect_equal(ibw_standard(age = 14, height = 150), 37.125) +}) + +test_that("ibw_standard calculates correct IBW", { + expect_equal( + ibw_standard(age = 15, height = 160, sex = "female"), + 48.992126 + ) + expect_equal( + ibw_standard(age = 15, height = 160, sex = "male"), + 45.792126 + ) +}) + +test_that("ibw_devine only supports adults and requires age", { + expect_error(ibw_devine(age = 15)) + expect_error(ibw_devine(age = NULL)) +}) + +test_that("ibw_devine returns NA and message if missing data", { + res1 <- expect_message(ibw_devine(age = 20, height = NA)) + res2 <- expect_message(ibw_devine(age = 20, height = NULL)) + expect_true(is.na(res1)) + expect_true(is.na(res2)) + + res3 <- expect_message(ibw_devine(age = 30, height = 165)) + res4 <- expect_message( + ibw_devine(age = 30, height = 165, sex = "unknown") + ) + expect_true(is.na(res3)) + expect_true(is.na(res4)) +}) + +test_that("ibw_devine calculates correct IBW", { + expect_equal( + ibw_devine(age = 20, height = 160, sex = "female"), + 52.381890 + ) + expect_equal( + ibw_devine(age = 20, height = 160, sex = "male"), + 56.881890 + ) +})