R/oneRM.R

#' Calculate one rep max using a formula
#'
#' @description
#' calculates the one rep max using one of 7 formula's
#'
#' @name formulas
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#'
#' @aliases NULL
NULL

#' Calculate one rep max using the Brzycki formula
#'
#' With this function you can calculate your one rep max using the formula from Brzycki. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#'
#' @rdname formulas
oneRMBrzycki <- function(r, w) {
  return(round(w / (1.0278 - (0.0278 * r)), 2))
}

#' Calculate one rep max using the Epley formula
#'
#' With this function you can calculate your one rep max using the formula from Epley. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMEpley <- function(r, w) {
  return(round(w * (1 + (r / 30)), 2))
}

#' Calculate one rep max using the Mayhew formula
#'
#' With this function you can calculate your one rep max using the formula from Mayhew. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMMayhew <- function(r, w) {
  return(round((100 * w) / (52.2 + (41.9 * (
    exp(-0.055 * r)
  ))), 2))
}

#' Calculate one rep max using the McGlothin formula
#'
#' With this function you can calculate your one rep max using the formula from McGlothin. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMMcGlothin <- function(r, w) {
  return(round((100 * w) / (101.3 - (2.67123 * r)), 2))
}

#' Calculate one rep max using the Lombardi formula
#'
#' With this function you can calculate your one rep max using the formula from Lombardi. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMLombardi <- function(r, w) {
  return(round(w * r ^ 0.10, 2))
}

#' Calculate one rep max using the O'Connor formula
#'
#' With this function you can calculate your one rep max using the formula from O'Connor. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMOConnor <- function(r, w) {
  return(round(w * (1 + (r / 40)), 2))
}

#' Calculate one rep max using the Wathan formula
#'
#' With this function you can calculate your one rep max using the formula from Wathan. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMWathan <- function(r, w) {
  return(round((100 * w) / (48.8 + (53.8 * (
    exp(-0.075 * r)
  ))), 2))
}

#' Calculate one rep max using the Wendler formula
#'
#' With this function you can calculate your one rep max using the formula from Wendler. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}.
#'
#' @param r number of reps
#' @param w weight
#'
#' @return one rep max
#' @rdname formulas
oneRMWendler <- function(r, w) {
  return(round((w * r * 0.0333) + w, 2))
}


label_facet <- function(method, value) {
  lev <- levels(as.factor(method))
  lab <- paste0(method, ": ", round(value, 2), " kg")
  names(lab) <- lev
  return(lab)
}

