R/functions.R

In andrew-a-hale/initmediaRUtils: R Utilities @Initmedia

#' Pipe operator
#'
#' @name %>%
#' @rdname pipe
#' @keywords internal
#' @export
#' @importFrom magrittr %>%
#' @usage lhs \%>\% rhs
NULL

#' Compound Pipe operator
#'
#' @name %<>%
#' @rdname Cpipe
#' @keywords internal
#' @export
#' @importFrom magrittr %<>%
#' @usage lhs \%<>\% rhs
NULL

#' Update Package
#' @noRd
updatePkg <- function()
  devtools::install_github("andrew-a-hale/initmediaRUtils")

#' Encode graphic for html base 64
#' @export
#' @param g is an image
#' @param height is the height in px of the image
#' @param aspectRatio is the aspect ratio of the image as a fraction
#'
#' @return An encode version of \code{g}
#'
#' @examples
#' encodeGraphic("my_test_plot.png", 480, 4/3)
encodeGraphic <- function(g, height = 480, aspectRatio = 4/3) {
  grDevices::png(
    tf1 <- tempfile(fileext = ".png"),
    width = height * aspectRatio,
    height = height,
    type = "cairo-png"
  )
  print(g)
  grDevices::dev.off()
  txt <- RCurl::base64Encode(
    readBin(tf1, "raw", file.info(tf1)[1, "size"]),
    "txt"
  )
  myImage <- htmltools::HTML(sprintf('<img src="data:image/png;base64,%s">', txt))
  return(myImage)
}

#' Vectorised comparison of 2 vectors
#' @export
#' @param v1 first vector of values
#' @param v2 second vector of values
#' @param operator type of comparator. eg. "==", ">", "<", "!=", "<=", ">="
#'
#' @return logical vector
#'
#' @examples
#' v1 <- c(1, 2L, 2)
#' v2 <- c(1, 2L, 3)
#' compareOrNA(v1, v2, "==")
#'
#' v1 <- c(1, 2L, 3)
#' v2 <- 1.2
#' compareOrNA(v1, v2, "==")
compareOrNA <- function(v1, v2, operator = "==") {
  if (length(v2) == 1) v2 <- rep(v2, length(v1))
  if (length(v1) != length(v2)) stop(simpleError("args have different lengths"))
  e <- lapply(seq_along(v1), function(x) {
    if(anyNA(c(v1[x], v2[x]))) return(TRUE)
    call(operator, v1[x], v2[x])
  })
  sapply(e, eval)
}

#' Prettier date ticks
#' @export
#' @param period 2 element ordered vector (smallest first.) Works with shiny dateRangeInputs.
#'
#' @return character vector with period and format, eg. c("3 day", "%d %b %Y")
#'
#' @examples
#' period <- c("2019-01-01", "2019-03-31")
#' date_ticks_by_period(period)
date_ticks_by_period <- function(period) {
  period <- lubridate::as_date(period)
  p <- period[2] - period[1] %>% as.numeric()
  patterns <- lapply(1:5, function(x) { dplyr::between(p, 365, x * 365) ~ c(paste(x, "month"), "%b %Y") })
  more_patterns <- list(
    dplyr::between(p, 365 / 2, 364) ~ c("2 week", "%d %b %Y"),
    dplyr::between(p, 365 / 4, 365 / 2 - 1) ~ c("1 week", "%d %b %Y"),
    dplyr::between(p, 365 / 12, 365 / 4 - 1) ~ c("3 day", "%d %b %Y"),
    TRUE ~ c("1 day", "%d %b %Y")
  )
  patterns %<>% append(more_patterns)
  dplyr::case_when(!!!patterns)
}

