Conditional formatting of a table in RShiny

Question

I'm trying to visualize a cohort analysis, and wanted to use RenderDataTable in shiny to get this sort of a visualization where I would be able to highlight all the cells based on a separate column having values 1/0, with 1 being shaded and 0 not being shaded.

I Tried a couple of things, including trying to use geom_tile in ggplot2, but it was of no avail. I also tried looking at rpivotTable, but I wasn't able to figure out how to shade certain cells.

Example Data:

df <- "
cohort  wk  value   flag
1   1   24  0
1   2   12  0
1   3   10  0
1   4   5   0
1   5   2   0
2   1   75  0
2   2   43  1
2   3   11  0
2   4   14  0
3   1   97  0
3   2   35  0
3   3   12  1
4   1   9   0
4   2   4   0
5   1   5   0"

df <- read.table(text = df, header = TRUE)

Can you provide an minimum [reproducible example](http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example)? Your example image doesn't have a 0/1 column and it has cells shaded, not rows. Does it really represent your expected output? — Molx, Aug 08 '15 at 04:59
@Karthikg the best is to use DT (using the datatables JS library). It allows to use conditional formatting. — Enzo, Aug 21 '15 at 09:51

score 8 · Answer 1 · answered Nov 03 '15 at 21:22

With the DT-package:

# global.R

library(shiny)
library(DT)

sketch = htmltools::withTags(table(
  class = 'display',
    thead(
       tr(
         th(rowspan = 2, ''),
         th(rowspan = 2, 'Cohort'),
         th(colspan = 10, 'Wk')
       ),
       tr(lapply(paste(c('', 'f'), rep(1:5, each=2), sep=''), th))
    )
))

# ui.R

shinyUI( fluidPage( DT::dataTableOutput(outputId="table") ) )

# server.R

shinyServer(function(input, output, session) {
    output$table <- DT::renderDataTable({
        df$flag <- as.factor(df$flag)
        x <-  reshape(df, timevar = 'wk', sep = '_', direction = 'wide',idvar ='cohort')
        row.names(x) <- NULL
        colnames(x)[-1] <- paste(c('', 'f'), rep(1:5, each = 2), sep = '')
        datatable(x, rownames = T, container = sketch,
          options = list(dom = 'C<"clear">rti', pageLength = -1,
                         columnDefs = list(list(visible = F, targets = c(3,5,7,9,11))))
    )%>%
       formatStyle('1', 'f1', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('2', 'f2', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('3', 'f3', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('4', 'f4', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('5', 'f5', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) 
    })  
})

\

No disrespect to this answer that some user seem to have enjoyed, and got abounty too, but some additional explanations or comments would be nice, I've been staring at this for the last 5 to 10 min and I have no idea what's going on here. — moodymudskipper, Feb 06 '20 at 17:21
@Moody_Mudskipper Hi, it's been a while but I'm pretty sure I didn't explain much because everything I used from `DT` is well explained at its [website](https://rstudio.github.io/DT/). But if you have any particular doubts I can try answering them. — user5029763, Feb 06 '20 at 19:16
Thanks for the quick reaction, I have indeed meanwhile found what I needed on this website! Well worth checking as much more telling that the help files of the package! — moodymudskipper, Feb 06 '20 at 19:50

score 3 · Answer 2 · answered Oct 29 '15 at 21:38

If you want to color a DataTable you could do it like this:

require(plyr)

# Create matrix
m.val <- max(unlist(lapply(unique(df$cohort),function(ch){ length(which(df$cohort==ch)) })))
cohort.df <-  do.call(rbind, lapply(unique(df$cohort),function(ch){ 
  v <- df$value[which(df$cohort==ch)]
  c(v,rep(NA,m.val-length(v))) 
  }))

ui <- fluidPage(
  tags$head(
    tags$script(
      HTML("
        Shiny.addCustomMessageHandler ('colorTbl',function (message) {
          console.log(message.row);
          var row = parseInt(message.row); var col = parseInt(message.col);
          $('#tbl').find('tbody').find('tr').eq(row).find('td').eq(col).css('background',message.color);
        });
           ")
    )
  ),
  dataTableOutput("tbl")
)

color <- "#6CAEC4"
server <- function(input, output, session) {
  colorTbl <- function(){
    # Get rows we want to color
    sel.d <- df[df$flag==1,]
    for(i in 1:nrow(sel.d)){
      row <- as.numeric(sel.d[i,sel.d$cohort]) -1
      col <- as.numeric(sel.d[i,sel.d$wk]) - 1
      session$sendCustomMessage(type = 'colorTbl', message = list(row=row,col=col,color=color))
    }
  }

  output$tbl <- renderDataTable({
    # Wait until table is rendered, then color
    reactiveTimer(200,{colorTbl()})
    as.data.frame(cohort.df)
  })
}

runApp(shinyApp(ui,server))

Here I use jQuery to color the rows based on your criterion.

JasonAizkalns · Answer 3 · 2015-10-28T20:15:26.820

This should get you started in creating the plot with ggplot2:

library(ggplot2)

ggplot(df, aes(x = wk, y = cohort, fill = factor(flag))) + 
  geom_tile(color = "white") +
  geom_text(aes(label = value), color = "white") +
  scale_y_reverse()

Rendering the plot in shiny should be trivial and since you have not provided any shiny code (e.g. server or ui), it's difficult to say where you could be experiencing a problem.

Conditional formatting of a table in RShiny

3 Answers3

Linked