R/formatp.R

In tab: Create Summary Tables for Statistical Reports

#' Format P-values for Functions in the \pkg{tab} Package
#'
#' Formats p-values for tables generated by the functions in the \pkg{tab}
#' package. Handles rounding and presentation of p-values.
#'
#' @param p Numeric vector of p-values.
#'
#' @param decimals Number of decimal places for p-values. If a vector is
#' provided rather than a single value, number of decimal places will depend on
#' what range the p-value lies in. See \code{cuts} input.
#'
#' @param cuts Cut-point(s) to control number of decimal places used for
#' p-values. For example, by default \code{cuts = 0.1} and
#' \code{decimals = c(2, 3)}. This means that p-values in the range [0.1, 1]
#' will be printed to two decimal places, while p-values in the range [0, 0.1)
#' will be printed to three decimal places.
#'
#' @param lowerbound Controls cut-point at which p-values are no longer printed
#' as their value, but rather <lowerbound. For example, by default
#' \code{lowerbound = 0.001}. Under this setting, p-values less than 0.001 are
#' printed as \code{<0.001}.
#'
#' @param leading0 If \code{TRUE}, p-values are printed with 0 before decimal
#' place; if \code{FALSE}, the leading 0 is omitted.
#'
#' @param avoid1 If \code{TRUE}, p-values rounded to 1 are not printed as 1, but
#' as \code{>0.99} (or similarly depending on \code{decimals} and \code{cuts}).
#'
#' @return Character vector.
#'
#' @examples
#' # Generate vector of numeric p-values
#' set.seed(123)
#' p <- c(runif(n = 5, min = 0, max = 1), 1, 0, 4e-7, 0.009)
#'
#' # Round to nearest 2 decimals for p in (0.01, 1] and 3 decimals for p < 0.01
#' pvals <- formatp(p = p)
#'
#' # Use 2 decimal places, a lower bound of 0.01, and omit the leading 0
#' pvals <- formatp(p = p, decimals = 2, lowerbound = 0.01, leading0 = FALSE)
#'
#' @export
formatp <- function(p, decimals = c(2, 3), cuts = 0.01, lowerbound = 0.001,
                    leading0 = TRUE, avoid1 = FALSE) {

  # If any inputs are not correct class or out of range, return error
  if (min(p) < 0 | max(p) > 1) {
    stop("Please ensure that all p-values are between 0 and 1")
  }
  if (!is.numeric(decimals)) {
    stop("For decimals input, please enter numeric value or vector")
  }
  if (!is.numeric(cuts)) {
    stop("For cuts input, please enter numeric value or vector")
  }
  if (!is.numeric(lowerbound)) {
    stop("For lowerbound input, please enter numeric value")
  }
  if (!is.logical(leading0)) {
    stop("For leading0 input, please enter TRUE or FALSE")
  }
  if (!is.logical(avoid1)) {
    stop("For avoid1 input, please enter TRUE or FALSE")
  }

  # Determine number of decimal points to use
  if (length(decimals) > 1) {
    dec <- cut(x = p, breaks = c(0, cuts, 1), labels = rev(decimals),
               include.lowest = TRUE, right = FALSE)
  } else {
    dec <- rep(decimals, length(p))
  }

  # Create spf to control format of string
  spf <- paste("%0.", dec, "f", sep = "")

  # Format pval
  pval <- c()
  for (ii in 1:length(p)) {
    if (leading0 == TRUE) {
      if (p[ii] < lowerbound) {
        pval[ii] <- paste("<", as.numeric(lowerbound), sep = "")
      } else {
        pval[ii] <- sprintf(spf[ii], p[ii])
      }
      if (avoid1 == TRUE & unlist(strsplit(pval[ii], ""))[1] == "1") {
        pval[ii] <- paste(">0.",
                          paste(rep("9", dec[ii]), sep = "", collapse = ""),
                          sep = "")
      }
    } else {
      if (p[ii] < lowerbound) {
        pval[ii] <- paste("<",
                          paste(strsplit(as.character(lowerbound), "")[[1]][-1],
                                collapse = ""),
                          sep = "")
      } else {
        first <- paste(strsplit(sprintf(spf[ii], p[ii]), "")[[1]])[1]
        if (first == "1") {
          pval[ii] <- paste(strsplit(sprintf(spf[ii], p[ii]), "")[[1]],
                            collapse = "")
        } else {
          pval[ii] <- paste(strsplit(sprintf(spf[ii], p[ii]), "")[[1]][-1],
                            collapse = "")
        }
      }
      if (avoid1 == TRUE & unlist(strsplit(pval[ii], ""))[1] == "1") {
        pval[ii] <- paste(">.", paste(rep("9", dec[ii]), sep = "",
                                      collapse = ""), sep = "")
      }
    }
  }

  # Return pval
  return(pval)

}