增加有光泽的仪表板边栏的长度

Question

因为我的原始数据集非常大，所以我使用虹膜数据集重新创建了我的问题。我添加了一个'new_var'列，其中包含花朵的描述。我遇到的麻烦是当我从下拉菜单中选择多个输入（> 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) 

Answer 1

有一个css样式的定义，它保持侧栏的向下重叠部分不可见。您只需重写该定义以便页面可以滚动。

围绕所有仪表板元素的“包装”有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)