R/goalweight.R

In MarijnJABoer/befitteR: A bundle of health, fitness, food and body related equations, formula's and more, so you can become fit

#' @title Calculate if your goal is realistic
#'
#' @description
#' \lifecycle{stable}
#'
#' FUNCTION_DESCRIPTION
#'
#' @param weight weight in kg
#' @param bfp body weight percentage (1-100)
#' @param goal your weight goal in kg, as positive (gain weight) or negative (lose weight) integer
#' @param sex one of `male` or `female`.
#'
#' @return Text output by `message()`
#'
#' @details www.bmi-calculator.net/body-fat-calculator/body-fat-chart.php
#'
#' @examples
#' check_weight_goal(
#'   weight = 60,
#'   sex = "male",
#'   bfp = 12.5,
#'   goal = -1
#' )
#' @rdname check_weight_goal
#' @export
check_weight_goal <-
  function(weight, sex, bfp, goal) {
    new_weight <- weight + goal
    fm <- calculate_fat_mass(weight, bfp)
    lm <- calculate_lean_mass(weight, fm)
    new_fm <- new_weight - lm
    new_bfp <- (new_fm / new_weight) * 100
    sent1 <- paste0(
      "Your goal is to change your weight with ",
      round(goal, 2),
      " kg, from ",
      round(weight, 2),
      " kg to ",
      round(new_weight, 2),
      " kg."
    )
    sent2 <- paste0(
      "\nYour current body fat percentage is ",
      round(bfp, 2),
      "% which results in ",
      round(lm, 2),
      " kg of lean mass."
    )
    sent3 <- paste0(
      "\nWith the new weight of ",
      round(new_weight, 2),
      " kg you will have ",
      round(new_fm, 2),
      " kg of body fat, which is ",
      round(new_bfp, 2),
      "% body fat percentage."
    )
    if (sex == "male") {
      if (new_bfp >= 25) {
        sent4 <- paste0(
          "\nAttention: as a male, this percentage of body fat is dangerously ",
          "high and categorized as obese!"
        )
      } else if (new_bfp < 25 && new_bfp >= 18) {
        sent4 <- paste0(
          "\nAs a male, this percentage of body fat is categorized as ",
          "normal and acceptable."
        )
      } else if (new_bfp < 18 && new_bfp >= 14) {
        sent4 <-
          paste0("\nAs a male, this percentage of body fat is categorized as ",
                 "being fit.")
      } else if (new_bfp < 14 && new_bfp >= 6) {
        sent4 <-
          paste0("\nAs a male, this percentage of body fat is categorized as ",
                 "being athletic!")
      } else if (new_bfp < 6) {
        sent4 <- paste0(
          "\nAttention: as a male, this percentage of body fat is dangerously ",
          "low as it is your essential fat!"
        )
      }
    } else if (sex == "female") {
      if (new_bfp >= 32) {
        sent4 <- paste0(
          "\nAttention: as a female, this percentage of body fat is ",
          "dangerously high and categorized as obese!"
        )
      } else if (new_bfp < 32 && new_bfp >= 25) {
        sent4 <- paste0(
          "\nAs a female, this percentage of body fat is categorized as ",
          "normal and acceptable."
        )
      } else if (new_bfp < 25 && new_bfp >= 21) {
        sent4 <-
          paste0("\nAs a female, this percentage of body fat is categorized as ",
                 "being fit.")
      } else if (new_bfp < 21 && new_bfp >= 14) {
        sent4 <-
          paste0("\nAs a female, this percentage of body fat is categorized as ",
                 "being athletic!")
      } else if (new_bfp < 14) {
        sent4 <- paste0(
          "\nAttention: as a female, this percentage of body fat is ",
          "dangerously low as it is your essential fat!"
        )
      }
    }
    message(paste0(sent1, sent2, sent3, sent4))
  }

# TODO(MJABOER): Add calculate_goalweight (with IF option and lose / gain options (see tdeeCalc))
#' @title Calculate healthy weight
#'
#' @description
#' \lifecycle{stable}
#'
#' Calculate a healthy weight interval ranging from the lowest
#' healthiest weight to the highest healthiest weight. This is based on the body
#' mass index. A healthy weight should range within a BMI of 18.5 and 24.9.
#'
#' @param height height in cm.
#'
#' @return A healthy weight range; lower bound and upper bound
#'
#' @details For more information go to https://www.gigacalculator.com/calculators/healthy-weight-calculator.php
#'
#' @examples
#' calculate_healthy_weight(180)
#' @rdname calculate_healthy_weight
#'
#' @export
#'
#' @importFrom checkmate assert_number
calculate_healthy_weight <- function(height) {
  checkmate::assert_number(height, lower = 0)
  # convert from cm to m
  height <- height / 100
  lowerbound <- 18.5 * (height ** 2)
  upperbound <- 24.9 * (height ** 2)
  range <- round(c(lowerbound, upperbound), 2)
  return(range)
}

