R/f.R

In neatR: Neat Data for Presentation

#' Infer the format type from the input.
#' @noRd
.infer_type <- function(x) {
  if (inherits(x, "POSIXt")) {
    return("ts")
  }
  if (inherits(x, "Date")) {
    return("date")
  }
  if (is.numeric(x)) {
    return("number")
  }
  if (is.character(x)) {
    return("string")
  }
  if (all(is.na(x))) {
    "na"
  }
}

#' Smart format function that infers type and applies neatR formatting.
#'
#' @param x Input data to format.
#' @param format_type Explicit format type: 'day', 'date', 'ts', 'number',
#' 'percent', 'string'. If NULL, type is inferred.
#' @param ... Additional parameters passed to the underlying formatting
#' functions.
#' @return Formatted string or vector of strings.
#' @importFrom utils modifyList
#' @export
f <- function(x, format_type = NULL, ...) {
  args <- list(...)

  if (is.null(format_type)) {
    format_type <- .infer_type(x)
  }

  if (format_type == "day") {
    params <- list(show_relative_day = FALSE)
    params <- modifyList(params, args)
    do.call(nday, c(list(x), params))
  } else if (format_type == "date") {
    params <- list(show_weekday = FALSE)
    params <- modifyList(params, args)
    do.call(ndate, c(list(x), params))
  } else if (format_type == "ts") {
    params <- list(show_weekday = TRUE, show_timezone = TRUE)
    params <- modifyList(params, args)
    res <- do.call(ntimestamp, c(list(x), params))
    res
  } else if (format_type == "number") {
    params <- list(thousand_separator = ",", unit = "custom")
    params <- modifyList(params, args)
    do.call(nnumber, c(list(x), params))
  } else if (format_type == "percent") {
    is_ratio <- if (is.null(args$is_ratio)) TRUE else args$is_ratio
    digits <- if (is.null(args$digits)) 1 else args$digits
    show_plus_sign <- if (is.null(args$show_plus_sign)) {
      TRUE
    } else {
      args$show_plus_sign
    }
    main_pct <- npercent(
      x,
      is_ratio = is_ratio,
      digits = digits,
      show_plus_sign = show_plus_sign
    ) # nolint

    x_val <- as.numeric(x)
    mult <- if (is_ratio) x_val else x_val / 100.0
    growth_val <- abs(mult)
    growth_str_list <- ifelse(
      growth_val %% 1 != 0,
      sprintf("%.1f", growth_val),
      sprintf("%.0f", growth_val)
    )
    growth_labels <- ifelse(mult >= 0, "x growth", "x drop")
    growth_full <- paste0(growth_str_list, growth_labels)
    bps_val <- if (is_ratio) x_val * 10000 else x_val * 100
    bps_fmt_arr <- nnumber(bps_val, digits = 0, thousand_separator = ",")
    bps_fmt_clean <- gsub(" ", "", bps_fmt_arr)
    bps_full <- paste0(bps_fmt_clean, " basis points")
    rhs <- paste0(" (", growth_full, ", ", bps_full, ")")
    comp <- paste0(main_pct, rhs)
    comp
  } else if (format_type == "string") {
    params <- list(case = "title", remove_specials = TRUE, ascii_only = TRUE)
    params <- modifyList(params, args)
    do.call(nstring, c(list(x), params))
  } else if (format_type == "na") {
    # If input is all NA/logical NA, return appropriate NA matching input length
    # But input x might be length 1 (scalar NA) or vector
    # Return NA_character_ since neatR returns strings
    # Try to return vector of NAs if x is vector?
    rep(NA_character_, length(x))
  } else {
    stop(paste("Unknown format_type:", format_type))
  }
}