#' Converting data frame into a JSON object suitable for charts.
#' @export
#' @param data data frame object
#' @param label json key
#' @param chartType type of chart, eg. "bar"
#' @param xLabels vector of x-axis labels
#' @param type optional
#' @param rankPosition optional
#' @param excludeRank optional
#' @param leadingText optional
#' @param trailingText optional
#' @param name optional
#' @param caption optional
#' @param title optional
#' @param subtitle optional
#' @param xType optional
#' @param y0Type optional
#' @param y1Type optional
#' @param xAxisLabel optional
#' @param y0AxisLabel optional
#' @param y1AxisLabel optional
#' @param xUnits optional
#' @param y0Units optional
#' @param y1Units optional
#' @param legendPos optional
#' @param seriesTypes optional
#' @param y0Labels optional
#' @param y1Labels optional
#' @param seriesXAxis optional
#' @param seriesYAxis optional
#'
#' @return json object
#' @importFrom rlang .data
dataToJSON <- function(
  data, label, chartType, xLabels, type = NULL, rankPosition = NULL, excludeRank = NULL,
  leadingText = NULL, trailingText = NULL, name = NULL, caption = NULL, title = NULL,
  subtitle = NULL, xType = NULL, y0Type = NULL, y1Type = NULL, xAxisLabel = NULL,
  y0AxisLabel = NULL, y1AxisLabel = NULL, xUnits = NULL, y0Units = NULL, y1Units = NULL,
  legendPos = NULL, seriesTypes = NULL, y0Labels = NULL, y1Labels = NULL,seriesXAxis = NULL,
  seriesYAxis = NULL
) {
  res <- list()
  res[[label]] <- list(
    "leadingText" = leadingText,
    "trailingText" = trailingText,
    "caption" = caption,
    "title" = title,
    "subtitle" = subtitle,
    "name" = name,
    "xAxisLabel" = xAxisLabel,
    "xUnits" = xUnits,
    "xLabels" = xLabels,
    "xType" = xType,
    "yAxes" = list(
      "0" = list(
        "axisLabel" = y0AxisLabel,
        "units" = y0Units,
        "labels" = y0Labels,
        "type" = y0Type
      ),
      "1" = list(
        "axisLabel" = y1AxisLabel,
        "units" = y1Units,
        "labels" = y1Labels,
        "type" = y1Type
      )
    ),
    "chartType" = chartType,
    "legendPosition" = legendPos
  )
  series <- list()
  if (!is.null(type)) {
    types <- data %>% dplyr::select(.data[[type]], rank) %>% unique() %>% dplyr::arrange(rank)
    ts <- types %>% dplyr::pull(.data[[type]])
    if (is.null(rankPosition) & is.null(excludeRank)) {
      for (t in ts) {
        k <- which(ts == t) - 1 # key
        d <- data %>% dplyr::filter(.data[[type]] == t) # data for type
        series[[as.character(k)]] = list(
          "name" = t,
          "totalCount" = sum(d$y),
          "xValues" = d$x,
          "yValues" = d$y,
          "type" = seriesTypes[k+1],
          "xAxis" = seriesXAxis[k+1],
          "yAxis" = seriesYAxis[k+1]
        )
      }
    } else if (is.null(rankPosition) & !is.null(excludeRank)) {
      ts <- types %>% dplyr::filter(rank != excludeRank) %>% dplyr::pull(.data[[type]])
      for (t in ts) {
        k <- which(ts == t) - 1 # key
        d <- data %>% dplyr::filter(.data[[type]] == t) # data for type
        series[[as.character(k)]] = list(
          "name" = t,
          "totalCount" = sum(d$y),
          "xValues" = d$x,
          "yValues" = d$y,
          "type" = seriesTypes[k+1],
          "xAxis" = seriesXAxis[k+1],
          "yAxis" = seriesYAxis[k+1]
        )
      }
    } else if (rankPosition %in% types$rank) {
      series = list(
        "0" = list(
          "name" = types %>% dplyr::filter(rank == rankPosition) %>% dplyr::pull(.data[[type]]),
          "totalCount" = sum(data[data$rank == rankPosition, ]$y),
          "xValues" = data[data$rank == rankPosition, ]$x,
          "yValues" = data[data$rank == rankPosition, ]$y
        )
      )
    }
  } else {
    series = list(
      "0" = list(
        "name" = "Count",
        "totalCount" = sum(data$y),
        "xValues" = data$x,
        "yValues" = data$y
      )
    )
  }
  res[[label]]$series <- series
  res
}

#' Table Headers to JSON
#' @export
#' @param header Header Name
#' @param label json key
#' @param align Header and value alignment, eg. "left", "right"
#' @param type column data type, eg. "text", "number", "date"
#' @return json object
tableHeaderToJSON <- function(header, label, align = "left", type = "text") {
  res <- list()
  label <- as.character(label)
  if (grepl("(\\d{1,2}|T)", header)) type <- "integer" # this is for the operational report
  res[[label]] <- list(
    name = header,
    align = align,
    type = type
  )
  res
}

