datastorm-open / visNetwork

R package, using vis.js library for network visualization
Other
542 stars 127 forks source link

visOptions height adds a footer #450

Open CorentinWicht opened 1 year ago

CorentinWicht commented 1 year ago

Dear Developper,

I just wanted to report a stranger behaviour when setting up the Height using VisOptions().

When used in combination with dashboardSidebar() it creates a footer with the same colour as the sidebar: image

This footer is not there when the Height argument is not defined.

Here is my code for a reproducible example:

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; }"))), # Changing sidebar font sizes
                # Boxes need to be put in a row (or column)
                fluidRow(
                  visNetworkOutput("network") # Unique name for an output
                ))
)

server <- function(input, output, session) {
  getDiagramPlot <- function(nodes, edges){
    v <- visNetwork(
      nodes, 
      edges
    ) %>%
      visPhysics(stabilization = TRUE, enabled = F) %>%
      visOptions(height = "1800", highlightNearest = T, nodesIdSelection = T, selectedBy= list(variable="group",multiple=T)) %>%
      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)
CorentinWicht commented 1 year ago

Funily enough, I realized that if you set the height in visNetworkOutput() instead:

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

Then there is no footer (which is great) but then adding a legend with visLegend() would look shifted down: image