Add background color to DT rows in shiny-CodePudding

I have some code that creates a DT table with radio buttons. On top of that I need to add particular colors to each row. I have been trying to use formatStyle too add a different color to each row but I haven't gotten the syntax correct.

Here is the working code:

library(shiny)
library(DT)

c1 = "This is comment 1"
c2 = "This is comment 2"
c3 = "This is comment 3"
c4 = "This is comment 4"
c5 = "This is comment 5"
comments1 = list(c1,c2,c3,c4,c5)


m1 = matrix(
 as.character(1:5), nrow = 5, ncol = 1, byrow = FALSE,
 dimnames = list(comments1, LETTERS[1])
)
for (i in seq_len(ncol(m1))) {
 m1[, i] = sprintf(
   '<input type="radio" name="%s" value="%s"/>',
   'AValue', m1[,i]
 )
}

callback1 <- c(
 "var LETTERS = ['AValue'];",
 "for(var i=0; i < LETTERS.length;   i){",
 "  var L = LETTERS[i];",
 "  $('input[name='   L   ']').on('click', function(){",
 "    var name = $(this).attr('name');",
 "    var value = $('input[name='   name   ']:checked').val();",
 "    Shiny.setInputValue(name, value);",
 "  });",
 "}"
)



ui <- fluidPage(
   title = 'Radio buttons in a table',
   DT::dataTableOutput('foo1'),
   verbatimTextOutput('sel1'),
)

server <- function(input, output, session) {

   output$foo1 = DT::renderDataTable(
     m1, escape = FALSE, selection = 'none', server = FALSE,
     options = list(dom = 't', paging = FALSE, ordering = FALSE),
     callback = JS(callback1),
   ) 

   output$sel1 = renderPrint({ 
     input[["AValue"]]
   })
}

shinyApp(ui, server)

Here are the some of the different variations of the calls that I have tried.

#formatStyle needs to be called on DT:datatable() 
    #Test adding formatStyle
    output$foo1 <- DT::renderDataTable({
      dat <- datatable(m1, escape = FALSE, selection = 'none', 
        options = list(dom = 't', paging = FALSE, ordering = FALSE))
      callback = JS(callback1)  %>% formatStyle(0, target='row', backgroundColor = styleEqual(3,'red'))
    })

    #Test adding formatStyle
    output$foo1 <- DT::renderDataTable({    
      DT::datatable(m1,escape = FALSE, selection = 'none', 
        options = list(dom = 't', paging = FALSE, ordering = FALSE, callback = JS(callback1))
        %>% formatStyle(0, target='row', backgroundColor = styleEqual(3,'red')))
    })

Any help would be greatly appreciated. Thanks!

CodePudding user response：

You need to pass the table as an argument of the formatStyle. To do that inside the renderDataTable you can use the datatable function.

It seems that your condition to assign a color to a row is not going to match any row. You need to put something that could be in the column. Below is an example where an entire row has a red background when the content in column 0 is equal to "This is comment 3".

  output$foo1 = DT::renderDataTable({
    DT::datatable(
      m1, escape = FALSE, selection = 'none',
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS(callback1)
    ) %>% formatStyle(0, target='row', backgroundColor = styleEqual('This is comment 3','red'))
    }, server = FALSE
  )

CodePudding user response：

Perhaps you can define a new column with row_numbers and assign colors to the rows of interest. You can make the row_num column not visible. Try this

mycolors <- c('green','pink','red','yellow','orange')
  output$foo1 = DT::renderDataTable({
    m2 <- as.data.frame(m1) %>% dplyr::mutate(row_num = 1:n())
    
    datatable( m2, escape = FALSE, 
               selection = 'none', 
               extensions = c("Select", "Buttons"), 
               callback = JS(callback1),  ###   needs double-click to select the radiobutton
               options = list(dom = 't', paging = FALSE, ordering = FALSE,
                              columnDefs = list(list(visible=FALSE, targets=2))
                              )
               )   %>% formatStyle(2, 
                                   target='row',
                                   backgroundColor = styleEqual(c(1:5),mycolors))
      
    }, server = FALSE,
    #callback = JS(callback1)  ###  does not recognize input[["AValue"]]
  )