How To Change Datatable Row Background Colour Based On The Condition In A Column, Rshiny

I have a real-time log file running, that listens to the database and renders a datatable of the most recent updates on top. However after spending sometime on it im stuck on how t

Solution 1:

You can add a custom message which you can call using the session$onFlushed method. To keep the example succinct I have removed formatting and extra tabs. First the script and call to shiny. Notuce we equate to " Pass " rather then "Pass" etc. as xtable seems to add extra spacing:

library(shiny)
options(digits.secs=3) 
script <- "
els = $('#logs tbody tr td:nth-child(2)');
console.log(els.length);
els.each(function() {
          var cellValue = $(this).text();
          if (cellValue == \" Pass \") {
            $(this).parent().css('background-color', 'green');
          }
          else if (cellValue == \" Aggr \") {
            $(this).parent().css('background-color', 'red');
          }
          else if (cellValue == \" Bad \") {
            $(this).parent().css('background-color', 'grey');
          }
        });"
test_table <- cbind(rep(as.character(Sys.time()),2),rep('a',2),rep('b',2),rep('b',2),rep('c',2),rep('c',2),rep('d',2),rep('d',2),rep('e',2),rep('e',2))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")

and the app

ui =navbarPage(inverse=TRUE,title = "Real-Time Logs",
               tabPanel("Logs",icon = icon("bell"),
                        mainPanel(
                          htmlOutput("logs"))
                        , tags$script(sprintf('
                          Shiny.addCustomMessageHandler("myCallback",
                            function(message) {
                                 %s
                            });
                          ', script)
                        )
                        )
)
server <- (function(input, output, session) {
  autoInvalidate1 <- reactiveTimer(3000,session)
  my_test_table <- reactive({
    autoInvalidate1()
    other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),  
                        (c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
    test_table <<- rbind(apply(other_data, 2, rev),test_table)
    session$onFlushed(function(){
      session$sendCustomMessage(type = "myCallback", "some message")
    })
    as.data.frame(test_table) 
  })
  output$logs <- renderTable({my_test_table()},include.rownames=FALSE)
})

runApp(list(ui = ui, server = server))

When you add back in the formatting and extra tabs it looks like: