如何将DT格式的输出转换为具有突出显示的单元格的数据框架

Question

我试图根据其值在数据框中为特定的细胞上色。

我已经设法使用DT库中的格式函数成功地突出了单元格，但是FormatStyle的输出格式似乎是一个列表，这是一个问题，因为我现在想将格式化选项添加到RenderDatabable函数（例如，例如使用scrollx = true）滚动栏。

是否有将输出从格式化到数据框架的某种方法？

因此，这里有一些可重现的示例代码，可以有效：

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输出表

这是一些示例代码，由于格式输出不是一个数据框：

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)

这是我得到的错误：

错误：'数据'必须是二维（例如，数据框架或矩阵

预先感谢

Answer 1

它表明颜色量级已经是数据表。因此，将选项转移到frighightdata部分将起作用。

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)