R/formatters.R

In tjmahr/printy: Helper functions for pretty-printing numbers

#' Format a number with a fixed number of digits
#' @param xs a vector of numbers or a character vector representing numbers
#' @param digits number of digits of precision
#' @export
#' @examples
#' # what we want to avoid
#' as.character(round(c(.4001, .1000, .5500), 2))
#'
#' fmt_fix_digits(c(.4001, .1000, .5500), 1)
#' fmt_fix_digits(c(.4001, .1000, .5500), 2)
#' fmt_fix_digits(c(.4001, .1000, .5500), 3)
fmt_fix_digits <- function(xs, digits = 2) {
  stopifnot(length(digits) == 1)
  rounded_xs <- round(xs, digits)
  decimals <- if (digits < 0) 0 else digits
  printed <- sprintf("%.*f", decimals, rounded_xs)
  printed[is.na(xs)] <- NA
  printed
}

#' Format negative numbers with a minus sign
#'
#' @inheritParams fmt_fix_digits
#' @return the vector with leading hyphens replaced with HTML minus signs
#'   (`&minus;`).
#' @export
#' @details Negative zero `-0`, which might happen from aggressive rounding,
#'   does not get a minus sign.
#' @examples
#' fmt_minus_sign(c(1, .2, -1, -.2))
#'
#' # Don't allow zero to be signed
#' fmt_minus_sign(c(-0, round(-0.001)))
fmt_minus_sign <- function(xs) {
  xs |>
    stringr::str_replace("^-", "&minus;") |>
    # Don't want a signed zero
    stringr::str_replace("^(&minus;)(0)$", "\\2") |>
    stringr::str_replace("^(&minus;)(0[.]0+)$", "\\2")
}

#' Replace HTML entities used by this package with UTF-8 codes
#' @param xs a character vector
#' @return the updated character vector
#' @export
#' @examples
#' x <- "a&nbsp;<&nbsp;&minus;12" |>
#'   fmt_remove_html_entities()
#' x
#' charToRaw(x)
#' charToRaw("a < -12")
#'
#' fmt_remove_html_entities("1&ndash;2")
fmt_remove_html_entities <- function(xs) {
  xs |>
    stringr::str_replace_all(stringr::fixed("&minus;"), "\u2212") |>
    stringr::str_replace_all(stringr::fixed("&nbsp;"), "\u00A0") |>
    stringr::str_replace_all(stringr::fixed("&ndash;"), "\u2013")
}

#' Format numbers to remove leading zeros
#'
#' @inheritParams fmt_fix_digits
#' @return the vector with leading zeros removed. This function returns a
#'   warning if any of the values have an absolute value greater than 1.
#' @export
#' @details APA format says that values that are bounded between \[-1, 1\]
#'   should not be formatted with a leading zero. Common examples would be
#'   correlations, proportions, probabilities and p-values. Why print the digit
#'   if it's almost never used?
#'
#'   Zeros are printed to match the precision of the most precise number. For
#'   example, `c(0, 0.111)` becomes `c(.000, .111)`
#' @examples
#' fmt_leading_zero(c(0, 0.111))
#' fmt_leading_zero(c(0.99, -0.9, -0.0))
fmt_leading_zero <- function(xs) {
  digit_matters <- xs |>
    as.numeric() |>
    abs() |>
    # Problem if any value is greater than 1.0
    is_greater_than_1() |>
    stats::na.omit()

  if (any(digit_matters)) {
    warning("Non-zero leading digit")
  }

  replaced <- stringr::str_replace(xs, "^(-?)0", "\\1")

  if (any(as.numeric(xs) == 0, na.rm = TRUE)) {
    # Match the most precise number (or use .0)
    precision <- max(c(stringr::str_count(replaced, "\\d"), 1))
    new_zero <- paste0(".", paste0(rep(0, precision), collapse = ""))
    replaced[xs == 0] <- new_zero
  }

  replaced
}

is_greater_than_1 <- function(xs) {
  xs > 1
}


#' Replace NAs with another value
#' @param x a character vector
#' @return the updated vector
#' @export
fmt_replace_na <- function(xs, replacement = "") {
  ifelse(is.na(xs), replacement, xs)
}


#' Format a *p*-value
#' @inheritParams fmt_fix_digits
#' @return formatted *-values. Values smaller than the precision `1 / (10 ^
#'   digits)` are replaced with a less than statement `< [precision]`.
#' @export
#' @examples
#' p <- c(1, 0.1, 0.01, 0.001, 0.0001)
#' fmt_p_value(p, digits = 2)
#' fmt_p_value(p, digits = 3)
fmt_p_value <- function(xs, digits = 3) {
  stopifnot(digits >= 1, length(digits) == 1)

  smallest_value <- 1 / (10 ^ digits)
  smallest_form <-  smallest_value  |>
    fmt_fix_digits(digits) |>
    fmt_leading_zero() |>
    paste0_after(.first = "< ")

  xs_chr <- xs |>
    fmt_fix_digits(digits) |>
    fmt_leading_zero()

  xs_chr[xs < smallest_value] <- smallest_form
  xs_chr
}

paste0_after <- function(..., .first) {
  paste0(.first, ...)
}

#' Format a *p*-value in markdown
#'
#' @param ps *p*-values to format
#' @return a character vector of markdown formatted *p*-values
#'
#' @details
#'
#' `fmt_p_value()` is for formatting p-values with manual precision, but this
#' functions follows some reasonable defaults and returns a markdown formatted
#' string.
#'
#' Values less than .06 are formatted with 3 digits. Values equal to .06 or
#' greater are formatted with 2 digits.
#'
#' [scales::label_pvalue()] does the initial rounding and formatting. Then this
#' function strips off the leading 0 of the *p* value.
#'
#' @export
#' @examples
#' fmt_p_value_md(0.0912)
#' fmt_p_value_md(0.0512)
#' fmt_p_value_md(0.005)
#'
#' # "p less than" notation kicks in below .001.
#' fmt_p_value_md(0.0005)
fmt_p_value_md <- function(ps) {
  prefixes <- c("*p*&nbsp;< ", "*p*&nbsp;= ", "*p*&nbsp;> ")
  label_pvalue_2 <- scales::label_pvalue(accuracy = .01 , prefix = prefixes)
  label_pvalue_3 <- scales::label_pvalue(accuracy = .001, prefix = prefixes)

  # use three digits if less than .06
  ps <- ifelse(
    ps < .06 | is.na(ps),
    label_pvalue_3(ps),
    label_pvalue_2(ps)
  )

  ps |>
    stringr::str_replace("(=|<|>) 0[.]", "\\1 .")
}