Shiny中VisNetwork设高度后与dashboardSidebar底部重叠问题求助

问题原因 #

• shinydashboard的.main-sidebar元素默认背景会延伸至页面底部，当主内容区域高度远超过侧边栏内容高度时，侧边栏背景会横向铺满底部区域，造成视觉上的异常延伸。
• 在visOptions中直接设置height会脱离dashboard布局结构，导致VisNetwork容器高度溢出时与侧边栏重叠。

解决方案 #

1. 调整VisNetwork的高度设置 #

将VisNetwork的高度定义从visOptions转移到visNetworkOutput控件上，确保容器高度正确嵌入dashboard布局体系：

visNetworkOutput("network", height = "1800px")

同时移除visOptions中的height = "1800"参数。

2. 修复侧边栏底部横向延伸问题 #

添加自定义CSS，限制侧边栏背景仅覆盖自身内容区域，同时允许侧边栏内容过长时纵向滚动：

.main-sidebar {
  overflow-y: auto;
  position: fixed;
  height: 100vh;
}
.content-wrapper {
  margin-left: 220px; /* 与侧边栏width参数值保持一致 */
  min-height: 100vh;
}
.wrapper {
  overflow-x: hidden;
}

修改后的完整代码 #

library(shiny)
library(visNetwork)
library(shinydashboard)

# User interface
ui <- dashboardPage(
  dashboardHeader(title = "Network", titleWidth = 220),
  
  ## Sidebar content
  dashboardSidebar(width = 220,
                   sidebarUserPanel(name = "CTU",image = "unibe_logo_mh.png"), 
                   sidebarMenu(id = "tab",
                               menuItem('CTU Division',
                                        menuSubItem("Data Management", tabName = "datamanagement", icon = icon("database")),
                                        menuSubItem("Statistics", tabName = "statistics", icon = icon("chart-area")),
                                        menuSubItem("Clinical Study Management", tabName = "studymanagement", icon = icon("laptop-medical")),
                                        menuSubItem("Monitoring", tabName = "monitoring", icon = icon("check")), # Would like to use the "magnifying-glass"
                                        menuItem("Quality Management", tabName = "qualitymanagement", icon = icon("broom"))),
                               radioButtons("projectlab", label = "Project labels", choices = c("IDs", "Names"), inline=T),
                               selectInput("servicetype", label = "Service", choices = c("\a", "Basic", "Full", "Light")),
                               checkboxGroupInput('projecttype', "Project types", c("External", "Consulting","Internal","FTE"), selected = "External"), 
                               selectInput("dlfsupport", label = "DLF support", choices = c("\a", "Yes", "No")),
                               selectInput("cdms", label = "CDMS", choices = c("\a","REDCap", "secuTrial", "Webspirit")),
                               checkboxGroupInput('tables', "Export tables", c("Time Bookings","Workers","Projects"), selected = c("Time Bookings","Workers","Projects")), 
                               downloadButton("DownloadReport", "Download Report", style = "margin: 5px 5px 35px 35px; "))), 
  
  ## Body content
  dashboardBody(
    tags$head(tags$style(HTML("
      .main-sidebar {
        font-size: 15px;
        overflow-y: auto;
        position: fixed;
        height: 100vh;
      }
      .content-wrapper {
        margin-left: 220px;
        min-height: 100vh;
      }
      .wrapper {
        overflow-x: hidden;
      }
    "))),
    fluidRow(
      visNetworkOutput("network", height = "1800px") # 在此处设置VisNetwork高度
    ))
)

server <- function(input, output, session) {
  getDiagramPlot <- function(nodes, edges){
    v <- visNetwork(
      nodes, 
      edges
    ) %>%
      visPhysics(stabilization = TRUE, enabled = F) %>%
      visOptions(highlightNearest = T, nodesIdSelection = T, selectedBy= list(variable="group",multiple=T)) %>% # 移除原height参数
      visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
      visLayout(improvedLayout = TRUE) %>%
      visEdges(arrows = edges$arrows) %>%
      visInteraction(multiselect = F) %>%
      visEvents(doubleClick = "function(nodes) {
            Shiny.onInputChange('current_node_id', nodes.nodes);
            ;}")
    return(v)
  }
  
  testFunction <- function(node_id){
    print(paste("The selected node ID is:", node_id))
  }
  
  nodes <- data.frame(id = 1:3, label = 1:3, group = c("group1","group1","group2"), value = c(10,10,11), color=c("#E41A1C","#48A462","#4A72A6"))
  edges <- data.frame(from = c(1,2), to = c(1,3), width = c(0.4,0.8))
  
  output$network <- renderVisNetwork(
    getDiagramPlot(nodes, edges)
  )
  
  observeEvent(input$current_node_id,{
    testFunction(input$current_node_id)
  })
}

shinyApp(ui, server)

说明 #

• 设置.main-sidebar为固定定位并限制高度为视口高度，确保侧边栏始终固定在左侧，内容过长时可纵向滚动，背景不会延伸到页面底部横向区域。
• 调整.content-wrapper的左侧边距与侧边栏宽度一致，避免主内容被侧边栏遮挡，同时设置最小高度保证布局完整性。
• 将VisNetwork高度定义移至输出控件，符合Shiny布局规范，避免容器溢出导致的重叠问题。

内容的提问来源于stack exchange，提问作者Corentin Wicht