Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

visOptions height adds a footer #450

Open
CorentinWicht opened this issue Dec 6, 2022 · 1 comment
Open

visOptions height adds a footer #450

CorentinWicht opened this issue Dec 6, 2022 · 1 comment

Comments

@CorentinWicht
Copy link

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
Copy link
Author

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
Status: No status
Development

No branches or pull requests

1 participant