calculate_ideal_weight_RB <- function(height, sex) {
  check_sex(sex)
  # convert from cm to inch
  height <- height / 2.54

  # Robinson et al., 1983 (5)
  if (sex == "male") {
    weight <- 52 + 1.9 * (height - 60)
  }
  if (sex == "female") {
    weight <- 49 + 1.7 * (height - 60)
  }
  return(weight)
}

calculate_ideal_weight_DV <- function(height, sex) {
  check_sex(sex)
  # convert from cm to inch
  height <- height / 2.54
  # Devine, 1974 (4)
  if (sex == "male") {
    weight <- 50.0 + 2.3 * (height - 60)
  }
  if (sex == "female") {
    weight <- 45.5 + 2.3 * (height - 60)
  }
  return(weight)
}

calculate_ideal_weight_HW <- function(height, sex) {
  check_sex(sex)
  # convert from cm to inch
  height <- height / 2.54
  # Hamwi, 1964 (3)
  # returns lbs
  if (sex == "male") {
    weight <- lbs_to_kg(106 + 6 * (height - 60))
  }
  if (sex == "female") {
    weight <- lbs_to_kg(100 + 5 * (height - 60))
  }
  return(weight)
}

calculate_ideal_weight_ML <- function(height, sex) {
  check_sex(sex)
  # convert from cm to inch
  height <- height / 2.54
  # Miller et al., 1983
  if (sex == "male") {
    weight <- 56.2 + 1.41 * (height - 60)
  }
  if (sex == "female") {
    weight <- 53.1 + 1.36 * (height - 60)
  }
  return(weight)
}

calculate_ideal_weight_HM <- function(height, sex) {
  check_sex(sex)
  # Hammond, 2000 (7)
  if (sex == "male") {
    weight <- 48 + 1.1 * (height - 150)
  }
  if (sex == "female") {
    weight <- 45 + 0.9 * (height - 150)
  }
  return(weight)
}

calculate_ideal_weight_BR <- function(height) {
  # Broca, 1871/H-index (1)
  checkmate::assert_number(height, lower = 0)
  weight <- height - 100
  return(weight)
}

calculate_ideal_weight_PT <- function(height, desired_bmi = 22) {
  # Peterson C.M., Thomas D.M., Blackburn G.L., Heymsfield S.B. (2016)
  # "Universal equation for estimating ideal body weight and body weight at any
  # BMI" The American Journal of Clinical Nutrition 103(5):1197-1203
  checkmate::assert_number(desired_bmi, lower = 0)
  checkmate::assert_number(height, lower = 0)
  # convert from cm to m
  height <- height / 100
  weight <- 2.2 * desired_bmi + 3.5 * desired_bmi * (height - 1.5)
  return(weight)
}

