Sorting column correctly in renderDataTable call with multi color bars

[GreyMerchant]

Hi!

I have this shiny app that is partially giving me a problem with sorting when I have 2 different coloured bars in the same column. It is partially related to the problem described here: https://github.com/renkun-ken/formattable/issues/92

As you will see if you use the line "background-color" = csscolor(color), instead of the other the sorting will work correctly. However, when we add the different colours it just fails to sort correctly. Any idea how I can change it to get it sort correctly?

library(shiny)
library(shinydashboard)
library(DT)
library(formattable)


custom_color_picker <- function(x){
  
  sapply(x,function(x){
    if(x > 0){
      formattable::csscolor("#B7D1DA", format = "hex")
    } else {
      formattable::csscolor("#D38591", format = "hex")
    }
  }
  )
}

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

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DT::dataTableOutput("tabOut")   
  )
) 

server <- function(input, output) {
  
  output$tabOut <- DT::renderDataTable({
    
    tab <- data.frame(A = -5:20, B = runif(26,0,10), C = letters)
    tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical
    
    as.datatable(
      formattable(tab, 
                  list("A"  = paddedcolor_bar("lightblue"),
                       "B" = formatter("span", x ~ sprintf("%10.2f", x, rank(-x)))))
    )
  })
  
}

shinyApp(ui, server)

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

[nirgrahamuk]

@GreyMerchant

As you will see if you use the line "background-color" = csscolor(color), instead of the other the sorting will work correctly.

I dont see that.. I see the same sort order ?

Anyway, I think its a complicated issue and the best approach may well depend on if you are using clientside or serverside Datatable.

This may give you some insight.
Custom sorting with DT (pierrerebours.com)

[GreyMerchant]

As you will see here when we do descending it fails to have the highest value up top and when you sort it the other way around it does something very strange with the 0 as well.

With just the blue bars the behaviour is as expected or predictable at least. Thanks for the link! I will have a look.

[GreyMerchant]

So this seems to be working with the change to the renderDataTable call. Just need to understand why this specific warning is occuring:

Warning in processWidget(instance) : renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable

library(shiny)
library(shinydashboard)
library(DT)
library(formattable)


custom_color_picker <- function(x){
  
  sapply(x,function(x){
    if(x > 0){
      formattable::csscolor("#B7D1DA", format = "hex")
    } else {
      formattable::csscolor("#D38591", format = "hex")
    }
  }
  )
}

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

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DT::dataTableOutput("tabOut")   
  )
) 

server <- function(input, output) {
  
  output$tabOut <- DT::renderDataTable({
    
    tab <- data.frame(A = -5:20, B = runif(26,0,10), C = letters)
    tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical
    
    as.datatable(
      formattable(tab, 
                  list("A"  = paddedcolor_bar("lightblue"),
                       "B" = formatter("span", x ~ sprintf("%10.2f", x, rank(-x)))))
    )
  }, server = FALSE, plugins = 'natural', options = list(
    columnDefs = list(list(type = "natural", targets = "_all")))
  )
  
}

shinyApp(ui, server)

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