如何在閃亮中為側邊欄面板添加滾動條？

Question

我必須在 sidebarPanel 中添加更多滑塊，但是當我向下滾動頁面時，整個頁面與 mainPanel 一起向下滾動。 我真正需要的是，當我向下滾動輸入滑塊並更改滑塊以在 Shiny 中觀察 mainPanel 上的相應輸出時，必須以這種方式鎖定或凍結顯示圖形或輸出的 mainPanel。

下面是ui.R的部分代碼。 這里我只展示了 7 個滑塊，但實際上我有 31 個滑塊。

library(shiny)  
shinyServer(fluidPage(  
  titlePanel("Regression"),  
  sidebarLayout(    
    sidebarPanel(   
      sliderInput("slide1","Select a value:",
                  min=min(unidf$X.17,na.rm = T),max=max(unidf$X.17,na.rm = T), value = median(unidf$X.17,na.rm = T)),  
      sliderInput("slide2","Head HIC-15:",
                  min=min(unidf$X.18,na.rm = T),max=max(unidf$X.18,na.rm = T), value = median(unidf$X.18,na.rm = T)),  
      sliderInput("slide3","Select a value:",
                  min=min(unidf$X.19,na.rm = T),max=max(unidf$X.19,na.rm = T), value = median(unidf$X.19,na.rm = T)),  
      sliderInput("slide4","Select a value:",
                  min=min(unidf$X.20,na.rm = T),max=max(unidf$X.20,na.rm = T), value = median(unidf$X.20,na.rm = T)),  
      sliderInput("slide5","Lateral force (kN):",
                  min=min(unidf$X.21,na.rm = T),max=max(unidf$X.21,na.rm = T), value = median(unidf$X.21,na.rm = T)),  
      sliderInput("slide6","Select a value:",
                  min=min(unidf$X.22,na.rm = T),max=max(unidf$X.22,na.rm = T), value = median(unidf$X.22,na.rm = T)),  
      sliderInput("slide7","Average deflection (mm):",
                  min=min(unidf$X.23,na.rm = T),max=max(unidf$X.23,na.rm = T), value = median(unidf$X.23,na.rm = T))  

    ),  
    mainPanel(...  

Answer 1

我有類似的情況。 這是我的解決方案：

dashboardSidebar(
    tags$head(
      tags$style(HTML("
                      .sidebar { height: 90vh; overflow-y: auto; }
                      " )
      )
    ),
... ...

我希望它可以幫助你。

Answer 2

我確實找到了@cutebunny 在dashboardSideBar 上工作的答案：

library(shiny)

################################ interactive datatable + functional scrollbar
library(shinydashboard)
## ui.R ##
ui <- dashboardPage(
    dashboardHeader(title = "TEST"),
    dashboardSidebar(
        # to add scrollbar
        tags$head(
            tags$style(HTML("
                      .sidebar { height: 90vh; overflow-y: auto; }
                      " )
            )
        ),
        # to fill sideBar
        p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), 
        sidebarMenu(
            menuItem("See data", tabName = "db")
        ),
        radioButtons("rb1", label = "Select data",
                     choices = list("IRIS" = "iris", "CARS" = "cars"),
                     selected = "iris")
    ),
    dashboardBody(
        tabItems(
            tabItem(tabName = "db",
                    h4("Show selected dataset"),
                    fluidRow(DT::dataTableOutput('tbl2'))
            )
        )
    )
)
## server.R ##
library(shiny)
server <- function(input, output, session) {
    output$value <- renderPrint({ input$rb1 })
    data <- reactive({
        switch(input$rb1,
               "iris" = iris,
               cars)
    })
    action <- dataTableAjax(session, cars)
    widget <- datatable(cars,
                        class = 'display cell-border compact',
                        filter = 'top',
                        # server = TRUE,
                        options = list(ajax = list(url = action))
    )
    output$tbl2 <- DT::renderDataTable({
        DT::datatable(data())
    })
}
shinyApp(ui, server)

但是，當使用sidebarLayout()時， tags$head(tags$style(HTML(".sidebar { height: 90vh; overflow-y: auto; }")))對我不起作用，所以我使用了style = "height:80vh; overflow-y: auto;" 反而：

################################ interactive datatable + functional scrollbar
library(shinydashboard)
## ui.R ##
ui <- fluidPage(
    titlePanel("TEST"),
    sidebarLayout(
        sidebarPanel(
        style = "height:90vh; overflow-y: auto;",
            # to fill sideBar
            p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), p("text"), 
            sidebarMenu(
                menuItem("See data", tabName = "db")
            ),
            radioButtons("rb1", label = "Select data",
                         choices = list("IRIS" = "iris", "CARS" = "cars"),
                         selected = "iris")
        ),
        mainPanel(
            DT::dataTableOutput('tbl2')
        )
    )
)
## server.R ##
library(shiny)
server <- function(input, output, session) {
    output$value <- renderPrint({ input$rb1 })
    data <- reactive({
        switch(input$rb1,
               "iris" = iris,
               cars)
    })
    action <- dataTableAjax(session, cars)
    widget <- datatable(cars,
                        class = 'display cell-border compact',
                        filter = 'top',
                        # server = TRUE,
                        options = list(ajax = list(url = action))
    )
    output$tbl2 <- DT::renderDataTable({
        DT::datatable(data())
    })
}
shinyApp(ui, server)

請記住，如果我從上面的代碼中刪除style = "height:80vh; overflow-y: auto;",則會創建整個窗口的滾動條。