Issue with UI side of Shiny app with data table

Question

I am in the process of creating a shiny app for a process at work and am struggling to figure something out on the UI side of the app. I would like to display a data table next to a sidebar menu containing options for the app. The issue is that when I do so, the data table is pushed down below the sidebar panel instead of beside it (see the original data tab).

I found a work around as seen in the suggested tab, but that comes with its own issues. I need to be able to lock the column headers while scrolling through the app and when the data table is inside the box element, I am unable to find a way to do so.

Here is the code to a simplified version of the app.

library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)


ui<- dashboardPage(
  #this gives you the name displayed on the tab
  dashboardHeader(title = "HHS Resin Purchasing 0.99"),
  #this gives you your sidebar (page) options
  dashboardSidebar(
    sidebarMenu(
      menuItem("Original Data", tabName = "original"),
      menuItem("Suggested", tabName = "suggested")
    )
  ),
  #this is the body of the webpages
  dashboardBody(
    #this gives you the body options that are displayed on every page
    sidebarPanel(width = 2,
                 h2("Menu Options"),
                 h4(strong("Upload Data:")),
                 fileInput("file", "Data", buttonLabel = "Upload..."),
                 textInput("delim", "Delimiter (leave blank to guess)", ""),
                 numericInput("skip", "Rows to skip", 0, min = 0),
                 h4(strong("User Options:")),
                 selectInput("plant", "Select a Plant", choices = 
                               c("All")),
                 dateInput("latest_date", "Select the latest W_LEAD date in the data",
                           value = Sys.Date()),
                 numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
                 h4(strong("Download Options:")),
                 actionButton("complete_orders", "Analysis for plant orders complete"),
                 actionButton("complete_checks", "Mid month check complete"),
                 downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
                 downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
                 downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
                 
    ),
    #This is the actual data that fills those page options listed above
    tabItems(
      tabItem(tabName = "original",
              DT::dataTableOutput(outputId = "preview1")
      ),
      tabItem(tabName = "suggested",
              box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
                  solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
      )
    )
  )
)

server <- function(input, output) {
  
  output$preview1 <- renderDataTable({
    DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
  })
  
  output$preview2 <- renderDataTable({
    DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
  })
}

shinyApp(ui, server)

Help in fixing either of the issues outlined above would be very appreciated! Thanks in advance.

score 2 · Accepted Answer · answered May 06 '21 at 15:11

I think using the column() function will support your first question of the datatable moving under the sidebar sidebarPanel. Please see example below.

I think the second request of freezing the row header in the datatable can be resolved with the advice found at Freezing header and first column using data.table in Shiny

library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)


ui<- dashboardPage(
  #this gives you the name displayed on the tab
  dashboardHeader(title = "HHS Resin Purchasing 0.99"),
  #this gives you your sidebar (page) options
  dashboardSidebar(
    sidebarMenu(
      menuItem("Original Data", tabName = "original"),
      menuItem("Suggested", tabName = "suggested")
    )
  ),
  #this is the body of the webpages
  dashboardBody(
    #this gives you the body options that are displayed on every page
    fluidRow(
      column(width = 2,
    sidebarPanel(width = 2,
                 h2("Menu Options"),
                 h4(strong("Upload Data:")),
                 fileInput("file", "Data", buttonLabel = "Upload..."),
                 textInput("delim", "Delimiter (leave blank to guess)", ""),
                 numericInput("skip", "Rows to skip", 0, min = 0),
                 h4(strong("User Options:")),
                 selectInput("plant", "Select a Plant", choices =
                               c("All")),
                 dateInput("latest_date", "Select the latest W_LEAD date in the data",
                           value = Sys.Date()),
                 numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
                 h4(strong("Download Options:")),
                 actionButton("complete_orders", "Analysis for plant orders complete"),
                 actionButton("complete_checks", "Mid month check complete"),
                 downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
                 downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
                 downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
)
    ),
    #This is the actual data that fills those page options listed above
column(width = 6,   
 tabItems(
      tabItem(
              tabName = "original",
              DT::dataTableOutput("preview1",
                                  options = list(dom = 't', 
                                                 scrollX = TRUE, 
                                                 paging=FALSE,
                                                 fixedHeader=TRUE,
                                                 fixedColumns = list(leftColumns = 1, rightColumns = 0)))
      ),
      tabItem(tabName = "suggested",
              box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
                  solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
      )
    )
)
)
  )
)

server <- function(input, output) {
  
  output$preview1 <- renderDataTable({
    DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
                      
  })
    
    output$preview2 <- renderDataTable({
      DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
    })
}

shinyApp(ui, server)

Issue with UI side of Shiny app with data table

1 Answers1