Apply function across numeric columns within a formattable call

[GreyMerchant]

Hello,

I have this paddedcolor_bar function set to run in this very specific way to preserve the correct sorting on the output table. I want a way to add the paddedcolor_bar only to numeric columns within the formattable call. How best can I do this?

library(formattable)
library(DT)

paddedcolor_bar <- function(color = "lightgray", fun = "proportion", ...) {
  fun <- match.fun(fun)
  formatter("span",
            style = function(x) style(
              display = "inline-block",
              direction = "rtl",
              "unicode-bidi" = "plaintext",
              "border-radius" = "4px",
              "padding-right" = "2px",
              "background-color" = csscolor(color),
              width = sprintf("%010.4f%%", 100 * percent(fun(as.numeric(x), ...)))
            ))
}






tab <- data.frame(A = 1:26, B = runif(26,0,10), C = letters)
tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical


output_table <-
  as.datatable(
    formattable(tab,
                list("A"  = paddedcolor_bar("lightblue"),
                     "B"  = paddedcolor_bar("lightblue")
                )
                
    )
  )

#output table
output_table

^{Created on 2021-10-15 by the reprex package (v2.0.0)}

[GreyMerchant]

Turned out a lot easier than I expected:

library(formattable)
#> Warning: package 'formattable' was built under R version 4.1.1
library(DT)

paddedcolor_bar <- function(color = "lightgray", fun = "proportion", ...) {
  fun <- match.fun(fun)
  formatter("span",
            style = function(x) style(
              display = "inline-block",
              direction = "rtl",
              "unicode-bidi" = "plaintext",
              "border-radius" = "4px",
              "padding-right" = "2px",
              "background-color" = csscolor(color),
              width = sprintf("%010.4f%%", 100 * percent(fun(as.numeric(x), ...)))
            ))
}

nocolor_bar <- function( fun = "proportion", ...) {
  fun <- match.fun(fun)
  formatter("span",
            style = function(x) style(
              display = "inline-block",
              direction = "rtl",
              "unicode-bidi" = "plaintext",
              "border-radius" = "4px",
              "padding-right" = "2px",
              width = x)
  )
}


tab <- data.frame(A = 1:26, B = runif(26,0,10), C = letters)
tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical


output_table <-
  as.datatable(
    formattable(tab,
                list("A"  = paddedcolor_bar("lightblue"),
                     "B"  = paddedcolor_bar("lightblue")
                )
                
    )
  )

#output table
#output_table

new_output_table <- 
as.datatable(
  formattable(tab,
              lapply(tab,function(x){
                if(is.numeric(x)){
                  x <- paddedcolor_bar("lightblue")
                } else {
                  x <- nocolor_bar()
                }
              })
  )
)

#new table
new_output_table

^{Created on 2021-10-15 by the reprex package (v2.0.0)}