使用 R ShinyDashboard 为 DT 制作水平滚动条 table

Make a Horizontal scrollbar with R ShinyDashboard for DT table

我正在创建一个有 88 列的 table,所以我自然需要一个滚动条,我还想根据它们的值突出显示一些列变量,但是我的问题是没有出现水平滚动条。这是代码:

library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- read.csv("somedata.csv", check.names = FALSE)
options(DT.options = list(pageLength = 5), scrollX = TRUE)
ui <- dashboardPage(
  dashboardHeader(title = "Table Summary"),
  dashboardSidebar(collapsed = FALSE,
                  sidebarMenu(
                    id = "tabs",
                    menuItem(text = "Tab 1",
                             tabName = "t1",
                             icon = icon('trophy'),
                             selected = TRUE
                    )
                  )
  ),
  dashboardBody(
    shinyjs::useShinyjs(),
    tabItems(
      tabItem(
        tabName = "t1",
        #we wan to create 3 separate pages on this tab
        tabsetPanel(
          id = "t1Selected", #returns value of current page we're on,
          type = "tabs",
          tabPanel(
            title = "totals",
            id = "tab_totals",
            fluidRow(
              column(width = 6, align = "right", DT::dataTableOutput("table"))
              #DT::dataTableOutput("table")
            ),
            fluidRow(
              column(
                width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
              ),
              column(
                width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
              ),
              column(
                width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
              ),
              column(
                width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
              ),
              
            )
          )
        )
      )
      
      
    )
  )
  
)
server <- function(input, output, session) {
  observe({
    shinyjs::enable("bt1C")
    if(input$bt1 == 0){
      shinyjs::disable("bt1C")
    }
    
  })
  output$table <- DT::renderDataTable({
    datatable(data) %>% formatStyle('Message_ratio', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
    
  })
  
}
shinyApp(ui, server)

我有 DT.options 的全局设置说 scrollX 应该打开,但没有出现水平任务栏.... 如果重要的话,我正在使用 windows。 任何建议都会有所帮助。

在有人推荐这个之前link:
我已经尝试过他们所说的,似乎没有帮助。

mtcars 为例,这对我来说很有效,可以获得水平滚动条。

library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)

data <- mtcars
ui <- dashboardPage(
  dashboardHeader(title = "Table Summary"),
  dashboardSidebar(collapsed = FALSE,
                   sidebarMenu(
                     id = "tabs",
                     menuItem(text = "Tab 1",
                              tabName = "t1",
                              icon = icon('trophy'),
                              selected = TRUE
                     )
                   )
  ),
  dashboardBody(
    shinyjs::useShinyjs(),
    tabItems(
      tabItem(
        tabName = "t1",
        #we wan to create 3 separate pages on this tab
        tabsetPanel(
          id = "t1Selected", #returns value of current page we're on,
          type = "tabs",
          tabPanel(
            title = "totals",
            id = "tab_totals",
            fluidRow(
              column(width = 6, align = "right", DT::dataTableOutput("table"))
              #DT::dataTableOutput("table")
            ),
            fluidRow(
              column(
                width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
              ),
              column(
                width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
              ),
              column(
                width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
              ),
              column(
                width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
              ),
              
            )
          )
        )
      )
      
      
    )
  )
  
)
server <- function(input, output, session) {
  observe({
    shinyjs::enable("bt1C")
    if(input$bt1 == 0){
      shinyjs::disable("bt1C")
    }
    
  })
  output$table <- DT::renderDataTable({
    datatable(data, options = list(scrollX = TRUE)) %>% 
      formatStyle('mpg', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
  })
  
}
shinyApp(ui, server)