R/promillo-withdoc.R

In fort-w2021/promillo-ex-MarcJohler: blood-alcohol-level calculator

#' Visualization of hypothetical blood-alcohol-level over time
#'
#' Uses the function [promillo::tell_me_how_drunk()] to compute the blood-alcohol-level after the drinking period and displays some intermediate values according to a chosen interval width. Note that the visualization is simplified according to the assumption that every drink was consumed right at the start of the drinking period. An actual realistic curve would be fluctuating
#'
#' @inheritParams get_bodywater
#' @inheritParams get_alcohol
#' @inheritParams tell_me_how_drunk
#' @param interval_width difftime-object, representing the time-interval-width for intermediate values of blood-alcohol-level. If it is chosen too wide, only the start and end value are displayed. Default is 5 minutes
#' @return a ggplot-object generated by [ggplot2::qplot()]
#' @author Marc Johler
#' @importFrom ggplot2 qplot
#' @import checkmate
#' @examples
#' \dontrun{
#' show_me_how_drunk(
#'   age = 39,
#'   sex = "male",
#'   height = 190,
#'   weight = 87,
#'   drinking_time = as.POSIXct(c("2016-10-03 17:15:00", "2016-10-03 22:55:00")),
#'   drinks = c("massn" = 3, "schnaps" = 4),
#'   interval_width = as.difftime("00:10:00")
#' )
#' }
#' @export
show_me_how_drunk <- function(age, sex = c("male", "female"), height, weight,
                              drinking_time, drinks,
                              interval_width = as.difftime("00:05:00")) {
  # check if interval_width's dimensions fit
  checkmate::assert_numeric(interval_width, len = 1, lower = 0, any.missing = FALSE)
  # check if interval_width is a difftime object
  checkmate::assert_class(interval_width, "difftime", null.ok = FALSE)
  # compute start and end blood-alcohol-value
  start_value <- tell_me_how_drunk(age, sex, height, weight,
    drinking_time = c(drinking_time[1], drinking_time[1]),
    drinks
  )
  end_value <- tell_me_how_drunk(
    age, sex, height, weight,
    drinking_time, drinks
  )
  # create set of time points for intermediate values
  measure_points <- seq(drinking_time[1], drinking_time[2], by = interval_width)
  # last point must be added manually
  measure_points <- c(measure_points, drinking_time[2])
  # compute the hypothetical blood-alcohol-level for each point
  blood_alcohol_values <- numeric(length = length(measure_points))
  for (i in seq_along(measure_points)) {
    # if start of drinking period was within the previous hour,
    # blood-alcohol-level is still the same
    if (difftime(measure_points[i], drinking_time[1], units = "hours") <= 1) {
      blood_alcohol_values[i] <- start_value
    } else {
      # time since start of alcohol breakdown
      sober_up_time <- difftime(measure_points[i],
        drinking_time[1] + as.difftime("01:00:00"),
        units = "mins"
      )
      # time left until end of drinking time
      time_left <- difftime(drinking_time[2], measure_points[i], units = "mins")
      # compute the blood-alcohol-value at a certain time point as weighted mean
      blood_alcohol_values[i] <- (as.numeric(sober_up_time) * end_value +
        as.numeric(time_left) * start_value) /
        as.numeric(sober_up_time + time_left)
    }
  }
  # create basic plot
  plot <- ggplot2::qplot(
    x = measure_points, y = blood_alcohol_values,
    ylab = "blood-alcohol-level in per mille",
    ylim = c(0, start_value)
  )
  # add an x-axis and display
  plot + ggplot2::scale_x_continuous(name = "Time", breaks = seq(drinking_time[1],
    drinking_time[2],
    length.out = 5
  ))
}

#' Computation of blood-alcohol-level
#'
#' Applies the formula for total body water according to Whatson, in order to compute the blood-alcohol-level according to Widmark.
#' The individuals attributes as height, weight, age and gender are included, as well as the consumed amount of alcohol and the duration of consumption.
#'
#' @inheritParams get_bodywater
#' @inheritParams get_alcohol
#' @param drinking_time two element POSIXct-vector with the first element being the start time of drinking and the second element being the end time of drinking
#' @return a numeric value representing the blood-alcohol-level in per mille
#' @author  Fabian Scheipl, Marc Johler
#' @references https://web.archive.org/web/20150123143123/http://promille-rechner.org/erlaeuterung-der-promille-berechnung/
#' @aliases how_drunk
#' @import checkmate
#' @examples
#' # This is supposed to work without warnings:
#' \dontrun{
#' tell_me_how_drunk(
#'   age = 39,
#'   sex = "male",
#'   height = 190,
#'   weight = 87,
#'   drinking_time = as.POSIXct(c("2016-10-03 17:15:00", "2016-10-03 22:55:00")),
#'   drinks = c("massn" = 3, "schnaps" = 4)
#' )
#'
#' # Violations of German laws according alcohol consumption will be reported as a warning:
#' tell_me_how_drunk(
#'   age = 17,
#'   sex = "male",
#'   height = 170,
#'   weight = 65,
#'   drinking_time = as.POSIXct(c("2016-10-03 17:15:00", "2016-10-03 22:55:00")),
#'   drinks = c("wein" = 3, "schnaps" = 4)
#' )
#'
#' tell_me_how_drunk(
#'   age = 15,
#'   sex = "female",
#'   height = 165,
#'   weight = 58,
#'   drinking_time = as.POSIXct(c("2016-10-03 17:15:00", "2016-10-03 22:55:00")),
#'   drinks = c("hoibe" = 3)
#' )
#' }
#' @export
tell_me_how_drunk <- function(age, sex = c("male", "female"), height, weight,
                              drinking_time, drinks) {
  # do input checks and homogenize inputs:
  drinks <- unlist(drinks)
  checkmate::assert_subset(names(drinks),
    choices = c("massn", "hoibe", "wein", "schnaps"),
    empty.ok = FALSE
  )
  checkmate::assert_numeric(drinks, lower = 0)

  sex <- tolower(sex)
  sex <- match.arg(sex)

  checkmate::assert_number(age, lower = 10, upper = 110)
  if (age < 16 | (age < 18 && "schnaps" %in% names(drinks))) {
    warning("illegal")
  }
  checkmate::assert_number(height, lower = 100, upper = 230)
  checkmate::assert_number(weight, lower = 40, upper = 300)

  checkmate::assert_posixct(drinking_time, any.missing = FALSE, sorted = TRUE, len = 2)

  alcohol_drunk <- get_alcohol(drinks)
  bodywater <- get_bodywater(sex, age, height, weight)
  get_permille(alcohol_drunk, bodywater, drinking_time)
}

