I am trying to colour specific cells in a data frame with RShiny, based on their values.

I have managed to highlight the cells successfully using the formatStyle function from the DT library, however the output format of formatStyle appears to be a list, which is a problem since I would now like to add formatting options to the renderDataTable function (such as the scroll bar using scrollX=TRUE).

Is there someway of transforming the output from formatStyle to a data frame?

So here is some reproducible example code which works:

library(shiny)
library(reticulate)
library(DT)

ui <- fluidPage(
mainPanel(

# first header title 
h3("MTCars"),

# prepare the first output table
DT::dataTableOutput('table1'),
)
)

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

myData <- mtcars

myData$wheelDiameter <- myData$wt
myData$windscreenHeight <- myData$mpg
myData$carTint <- myData$vs
myData$color <- rep(c("red","black","green","yellow"),4)

colourWeights <- reactive({

highlightData <- datatable(myData) %>% formatStyle(
  'wt',
  backgroundColor = styleInterval(c(1.5,3.0), c("red","yellow","green")),
  fontWeight = 'bold'
)
return(highlightData)
})

# display the first output table
output$table1 <- DT::renderDataTable({
colourWeights()


})
}

shinyApp(ui, server)

And a screen shot of the output:

Shiny output table

And here is some example code which doesn't work since the formatStyle output is not a dataframe:

library(shiny)
library(reticulate)
library(DT)

ui <- fluidPage(
mainPanel(

# first header title 
h3("MTCars"),

# prepare the first output table
DT::dataTableOutput('table1'),
)
)

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

myData <- mtcars

myData$wheelDiameter <- myData$wt
myData$windscreenHeight <- myData$mpg
myData$carTint <- myData$vs
myData$color <- rep(c("red","black","green","yellow"),4)

colourWeights <- reactive({
  
  highlightData <- datatable(myData) %>% formatStyle(
    'wt',
    backgroundColor = styleInterval(c(1.5,3.0), c("red","yellow","green")),
    fontWeight = 'bold'
  )
  return(highlightData)
})

# display the first output table
output$table1 <- DT::renderDataTable({
  datatable(colourWeights(),
  options = list(
  scrollX = TRUE,
  autoWidth = FALSE,
  dom = 'Blrtip'
  )
  )
})
}

shinyApp(ui, server)

This is the error I get:

Error: 'data' must be 2-dimensional (e.g. data frame or matrix

Thanks in advance

CodePudding user response：

It shows that colourWeights is already a datatable. Thus, moving the options to the highlightData part will work.

library(shiny)
library(reticulate)
library(DT)

ui <- fluidPage(
  mainPanel(
    
    # first header title 
    h3("MTCars"),
    
    # prepare the first output table
    DT::dataTableOutput('table1'),
  )
)

server <- function(input, output, session) {
  
  myData <- mtcars
  
  myData$wheelDiameter <- myData$wt
  myData$windscreenHeight <- myData$mpg
  myData$carTint <- myData$vs
  myData$color <- rep(c("red","black","green","yellow"),4)
  
  colourWeights <- reactive({
    
    highlightData <- datatable(myData,
                               options = list(
                                 scrollX = TRUE,
                                 autoWidth = FALSE,
                                 dom = 'Blrtip'
                               )) %>% formatStyle(
      'wt',
      backgroundColor = styleInterval(c(1.5,3.0), c("red","yellow","green")),
      fontWeight = 'bold'
    )
    return(highlightData)
  })
  
  # display the first output table
  output$table1 <- DT::renderDataTable({
    colourWeights()

  })
}

shinyApp(ui, server)