Search code examples
rshinyscrollbarshinydashboarddt

Make a Horizontal scrollbar with R ShinyDashboard for DT table


I'm creating a table that has 88 columns, so naturally I'd require a scrollbar, I'd also like to highlight some column variables depending on their values, however my issue is that no horizontal scrollbar appears. This is the code:

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)

I have the global setting for DT.options saying that scrollX should be on, but no horizontal taskbar comes up.... If it matters, I'm using windows. Any suggestions would be helpful.

Before anyone recommends this link: How to make the horizontal scrollbar visible in DT::datatable
I've already tried what theyre saying, did not seem to help.


Solution

  • Using mtcars as example this works for me to get a horizontal scroll bar.

    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)
    

    enter image description here