# utilities --------------------------------------------------------------------
#' Computation of pure alcohol
#'
#' Takes a list of alcoholic drinks and computes the cummulated mass of pure alcohol
#'
#' @param drinks named numeric vector.
#' Names of the vector represent the consumed type of drink, the numbers represent the consumed quantitiy of the corresponding drink.
#' Currently the following drinks are supported: "massn", "hoibe", "wein" and "schnaps"
#' @return a numeric value representing the mass of absolute alcohol in gram
#' @author  Fabian Scheipl, Marc Johler
#' @references https://web.archive.org/web/20150123143123/http://promille-rechner.org/erlaeuterung-der-promille-berechnung/
#' @examples
#' \dontrun{
#' get_alcohol(c("hoibe" = 3, "wein" = 2, "massn" = 1))
#' }
get_alcohol <- function(drinks) {
  volume <- c(
    "massn"    = 1000,
    "hoibe"   = 500,
    "wein"    = 200,
    "schnaps" = 40
  )
  alcohol_concentration <- c(
    "massn"    = 0.06,
    "hoibe"   = 0.06,
    "wein"    = 0.11,
    "schnaps" = 0.4
  )
  alcohol_density <- 0.8

  sum(drinks * volume[names(drinks)] *
    alcohol_concentration[names(drinks)] * alcohol_density)
}

#' Computation of body water
#'
#' Computes an individuals quantity of body water
#'
#' @param age age of the individual in years
#' @param sex sex of the individual. Either "male" or "female"
#' @param height height of the individual in centimeters
#' @param weight weight of the individual in kilograms
#' @return a numeric value representing the quantity of body water in liters
#' @author  Fabian Scheipl, Marc Johler
#' @references https://web.archive.org/web/20150123143123/http://promille-rechner.org/erlaeuterung-der-promille-berechnung/
#' @examples
#' \dontrun{
#' get_bodywater(
#'   age = 17,
#'   sex = "male",
#'   height = 170,
#'   weight = 65
#' )
#' }
get_bodywater <- function(sex = c("male", "female"), age, height, weight) {
  coef <- if (sex == "male") {
    c(2.447, -0.09516, 0.1074, 0.3362)
  } else {
    c(0.203, -0.07, 0.1069, 0.2466)
  }
  t(coef) %*% c(1, age, height, weight)
}

#' Low-level function to compute blood-alcohol-level
#'
#' Computes the "alcohol per mille" value based on consumed alcohol, total body water and passed time since start of drinking
#'
#' @param alcohol_drunk mass of consumed alcohol in gram
#' @param bodywater quantity of individuals body water in liters
#' @param drinking_time two element POSIXct-vector with the first element being the start time of drinking and the second element being the end time of drinking
#' @return a numeric value representing the blood-alcohol-level in per mille
#' @author Fabian Scheipl, Marc Johler
#' @references https://web.archive.org/web/20150123143123/http://promille-rechner.org/erlaeuterung-der-promille-berechnung/
#' @examples
#' \dontrun{
#' get_permille(
#'   alcohol_drunk = 48,
#'   bodywater = 42,
#'   drinking_time = as.POSIXct(c("2016-10-03 17:15:00", "2016-10-03 22:55:00"))
#' )
#' }
get_permille <- function(alcohol_drunk, bodywater, drinking_time) {
  alcohol_density <- 0.8
  blood_density <- 1.055
  permille <- alcohol_density * alcohol_drunk / (blood_density * bodywater)

  partylength <- difftime(drinking_time[2], drinking_time[1], units = "hours")
  sober_per_hour <- 0.15
  # sobering up starts only after one hour & you can't be more sober than 0:
  max(0, permille - (max(0, partylength - 1) * sober_per_hour))
}