table formatting helper functions

table_helpers.R

sprintcol <- function(x, sig.digits = 3) {
  rounded <- paste(signif(x, sig.digits))
  max.decimal <-
    str_extract(rounded, "\\.(\\d+)") %>%
    str_length() %>%
    max(c(0, .), na.rm = T) - 1
  max.decimal <- max(max.decimal, min(abs(max.decimal), 0))
  sprintf(fmt = glue::glue("%.{max.decimal}f"), x)
}

sprintrows <- function(df, sig.digits = 3) {
  cols <- purrr::map(df, is_double) %>% unlist()
  dfss <- df[cols]
  dfss.proc <- dfss %>%
    t() %>%
    as_tibble() %>%
    mutate_all(.funs = funs(sprintcol), sig.digits = sig.digits) %>%
    t() %>%
    as.tibble() %>%
    setNames(names(dfss))
  
  df[cols] <- dfss.proc
  df
}

# example <- tribble(
#   ~A, ~B,
#   1992, 1990,
#   12.12232, 1.232,
#   12.22, 12
# )
# 
# example %>%
#   mutate_if(is.numeric, funs(sprintcol))
# 
# example %>%
#   sprintrows(sig.digits = 2)
# 
# example %>%
#   sprintrows(sig.digits = 3)
# 
# example %>%
#   sprintrows(sig.digits = 4)