#' Prettier Y tick
#' @export
#' @param v numeric vector suitable for pretty
#' @param start a minimum value for the vector, eg. 0
#' @param ... passed to base::pretty
#' @return numeric vector
prettyYs <- function(v, start = NULL, ...) {
  if (!is.null(start))  v <- c(start, v)
  ys <- pretty(v, ...)
  ydiff <- ys[2] - ys[1]
  if (max(v) > max(ys)) ys <- c(ys, max(ys) + ydiff)
  ys
}

#' Date to Financial Date
#' @export
#' @param year_string year as string, eg. "2019"
#' @param quarter_string quarter as string, eg. "4"
#' @return vector of numeric financial year, numeric financial quarter
finDateToCalDate <- function(year_string, quarter_string) {
  year <- stringr::str_split_fixed(year_string, "/", 2)[2] %>% as.numeric()
  quarter <- as.numeric(quarter_string)
  if (quarter < 3) {
    year <- year - 1
    quarter <- quarter + 2
  } else {
    quarter <- quarter - 2
  }
  return(c(year, quarter))
}

#' True or Null
#' @export
#' @param ... arguments suitable for the any() function in base R
#' @return logical
#' @examples
#' anyOrNull(NA, 1)
#' anyOrNull(FALSE, 1)
#' anyOrNull(NULL)
#' anyOrNull(NA)
#' anyOrNull(NULL, NA)
anyOrNull <- function(...) {
  suppressWarnings({
    if (any(..., na.rm = T)) return(TRUE)
  })
  return(NULL)
}

#' Parent Directory
#' @export
#' @param path file path, eg. normalizePath(".")
#' @param ... additional elements to appended to the parent directory
#' @return character vector
#' @examples
#' parentDir()
parentDir <- function(path, ...) {
  args <- rlang::ensyms(...)
  appendParent <- paste0(purrr::map(args, rlang::as_string), collapse = "/")
  path <- stringr::str_replace_all(path, "\\\\", "/")
  if (endsWith(path, "/")) path <- stringr::str_sub(path, 1, -2)
  parent <- stringr::str_match(path, ".*/")[1, 1]
  paste0(parent, appendParent)
}

#' Pretty HTML Table
#' @export
#' @param df data frame
#' @param title optional title for the table
#' @param footnote optional simple footnote
#' @return HTML Table
#' @examples
#' dfToPrettyTable(iris)
#' dfToPrettyTable(head(iris), "iris data", "my note")
dfToPrettyTable <- function(df, title = NULL, footnote = NULL) {
 table <- knitr::kable(df, 'html', caption = title, escape = FALSE) %>%
    kableExtra::kable_styling(
      bootstrap_options = c("striped", "bordered", "condensed"),
      position = "left",
      full_width = TRUE,
    ) %>%
    kableExtra::row_spec(
      0,
      background = "#4682b4",
      color = "white",
      extra_css = "border-right: 1px solid white"
    ) %>%
   kableExtra::footnote(footnote)
  htmltools::HTML(
    "<style>
      caption {
        font-size: 20px;
        text-align: left;
        caption-side: top;
      }
      td {
        padding-top: 0px;
        padding-bottom: 0px
      }
    </style>",
    table
  )
}

