visNetwork
visNetwork copied to clipboard
visOptions height adds a footer
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:
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)
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: