Color cells in DT::dataTable in Shiny

shiny
1

So I have spent hours looking at different threads on github and stackoverflow and have yet to find the answer. I have a DT::dataTable that I need to color cells (red, white and green of various gradients) based upon the value in the cell. I tried to use formatStyle, but shiny wouldn't recognize the column names to color anything. Below is code that I have gotten to work ( i commented out the formatStyle where I had it in place)

library(DT)
library(shiny)
#define UI dataset viewer application
ui<- fluidPage(
shinyUI(verticalLayout(
#Application title
headerPanel("R.A.M. Results"),
#Sidebar with controls to select a dataset and specify root numbers.
sidebarPanel(
fluidRow(
textInput(inputId = "root",label = NULL ,placeholder = "Enter Root number here"),
helpText(
tags$em("Note: The root number must include all 6 digits e.g. 000107")
)
),
fluidRow( # made check boxes to allow users to view data in multiple ways.
column(
8, checkboxGroupInput(inputId = "mods",label = "Options", choices = c("All Policy Items","Expand Table"),
selected = "All Policy Items", inline = FALSE)
),
column(
4,offset = 8, actionButton(inputId = "go", label = "Update")
)
)
),
mainPanel(
div(DT::dataTableOutput("RAMResults"),
style = "font-size:70%; width:50%")
)
))
)
server <- function(input,output) {
#the eventReactive code is the delayed reaction.
root1 <- eventReactive(input$go, {input$root})
#check <- eventReactive(input$expand, {input$root})
PolSummary <- reactive({
if ("Expand Table" %in% input$mods) {
policyDetails <- reactive({
Policy[Policy$Root == root1(),c(2:9,12:14,17,19,21:23,25:26,29,32,34,36:42)]
}) # IF we want DS number (i.e. 1,2,3) add in column 18
ItemDetails <- reactive({
Item[Item$Root == root1(), c(2:9,25:26,35,46,54,62:63,72,74,83,98,109,120,126:132)]
})
} else if (!"Expand Table" %in% input$mods) {
policyDetails <- reactive({
Policy[Policy$Root == root1(),c(2:9,12:14,21,32,37:40)]
}) # IF we want DS number (i.e. 1,2,3) add in column 18
ItemDetails <- reactive({
Item[Item$Root == root1(), c(2:9,25:26,35,62,109,127:130)]
})
}
# IF we want DS number (i.e. 1,2,3) add in column 47
#the if else statment allows to look at just the policy summary data or look at everything,
#if we remove this keep the rbind line "THIS ONE" only
#(rbind (policyDetails(),ItemDetails(),deparse.level = 1)
if ("All Policy Items" %in% input$mods) {
rbind(policyDetails(),ItemDetails(),deparse.level = 1) #THIS ONE
} else if (!"All Policy Items" %in% input$mods) {
rbind(policyDetails(),deparse.level = 1)
}
})
output$RAMResults <- DT::renderDataTable({
if("Expand Table" %in% input$mods) {
DT::datatable(PolSummary(), rownames = FALSE, extensions = c('Buttons','FixedHeader'), options = list(
lengthMenu = c(10,25,50), pageLength = 50, class = 'cell-border', fixedHeader = TRUE, dom = 'Bfrtip', buttons = list(list(extend = 'colvis', columns = c(7:25)))
) #%>%formatStyle(PolSummary()$LoyCorr, color = 'red', backgroundColor = 'blue', fontWeight = 'bold' )
)
} else if (!"Expand Table" %in% input$mods) {
DT::datatable(PolSummary(), rownames = FALSE, extensions = c('Buttons','FixedHeader'), options = list(
lengthMenu = c(10,25,50), pageLength = 50, class = 'cell-border', fixedHeader = TRUE, dom = 'Bfrtip', buttons = list(list(extend = 'colvis', columns = c(7:16)))
) #%>%formatStyle(PolSummary()$LoyCorr, color = 'red', backgroundColor = 'blue', fontWeight = 'bold' )
)
}
})
}
#run the ui and server in the same tab and be able to save it with unique identifying names.
shinyApp(ui = ui, server = server)

2

So.. I can't run your code because it uses variables that aren't defined. But my guess is that the formatStyles are in the wrong place, applying to the list of options rather than the datatable. Check your parentheses.

Check out the DT docs for examples on how to conditionally style table cells:

Here's one example I've lifted straight from the docs. For a value x, cell color is

  • red if x <= 3.4
  • white if 3.4 < x <= 3.8
  • green if x > 3.8 
library(DT)

datatable(iris) %>% formatStyle(
  'Sepal.Width',
  backgroundColor = styleInterval(c(3.4, 3.8), c('red', 'white', 'green')),
  fontWeight = 'bold'
)

and btw, you can format code like this by wrapping it in backticks. Triple backticks for a code block.

1 Like
3

Another approach would be to use the formattable package which offers a lot of possibilities to format cells in a variety of ways. Once you set up the formatting of the columns, you can convert the final result to a data table and render it with DT. Coloring cells based on values is very much supported among other features. Here's an adaptation of @greg's example:

library(DT)
library(formattable)

iris_new <- formattable(iris, list(
  Sepal.Width = color_tile("red", "green")
))

as.datatable(iris_new)

You can use the package in any R analysis and I'd recommend checking out the data frame vignette to see more capabilities:

https://cran.r-project.org/web/packages/formattable/vignettes/formattable-data-frame.html

1 Like
4

This worked Greg Thanks! I had things in the wrong spot, sorry the tables are restricted info so I couldn't add them but you were a huge help on this.

5

so this is quite intriguing, and I think it has a couple attributes that I would like to implement, question though, in a shiny app would the formattable code go after I create my data table and then before I render it or would I do a %>% after the renderDataTable command? e.g.

server <- function(input,output) {
  root1 <- eventReactive(input$go, {input$root})
  PolSummary <- reactive({
    if ("Expand Table" %in% input$mods) {  
      policyDetails <- reactive({
        Policy[Policy$Root == root1(),c(2:9,12:14,17,19,21:23,25:26,29,32,34,36:42)]
      }) # IF we want DS number (i.e. 1,2,3) add in column 18
      ItemDetails <- reactive({
        Item[Item$Root == root1(), c(2:9,25:26,35,46,54,62:63,72,74,83,98,109,120,126:132)]
      })
    } else if (!"Expand Table" %in% input$mods) {
      policyDetails <- reactive({
        Policy[Policy$Root == root1(),c(2:9,12:14,21,32,37:40)]
      }) # IF we want DS number (i.e. 1,2,3) add in column 18
      ItemDetails <- reactive({
        Item[Item$Root == root1(), c(2:9,25:26,35,62,109,127:130)]
      })
    }
    if ("All Policy Items" %in% input$mods) {
      rbind(policyDetails(),ItemDetails(),deparse.level = 1) #THIS ONE
    } else if (!"All Policy Items" %in% input$mods) {
      rbind(policyDetails(),deparse.level = 1)    
    }
  })

HERE?!?!
or

output$RAMResults  <- DT::renderDataTable({
    if("Expand Table" %in% input$mods) {
      DT::datatable(PolSummary(), rownames = FALSE, extensions = c('Buttons','FixedHeader'), options = list( 
        lengthMenu = c(10,25,50), pageLength = 50, class = 'cell-border', fixedHeader = TRUE, dom = 'Bfrtip', buttons = list(list(extend = 'colvis', columns = c(7:25)))
        ) 
      ) %>%

HERE?!?

6

also what do you mean by back ticks (which key and could you provide me an example) sorry this is my very first post ever.

7

There's also a button (and keyboard shortcut) in the Discourse text editor that looks like </> which you can use to format code as well. Highlight a block of code and click </> to wrap it in ```

9

You should be able to put it within the DT::renderDataTable block. Here's some pseudocode for how I did it in one of my shiny apps:

output$myView <- DT::renderDataTable({

# my_results() is a simple reactive data frame with all columns being numbers ranging from 0 to 1
new_table <- formattable(
  my_results(), 
  lapply(format_list, function(x) color_tile("lightgreen", "green"))
) %>%
as.datatable(., rownames = FALSE)
})
1 Like