Conditional table formatting in RShiny

Question

I am trying to visualize a cohort analysis and wanted to use RenderDataTable in brilliant form to get a visualization where I could select all cells based on a single column with values ​​1/0, with 1 shaded and 0 not shaded.

I tried a couple of things, including trying to use geom_tile in ggplot2 , but that was useless. I also tried to take a look at rpivotTable , but I could not figure out how to shade specific cells.

Sample 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) 

Answer 1

Using 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'))) }) }) 

\

Answer 2

If you want to color the DataTable, you can 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 for colored strings based on your criteria.

Answer 3

This should help you get started creating graphs using 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() 

The rendering of the plot in brilliance should be trivial, and since you have not provided any brilliant code (for example, server or ui), it is difficult to say where you might run into the problem.