#' @title Calculate ideal weight
#'
#' @description
#' \lifecycle{stable}
#'
#' Calculate your ideal weight, based on your height or a desired
#' bmi.
#'
#' @param height height in cm.
#' @param sex one of `male` or `female`, Default: NULL
#' @param desired_bmi a desired bmi. Needed for the `peterson` equation,
#'   Default: NULL
#' @param equation character string setting the equation, Default: 'peterson'.
#'
#' @return Weight in kg.
#'
#' @details https://www.gigacalculator.com/calculators/ideal-weight-calculator.php
#'
#' @examples
#' calculate_ideal_weight(height = 180, sex = "male", equation = "robinson")
#' calculate_ideal_weight(height = 180, sex = "male", equation = "devine")
#' calculate_ideal_weight(height = 180, sex = "male", equation = "hamwi")
#' calculate_ideal_weight(height = 180, sex = "male", equation = "miller")
#' calculate_ideal_weight(height = 180, sex = "male", equation = "hammond")
#' calculate_ideal_weight(height = 180, equation = "broca")
#' calculate_ideal_weight(height = 180, desired_bmi = 22, equation = "peterson")
#' calculate_ideal_weight(height = 170, sex = "female", equation = "robinson")
#' calculate_ideal_weight(height = 170, sex = "female", equation = "devine")
#' calculate_ideal_weight(height = 170, sex = "female", equation = "hamwi")
#' calculate_ideal_weight(height = 170, sex = "female", equation = "miller")
#' calculate_ideal_weight(height = 170, sex = "female", equation = "hammond")
#' @rdname calculate_ideal_weight
#'
#' @export
#'
#' @importFrom checkmate assert_number assert_choice
calculate_ideal_weight <-
  function(height,
           sex = NULL,
           desired_bmi = NULL,
           equation = "peterson") {
    checkmate::assert_number(height, lower = 0)
    choices <-
      c("robinson",
        "devine",
        "hamwi",
        "miller",
        "hammond",
        "broca",
        "peterson")
    checkmate::assert_choice(equation, choices)
    weight <- switch(
      equation,
      "robinson" = calculate_ideal_weight_RB(height, sex),
      "devine" = calculate_ideal_weight_DV(height, sex),
      "hamwi" = calculate_ideal_weight_HW(height, sex),
      "miller" = calculate_ideal_weight_ML(height, sex),
      "hammond" = calculate_ideal_weight_HM(height, sex),
      "broca" = calculate_ideal_weight_BR(height),
      "peterson" = calculate_ideal_weight_PT(height, desired_bmi)
    )
    return(weight)
  }

calculate_ideal_perc_weight <- function(weight, ideal_weight) {
  perc <- weight / ideal_weight
  return(perc)
}


#' @title TDEE for weight change
#'
#' @description
#' \lifecycle{stable}
#'
#' Check how you should adjust your tdee when changing weight.
#'
#' @param weight weight in kg
#' @param goal your weight goal in kg, as positive (gain weight) or negative
#'   (lose weight) integer
#' @param weekly_target your weekly target in kg, as positive (gain weight) or
#'   negative (lose weight) integer
#' @param tdee Total daily energy expenditure, Default: NULL
#'
#' @details DETAILS
#' @examples
#' weight_goal(
#'   weight = 94,
#'   goal = 5,
#'   weekly_target = 0.5,
#'   tdee = 2700
#' )
#' @rdname weight_goal
#' @export
#' @importFrom checkmate assert_number
weight_goal <- function(weight, goal, weekly_target, tdee = NULL) {
  checkmate::assert_number(weight, lower = 0)
  checkmate::assert_number(goal)
  checkmate::assert_number(tdee, lower = 0)
  checkmate::assert_number(weekly_target)
  new_weight <- goal + weight
  if (sign(goal) != sign(weekly_target)) {
    stop(
      "A negative goal needs a negative weekly target, and vise versa for a ",
      "positive target."
    )
  }
  if (goal < 0) {
    change <- " loose "
  } else {
    change <- " gain "
  }
  n_weeks <- abs(goal / weekly_target)
  goal_kcal <- fat_to_kcal(abs(goal * 1000))
  n_days <- n_weeks * 7
  kcal_balance <-
    if (goal > 0) {
      goal_kcal / n_days
    } else {
      (goal_kcal / n_days) * -1
    }
  sent1 <-
    paste0(
      "Current weight: ",
      weight,
      " kg. \nGoal weight: ",
      new_weight,
      " kg.\nGoal: to",
      change,
      goal,
      " kg in total and ",
      weekly_target,
      " kg per week."
    )
  sent2 <-
    paste0("\n\nWeeks untill new weight of ",
           new_weight,
           " kg: ",
           n_weeks,
           " weeks.")
  sent3 <-
    paste0("\nTotal number of days: ", round(n_days, 2), " days.")
  sent4 <-
    paste0("\n\nTotal kcal to",
           change,
           goal,
           " kg of fat: ",
           goal_kcal,
           " kcal.")
  sent5 <-
    paste0("\nKcal adjustment per day: ", kcal_balance, " kcal.")
  if (!missing(tdee)) {
    tdee_new <- tdee - kcal_balance
    sent6 <-
      paste0("\n\nOriginal TDEE: ",
             tdee,
             " kcal.\nNew TDEE: ",
             tdee_new,
             " kcal .")
    message(sent1, sent2, sent3, sent4, sent5, sent6)
  } else {
    message(sent1, sent2, sent3, sent4, sent5)
  }
}