使用 R ShinyDashboard 為 DT 表制作水平滾動條

Question

我正在創建一個有 88 列的表，所以自然我需要一個滾動條，我還想根據它們的值突出顯示一些列變量，但是我的問題是沒有出現水平滾動條。 這是代碼：

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。 任何的意見都將會有幫助。

在任何人推薦此鏈接之前： 如何使水平滾動條在 DT::datatable 中可見
我已經嘗試過他們所說的，似乎沒有幫助。

Answer 1

以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)