#' Another Pretty HTML Table
#' @export
#' @param df data frame
#' @param title optional title for the table
#' @param width width in pixel. default is 400
#' @param footnote optional simple footnote
#' @param headerFontSize font-size for the header row of the table. default is 14px.
#' @param highlightRow optional vector containing row numbers to highlight
#' @param highlightColour optional argument to change highlightRow colour,
#' if highlightRow is given. default value = "#4daf4a"
#' @param align optional vector to align table columns must have the
#' same length as the number of columns. eg. c("left", "center", "right")
#' also maps "lcr" -> c("left", "center", "right")
#' @param cellPadding should be valid html, eg. 0px 2px, etc
#' @return HTML Table
#' @examples
#' dfToAnotherPrettyTable(head(iris))
#' dfToAnotherPrettyTable(
#'   head(iris), "iris data", 800, "my note", "14px", 2, "#4daf4a",
#'   align = c("right", "right", "right", "right", "left")
#' )
#' dfToAnotherPrettyTable(
#'   head(iris), "iris data", 800, "my note", "14px", 2, "#4daf4a",
#'   align = "rrrrl", cellWrapping = "normal"
#' )
dfToAnotherPrettyTable <- function(
  df, title = NULL, width = 400, footnote = NULL, headerFontSize = "15px",
  highlightRow = NULL, highlightColour = "#4daf4a", align = NULL,
  cellPadding = "1px 2px 1px 2px", cellWrapping = "nowrap"
) {
  rows = nrow(df)
  cols = ncol(df)
  if(!missing(align) && length(align) == 1 && stringr::str_length(align) == cols) {
    align <- stringr::str_split(align, "") %>%
      unlist() %>%
      stringr::str_replace_all(
        c("[^clr]" = "left", "^c$" = "center", "^l$" = "left", "^r$" = "right")
      )
  }
  if (!missing(align) && length(align) != cols)
    stop("align vector not the same size ncol(df)")
  if (rows > 0) {
    tableRows <- lapply(1:rows, function(x) {
      if (x %in% highlightRow) {
        bg = highlightColour
        color = "#ffffff"
      } else if (x %% 2 == 1) {
        bg = "#ddd"
        color = "#000000"
      } else {
        bg = "#ffffff"
        color = "#000000"
      }
      htmltools::tags$tr(
        bgcolor = bg,
        style = paste("background-color:", bg, "; color:", color),
        lapply(1:cols, function(y) {
          htmltools::tags$td(
            df[x, y],
            align = if (is.null(align)) "center" else align[y],
            style = stringr::str_glue(
              "white-space: {cellWrapping}; padding: {cellPadding}"
            )
          )
        })
      )
    })
  } else {
    tableRows <- htmltools::tags$tr(
      bgcolor = "#ddd", style = paste("background-color: #ddd"),
      htmltools::tags$td("No data to display", colspan = cols, align = "center")
    )
  }

  tableTitle <- if (missing(title)) NULL else htmltools::tags$h2(title)
  tableNote <- if (missing(footnote)) NULL else htmltools::tags$p(footnote, style = "margin-top: 0px")

  htmltools::tagList(
    htmltools::tags$style(
      "table, td, th {
        border: 1px solid #bfbfbf;
        font-size: 0.95em;
        font-family: Helvetica, Arial, sans-serif;
      }"
    ),
    tableTitle,
    htmltools::tags$table(
      width = width,
      border = "1",
      style = "border-collapse: collapse; page-break-inside: avoid;",
      htmltools::tags$tr(
        lapply(
          1:cols,
          function(x) {
            htmltools::tags$th(
              names(df)[x],
              align = if (is.null(align)) "center" else align[x],
              bgcolor = "#4682b4",
              style = stringr::str_glue(
                "background-color: {bgcolor};
                color: #ffffff;
                padding: {cellPadding};
                margin: 0px;
                font-size: {headerFontSize};
                text-align: center;
                font-weight: 600;",
                bgcolor = "#4682b4"
              )
            )
          }
        )
      ),
      tableRows
    ),
    tableNote
  ) %>%
    as.character() %>%
    stringr::str_replace_all(c("&lt;" = "<", "&gt;" = ">", "&amp;" = "&")) %>%
    htmltools::HTML()
}

#' Empty ggplot with text label
#' @export
#' @param title plot title
#' @param chartType chart type. default value is "regular". regular includes
#' line and bar charts. other values are "pie"
#' @param textLabel text label for the center of the plot
#' @param textSize font size of the annotation. default value is 14px
#' @param subtitleOne optional subtitle
#' @param subtitleTwo optional subtitle under first subtitle
#' @param logo optional watermark image
#' @param border optional. adds a border to the plot, default value is TRUE
#' @return ggplot object
#' @examples
#' emptyPlot(
#'   "Title", textLabel = "No data to display", subtitleOne = "SubtitleOne",
#'   subtitleTwo = "SubtitleTwo", logo = magick::logo
#' )
#' emptyPlot(
#'   "Pie Chart", "pie", "bad pie", 16, "subtitle", "another subtitle", magick::logo, FALSE
#' )
emptyPlot <- function(
  title, chartType = "regular", textLabel, textSize = 14, subtitleOne = "",
  subtitleTwo = "", logo = NULL, border = TRUE
) {

  g <- ggplot2::ggplot() +
    ggplot2::geom_blank() +
    ggplot2::annotate(
      "label", x = 0.5, y = 0.5, label = textLabel, size = textSize,
      label.r = grid::unit(0, "lines"), label.padding = grid::unit(1, "lines")
    ) +
    ggplot2::xlim(c(0, 1)) +
    ggplot2::ylim(c(0, 1)) +
    ggplot2::labs(
      title = title,
      subtitle = paste(subtitleOne, subtitleTwo, sep = "\n")
    )

  if (chartType == "regular") {
    g <- g +
      ggplot2::theme_grey(base_size = 16) +
      ggplot2::theme(
        plot.title = ggplot2::element_text(hjust = 0.5),
        plot.subtitle = ggplot2::element_text(hjust = 0.5, face = "italic"),
        axis.title = ggplot2::element_blank(),
        axis.text = ggplot2::element_blank(),
        axis.ticks = ggplot2::element_blank(),
        panel.background = ggplot2::element_blank(),
        plot.background = ggplot2::element_blank()
      )

    if (!missing(logo)) {
      g <- cowplot::ggdraw() +
        cowplot::draw_image(
          logo, scale = 0.125, hjust = -0.43, vjust = -0.4475, interpolate = TRUE
        ) +
        cowplot::draw_plot(g)
    }

  }
  else if (chartType == "pie") {
    g <- g +
      ggplot2::theme_void(base_size = 16) +
      ggplot2::theme(
        plot.title = ggplot2::element_text(hjust = 0.5),
        plot.subtitle = ggplot2::element_text(hjust = 0.5, face = "italic"),
        panel.background = ggplot2::element_blank(),
        plot.background = ggplot2::element_blank()
      )

    if (!missing(logo)) {
      g <- cowplot::ggdraw() +
        cowplot::draw_image(
          logo, scale = 0.3, hjust = -0.2, vjust = -0.35, interpolate = TRUE
        ) +
        cowplot::draw_plot(g)
    }
  }

  if (border) {
    g <- g + ggplot2::theme(plot.background = ggplot2::element_rect(colour = "black"))
  }

  g

}

