增加闪亮仪表板侧边栏的长度

Increase length of the shiny dashboard sidebar

因为我的原始数据集非常庞大,所以我使用 iris 数据集重新创建了我的问题。我添加了一个列 'new_var',其中包含对鲜花的描述。我遇到的问题是当我从下拉菜单中 select 多个输入(> 3)时,边栏的长度没有得到调整以显示下拉菜单中的剩余值。

我试过增加侧边栏的长度,但没有用。我试过用 fluidPage 包裹 dashboardSidebar,也没用。

我真正想要的是侧边栏的长度是否可以动态调整以便我可以滚动查看所有值或提供垂直滚动条。谢谢

library(datasets)
library(shiny)
library(shinydashboard)
library(DT)

data(iris)
x <- c("Small flowers","Flowers (or heads) borne singly on isolated stems or arising individually from leaf axils. Not part of a larger group.", "A simple, indeterminate inflorescence consisting of stalked flowers attached to a central stem and forming a more or less elongated cluster. The stalk of a flower is termed a pedicle and pedicled flowers are implied by the term raceme when used alone in the specific sense. ", "An indeterminate inflorescence consisting of stalkless flowers attached to a central stem, generally forming a highly elongated cluster. A raceme of stalkless flowers. ", "An indeterminate inflorescence forming a convex or flat-topped cluster, essentially a contracted raceme. Typically flowers arise from a central axis on stalks (pedicles) of different lengths that bring them all to near the same height. The term is also applied to racemes of similar shape with branching pedicles. The outermost flowers generally open first. ")
iris$new_var <- rep(x, each = 30)


ui <- 
  dashboardPage(
    dashboardHeader(title = strong("DATA LOADER"),titleWidth = 240),
    dashboardSidebar(

      sidebarMenu(
        selectizeInput("newvar", "Choose type of flower:", choices = sort(unique(iris$new_var)), multiple = TRUE)

      )
    ),
    dashboardBody(
      fluidRow(
        dataTableOutput("df"),
        br()
      )))

server <- function(input, output){
  output$df <- renderDataTable(reactive({
    iris[iris$new_var %in% input$newvar, ]
  })())
}
shinyApp(ui, server)

有一个 css 样式定义,使侧边栏的向下重叠部分不可见。您只需重写该定义即可使页面可滚动。

所有仪表板元素周围的 "wrapper" 都有 overflow: hidden !important,显然是为了让它看起来更像一个真正的仪表板而不是网页。奇怪的是,由于 dashboardBody 本身是可滚动的,这只会影响侧边栏的可见性。

我在 head 标签内写了样式定义。这样,这个定义放在 ui 中的什么位置都没有关系,因为它将被附加到 HTML 头部。

如果这不能解决您的问题,请发表评论。

代码如下:

library(datasets)
library(shiny)
library(shinydashboard)
library(DT)

data(iris)
x <- c("Small flowers", "Flowers (or heads) borne singly on isolated stems or arising individually from leaf axils. Not part of a larger group.", "A simple, indeterminate inflorescence consisting of stalked flowers attached to a central stem and forming a more or less elongated cluster. The stalk of a flower is termed a pedicle and pedicled flowers are implied by the term raceme when used alone in the specific sense. ", "An indeterminate inflorescence consisting of stalkless flowers attached to a central stem, generally forming a highly elongated cluster. A raceme of stalkless flowers. ", "An indeterminate inflorescence forming a convex or flat-topped cluster, essentially a contracted raceme. Typically flowers arise from a central axis on stalks (pedicles) of different lengths that bring them all to near the same height. The term is also applied to racemes of similar shape with branching pedicles. The outermost flowers generally open first. ")
iris$new_var <- rep(x, each = 30)

ui <- 
  dashboardPage(
    dashboardHeader(title = strong("DATA LOADER"),titleWidth = 240),
    dashboardSidebar(
      tags$head(tags$style(".wrapper {overflow: visible !important;}")),
      sidebarMenu(
        selectizeInput("newvar", "Choose type of flower:", choices = sort(unique(iris$new_var)), multiple = TRUE)

      )
    ),
    dashboardBody(
      fluidRow(
        dataTableOutput("df"),
        br()
      )))

server <- function(input, output){
  output$df <- renderDataTable(reactive({
    iris[iris$new_var %in% input$newvar, ]
  })())
}
shinyApp(ui, server)