如何将 DT formatStyle 的输出转换为带有 RShiny 突出显示单元格的数据框

Question

我正在尝试使用 RShiny 根据它们的值为数据框中的特定单元格着色。

我已经成功地使用 DT 库中的 formatStyle 函数突出显示了单元格，但是 formatStyle 的输出格式似乎是一个列表，这是一个问题，因为我现在想向 renderDataTable 添加格式化选项函数（比如滚动条使用scrollX=TRUE）。

是否有某种方法可以将 formatStyle 的输出转换为数据框？

所以这里有一些可重现的示例代码：

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)

以及输出的屏幕截图：

Shiny output table

下面是一些示例代码，由于 formatStyle 输出不是数据帧，因此无法正常工作：

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)

这是我得到的错误：

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

提前致谢

Answer 1

说明colourWeights已经是数据表了。因此，将选项移动到 highlightData 部分将起作用。

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)

如何将 DT formatStyle 的输出转换为带有 RShiny 突出显示单元格的数据框

How to convert the output of DT formatStyle to a data frame with highlighted cells for RShiny

r

shiny

dt