#' Truncate Decimal
#' @export
#' @param x numeric
#' @param precision digits
#' @param suffix character vector added to the end of the value
#' @param na.replace na replace value. default is 0.
#' @param tol tolerence
#' @return character vector
#' @examples
#' truncateDecimal(123.123, 2, "%") # returns 123.12%
#' truncateDecimal(123.123, 6, "%") # returns 123.123000%
#' truncateDecimal(2L, suffix = "%") # returns 2%
#' truncateDecimal(NA, suffix = "%")
#' truncateDecimal(NA, suffix = "%", na.replace = "")
truncateDecimal <- function(
  x, precision = 2, suffix = NULL, na.replace = 0, tol = .Machine$double.eps ^ 0.5
) {
  dplyr::case_when(
    is.na(x) & !is.numeric(na.replace) ~ as.character(na.replace),
    is.na(x) ~ paste0(na.replace, suffix),
    abs(x - round(x)) > tol ~
      paste0(formatC(round(x, precision), format = "f", digits = precision), suffix),
    TRUE ~ paste0(x, suffix)
  )
}

#' Table Row Difference
#'
#' CSS styling for Row Difference with colours and signs
#' eg. 18650 <span style="color:green">+113</span>
#'
#' @export
#' @param v a vector of values
#' @param cv a vector of compare values
#' @param rv determines the report value (rv) to display first,
#' eg, 1 is v, 2 is cv
#' @param flipColour default = 0, meaning positive numbers are green.
#' if reverse = 1, negative numbers are green.
#' @param flipSign default = 0, positive values are +,
#' if flipSign = 1 then positive values are -
#' @param signSet default = 1, this uses arrows instead of + / -
#'
#' @examples
#' formattedDifference(v = 3:5, cv = 4, rv = 1, flipColour = 1, flipSign = 1, signSet = 2)
#' formattedDifference(3:5, 4, 1, 1)
#' formattedDifference(3:5, 4, 1, 0)
#' formattedDifference(1:3, 2:3, 1) # errors
#' formattedDifference(2, 1:3, 1, 0)
formattedDifference <- function(
  v, cv, rv = 1, flipColour = 0, flipSign = 0, signSet = 1
) {
  if (!(rv %in% c(1, 2)))
    stop("reportValue must be 1 or 2")
  if (length(v) != length(cv) & length(v) > 1 & length(cv) > 1)
    stop("value and compareValue must have the same length, or either must be length 1")
  signs <- if (signSet == 1) c("&#8593;", "&#8595;") else c("+", "-")
  flipColour <- if (flipColour == 1) -1 else 1
  flipSign <- if (flipSign == 1) -1 else 1
  diffColour <- ifelse(
    sign(v - cv) * flipColour > 0,
    "green",
    "red"
  )
  sign <- dplyr::case_when(
    sign(v - cv) * flipSign > 0 ~ signs[1],
    sign(v - cv) * flipSign < 0 ~ signs[2],
    TRUE ~ NA_character_
  )
  ifelse(
    v == cv,
    v,
    stringr::str_glue(
      '{rv} (<span style="color:{colour};">{sign}{diff}</span>)',
      rv = if (rv == 1) v else cv,
      colour = diffColour,
      sign = sign,
      diff = abs(v - cv)
    )
  )
}