#' Calculate 1 Rep Max
#'
#' This function takes in your reps and weight to calculate your 1 Rep Max for. Note that 1RM are estimates and can be very different for all exercises. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}
#'
#' @param r The number of reps
#' @param w The weight for that number of reps
#' @param method Specifies the method to estimate your One Rep Max. Defaults to "All", other  options are `Brzycki`, `Epley`, `Mayhew`, `McGlothin`, `Lombardi`, `OConnor`, `Wathan` or `Wendler`.
#' @param plot Set to TRUE if you want to see the estimates visualized
#'
#' @return The value of your 1 Rep Max
#'
#' @importFrom ggplot2 geom_line geom_segment aes theme  geom_point coord_cartesian labs element_blank
#' @importFrom ggrepel geom_label_repel
#' @importFrom tibble add_row
#'
#' @export
#'
#' @examples
#' oneRM(8, 82.5)
#' oneRM(10, 40, method = "Lombardi", plot = FALSE)
#' oneRM(10, 40, method = "Brzycki", plot = FALSE)
#' oneRM(10, 40, method = "All", plot = FALSE)
#' oneRM(5, 210, plot = TRUE)
oneRM <- function(r,
                  w,
                  method = "All",
                  plot = FALSE) {
  # Error: when reps is not a whole number.
  if (r %% 1 != 0) {
    stop("The number of reps is not a whole number")
  }
  # Error: when reps are not found in the percentage table.
  else if (r > 10) {
    stop("`oneRM` can not calculate the 1RM accurately when `reps` is larger than 12.")
  }
  # Error: when reps is 1
  else if (r == 1) {
    stop("Number of reps must always be > 1.")
  }
  # Check: It does not make sense to plot if the method is not set to `All`.
  if (method != "All" & plot == TRUE) {
    stop(
      "If method is set `All`, plot can never be set to `TRUE`, because there is only one estimate"
    )
  }
  # If method = `All` a dataframe is created with all estimates, the mean and sd.
  if (method == "All") {
    out <- data.frame(
      "Method" = c(
        "Brzycki",
        "Epley",
        "Mayhew",
        "McGlothin",
        "Lombardi",
        "OConnor",
        "Wathan",
        "Wendler"
      ),
      "Values" = c(
        oneRMBrzycki(r, w),
        oneRMEpley(r, w),
        oneRMMayhew(r, w),
        oneRMMcGlothin(r, w),
        oneRMLombardi(r, w),
        oneRMOConnor(r, w),
        oneRMWathan(r, w),
        oneRMWendler(r, w)
      ),
      stringsAsFactors = FALSE
    )
    out <- out %>%
      mutate(Mean = mean(Values))
    # tibble::add_row(Method = "Mean", Values = mean(out$Values))
    #   tibble::add_row(Method = "SD", Values = sd(out$Values))
    # out <- out %>%
    #   tibble::add_row(Method = "SD-", Values = (out[9, 2] - out[10, 2])) %>%
    #   tibble::add_row(Method = "SD+", Values = (out[9, 2] + out[10, 2]))
  }

  # If the method is not `all`, methods are executed here.
  else if (method == "Brzycki") {
    out <- oneRMBrzycki(r, w)
  }
  else if (method == "Epley") {
    out <- oneRMEpley(r, w)
  }
  else if (method == "Mayhew") {
    out <- oneRMMayhew(r, w)
  }
  else if (method == "McGlothin") {
    out <- oneRMMcGlothin(r, w)
  }
  else if (method == "Lombardi") {
    out <- oneRMLombardi(r, w)
  }
  else if (method == "OConnor") {
    out <- oneRMLombardi(r, w)
  }
  else if (method == "Wathan") {
    out <- oneRMWathan(r, w)
  }
  else if (method == "Wendler") {
    out <- oneRMWendler(r, w)
  }
  # Error: If the method is not recognized.
  else {
    stop(
      "The method is not recognized. Method should be one of All, Brzycki, Epley, McGlothin, Lombardi, Mayhew, OConnor, Wathan or Wendler"
    )
  }
  # If plot is TRUE and method is `all`: make a ggplot object.
  if (plot & method == "All") {
    gg <- ggplot2::ggplot(out) +
      geom_segment(aes(
        x = 0,
        xend = 2,
        y = Values,
        yend = Values,
        color = Method
      )) +
      # ggplot2::geom_point(ggplot2::aes(x = 1,
      #                                  y = Values)) +
      # facet_wrap(~ Method, nrow = 1, labeller = labeller(Method = label_facet(out$Method, out$Values))) +
      ggplot2::geom_segment(aes(
        x = 0,
        xend = 2,
        y = Mean,
        yend = Mean
      ),
      color = HS_cols("color2")) +
      ggplot2::theme(
        axis.title.x = ggplot2::element_blank(),
        axis.text.x = ggplot2::element_blank(),
        axis.ticks.x = ggplot2::element_blank(),
        legend.position = "none"
      ) +
      ggrepel::geom_text_repel(
        aes(
          x = 1,
          y = Values,
          label = paste0(Method, ": ", Values, " kg"),
          colour = Method
        ),
        box.padding = 0.3,
        nudge_x = 0.1,
        nudge_y = 0.1
      ) +
      ggplot2::annotate(
        "text",
        label = paste0("Mean", ": ", round(out$Mean, 2), " kg"),
        x = 1.7,
        y = out$Mean + 0.5
      ) +
      scale_color_HS() +
      ggplot2::labs(
        title = "Estimated one rep max",
        x = NULL,
        y = "Weight (kg)",
        subtitle = paste(
          "One rep max estimates are based on",
          w,
          "kg and",
          r,
          "repetitions."
        )
      )
    return(gg)
  }
  # If plot not `TRUE`, return dataframe.
  else {
    return(out)
  }
}

#' Plot one rep max graphs estimates
#'
#' This function plots the functions for estimating your one rep max. For more information go to: \url{https://en.wikipedia.org/wiki/One-repetition_maximum}. In this plot you can see how your one rep max scales for that weight from 1 - r.
#'
#' @param r The number of reps
#' @param w The weight for that number of reps
#'
#' @importFrom ggplot2 stat_function scale_x_continuous scale_y_continuous
#'
#' @export
#'
#' @examples
#' plotEstimates(8, 100)
plotEstimates <- function(r, w) {
  gg <- ggplot(data.frame(x = c(0, 1)), aes(x = x)) +
    stat_function(
      fun = oneRMBrzycki,
      args = list(w),
      aes(colour = "Brzycki"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMEpley,
      args = list(w),
      aes(colour = "Epley"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMLombardi,
      args = list(w),
      aes(colour = "Lombardi"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMWendler,
      args = list(w),
      aes(colour = "Wendler"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMMcGlothin,
      args = list(w),
      aes(colour = "McGlothin"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMOConnor,
      args = list(w),
      aes(colour = "OConnor"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMMayhew,
      args = list(w),
      aes(colour = "Mayhew"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    stat_function(
      fun = oneRMWathan,
      args = list(w),
      aes(colour = "Wathan"),
      size = 1,
      alpha = 0.6,
      xlim = c(0, r)
    ) +
    scale_color_HS() +
    scale_y_continuous("Weight (kg)") +
    # limits = c(, 140))+
    scale_x_continuous("Reps", breaks = c(seq(w, 0, -1)))

  return(gg)
}
MarijnJABoer/HeavySetR documentation built on May 22, 2019, 5:31 p.m.