How can I set a gradient color shade in DT::datable colums?

Question

I've got a shiny App where I want to fill numeric column spaces of a matrix output with different colors from low to high according each row value (all of them but 'topic'). I saw in this link a way to color spaces with color = styleInterval() but I can't figure out a way to fit different colors for each column by topic (taking into account that they won't necesarilly be the same number of topics each time, but they won't ever be more than 15 topics for sure & of course numbers of each column will vary). Important to mention that I want the same colors for each one of those other 3 numeric columns, gradient according to respective values. Could somebody please tell me the way?

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
  )

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
# COLOR TABLE BY TOPIC

bytopic <- NULL

output$topic_info_table <- DT::renderDataTable({

  bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                        "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                        "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                        "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                        "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                        "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                        "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                        "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                          c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                            "12", "13"), c("topic", "year", "expiration", "cost")))

  DT::datatable(bytopic, options = list(pageLength = 15)) %>% formatCurrency(c('cost')) 
}) 
}
shinyApp(ui,server)

Idea would be getting something like: Easily done with Excel's conditional formating where you format cells based on their values. In the example I used the clearest green shade for minimum value to the darkest blue shade for the maximum. Hopefully with a legend that says something like Lowest -> Highest with the color gradient.

If I understand correctly, you want to color rows (except ```topic```) according to the value of ```topic```, right? — bretauv, Jan 11 '20 at 10:28
Yes, different colors for each row *according to the column values from low to high*. I mean, could be numbers from 0 to 13 in `cost`, where 0 is white and it starts going stronger until 13 being dark blue and same shades are fit in the other 2 columns. But it must generic code because they will be different every time. — MelaniaCB, Jan 11 '20 at 14:33
I don't get it, do you want the color to depend on the value in the ```topic``` column or in the ```cost``` column? Can you add the expected output in your post (like an image of your expected table on Excel maybe)? — bretauv, Jan 11 '20 at 14:43

bretauv · Answer 1 · 2020-01-12T22:54:09.117

Here's a solution.

Basically, I used this code to make a function that creates a range of color (placed before the ui since it only has to run once and does not need to be reloaded with the inputs):

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

Then, as your data was a matrix, I transformed it in a dataframe and then unfactored the columns to have them in numeric (thanks to the function unfactor, from the varhandle package):

bytopic <- as.data.frame(bytopic)
bytopic <- unfactor(bytopic)

Finally, I used these examples to color the columns according to their values (only the column year in the chunk below):

formatStyle("year", 
            backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                              decreasing = TRUE),
                                          colfunc(length(unique(bytopic$year)))
                                         )
            )

The problem is I couldn't put that chunk in a function (maybe it is easy to do so but I didn't succeed in it) so you have to repeat this code for every column you want to color (hopefully you don't have many). This is not ideal but at least it is a working basis.

Here's the complete code:

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

# Additional package
if("varhandle" %in% rownames(installed.packages()) == FALSE){ install.packages("varhandle") }
library(varhandle)


#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
)

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
  # COLOR TABLE BY TOPIC

  bytopic <- NULL

  output$topic_info_table <- DT::renderDataTable({

    bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                           "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                           "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                           "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                           "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                           "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                           "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                           "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                             c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                               "12", "13"), c("topic", "year", "expiration", "cost")))

    bytopic <- as.data.frame(bytopic)
    bytopic <- unfactor(bytopic)

    DT::datatable(bytopic, options = list(pageLength = 15)) %>% 
      formatCurrency(c('cost')) %>%
      formatStyle("year", 
                  backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$year)))
                                               )
      ) %>%
      formatStyle("expiration", 
                  backgroundColor = styleEqual(sort(unique(bytopic$expiration), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$expiration)))
                  )
      ) %>%
      formatStyle("cost", 
                  backgroundColor = styleEqual(sort(unique(bytopic$cost), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$cost)))
                  )
      ) 
  }) 
}
shinyApp(ui,server)

RivetPanda · Accepted Answer · 2022-10-20T21:46:36.003

To expand on bretauv's answer above, the following code is a function that will apply a color gradient to a single column.

color_gradient <- function(dt, column_name, gradient_colors = c("#6666FF", "#DDDDDD", "#FF6666")) {
    col_func <- colorRampPalette(gradient_colors)
    dt %>% 
        formatStyle(column_name, 
                    backgroundColor = styleEqual(
                        sort(unique(dt$x$data[[column_name]]), decreasing = TRUE),
                        col_func(length(unique(dt$x$data[[column_name]])))
                    )
        ) 
}

It can be used like so:

DT::datatable(bytopic, options = list(pageLength = 15)) %>% 
  formatCurrency(c('cost')) %>%
  color_gradient("year") %>% 
  color_gradient("expiration") %>% 
  color_gradient("cost", c("#66FF66", "#DDDDDD"))

How can I set a gradient color shade in DT::datable colums?

2 Answers2