#' Truncate Large Numbers (vectorised)
#'
#' @param n number
#' @param suffix string to concatenate to end. eg units (KG, LB, etc)
#'
#' @return character vector
#' @export
#'
#' @examples
#' truncateLargeN(c(1231516, 123141))
truncateLargeN <- function(n, suffix = NULL) {
  if (!missing(suffix)) suffix <- paste0(" ", suffix)
  dplyr::case_when(
    n >= 1e12 ~ paste0(round(n / 1e12, 4), "T", suffix),
    n >= 1e9 ~ paste0(round(n / 1e9, 3), "B", suffix),
    n >= 1e6 ~ paste0(round(n / 1e6, 2), "M", suffix),
    n >= 1e3 ~ paste0(round(n / 1e3, 1), "K", suffix),
    TRUE ~ as.character(n)
  )
}

#' Not In Operator
#'
#' @param value value to be checked
#' @param set set of values to be checked against
#'
#' @return boolean
#' @export
#'
#' @examples
#' 1 %notin% 1:3
#' 4 %notin% 1:3
`%notin%` <- Negate(`%in%`)


#' Formatter
#'
#' @param x value to be formatted
#' @param precision precision of the numeric, must be
#' @param prefix prefix
#' @param suffix suffix
#' @param na.replace na.replace
#' @param numeric.abbrev numeric.abbrev
#'
#' @return string
#' @export
#'
#' @examples
#' formatter(NA, NA, NA, NA, "")
#' formatter(NA, 0, NA, NA)
#' formatter(123.123, 2, suffix = "%")
#' formatter(1231415161.2, precision = 0, suffix = " kg", numeric.abbrev = TRUE)
#' formatter(c(12.415, 132.141), -1, "$")
#' formatter(c(12.415, 132.141), 3, "$")
#' formatter(c("string", "string2"), na.replace = "")
#' formatter(213151, 2, suffix = NA)
#' formatter(c(NA, 2), 2, "", "%", na.replace = "")
formatter <- function(
  x, precision = 0, prefix = "", suffix = "", na.replace = 0, numeric.abbrev = FALSE
) {
  if (!is.logical(numeric.abbrev) || is.na(numeric.abbrev)) {
    stop("numeric.abbrev must be TRUE or FALSE")
  }
  if (!stringr::str_detect(precision, "^\\d+$")) {
    stop("precision must be an integer")
  } else {
    precision <- as.numeric(precision)
  }

  # handling explicit NA
  prefix <- if (is.na(prefix)) "" else prefix
  suffix <- if (is.na(suffix)) "" else suffix
  na.replace <- if (is.na(na.replace)) 0 else na.replace

  if (all(is.na(x))) {
    rlang::rep_along(x, na.replace)
  }
  else if (all(is.character(x) | is.na(x))) {
    dplyr::if_else(is.na(x), na.replace, x)
  }
  else if (all(is.numeric(x) | is.na(x)) && numeric.abbrev) {
    dplyr::case_when(
      is.na(x) & stringr::str_detect(na.replace, "^\\d+$") ~ paste0(prefix, na.replace, suffix),
      is.na(x) ~ as.character(na.replace),
      x >= 1e12 ~ paste0(prefix, round(x / 1e12, 4), "T", suffix),
      x >= 1e9 ~ paste0(prefix, round(x / 1e9, 3), "B", suffix),
      x >= 1e6 ~ paste0(prefix, round(x / 1e6, 2), "M", suffix),
      x >= 1e3 ~ paste0(prefix, round(x / 1e3, 1), "K", suffix),
      TRUE ~ as.character(x)
    )
  }
  else if (all(is.numeric(x) | is.na(x))) {
    dplyr::case_when(
      is.na(x) & stringr::str_detect(na.replace, "^\\d+$") ~ paste0(prefix, na.replace, suffix),
      is.na(x) ~ as.character(na.replace),
      is.numeric(x) ~ paste0(
        prefix,
        formatC(
          round(x, precision),
          format = "f",
          digits = precision, drop0trailing = TRUE
        ),
        suffix
      ),
      TRUE ~ as.character(x)
    )
  } else {
    as.character(x)
  }

}