rshinyshinydashboardjstreeshinytree

MenuItem doesn't always show the tree if there are multiple menuItems


I am trying to build a shinydashboard for my workplace to create a searchable table to display who is good at doing what in our different branches.

I wanted to have two sidebar items, to filter the table either by location, or by techniques. The location would be a tree (Country/City/Name), and the technique a set of buttons.

My issue is when I jump from one tab to the other. If I close the location tab before jumping to the technique tab (or the reverse), everything works fine, but if I open the technique tab without closing the location, the tree disappears, and I can't get it back.

I tried to replace the tree by a button, and in that case, there is no issue. The button will reappear no matter what I do.

I am a bit lost on what can be the issue.

When I try to inspect the page, I dont see any error that would justify why the tree is gone. I also tried to invert both tabs to see if the tree was hidden behind the second tab, but the issue remains the same. I am quite confused on why it only appears when I put a tree in the tab and not buttons.

My code to reproduce :

# Create a dataframe
tree <- data.frame(
  Country = c("USA", "Canada", "UK", "France", "Germany"),
  City = c("New York", "Toronto", "London", "Paris", "Berlin"),
  Name = c("John", "Alice", "Michael", "Sophie", "David")
)



######################
#UI###################
######################



ui <- dashboardPage(
  dashboardHeader(title = "Filters"),
  dashboardSidebar(
    # Increase the width of the sidebar panel
    width = 280,
    useShinyjs(),
    sidebarMenu(
      menuItem("By Location", tabName = "location", icon = icon("globe"),
               fluidRow(
                 # This doesnt work
                 column(12, treeInput(inputId = "tree_loc",label = "Select facilities:",choices = create_tree(tree),selected = "",returnValue = "text",closeDepth = 0))
                 
                 #This work
                 #column(12, actionBttn(inputId = "all_btn0", label = "Show all/Hide all", style = "jelly", color = "danger"))
                 )),
      
      menuItem("By Technique", tabName = "technique", icon = icon("microscope"),
               fluidRow(
                 # Adjust column sizing and spacing
                 column(3, actionBttn(inputId = "group1_btn", label = "EM", style = "jelly", color = "danger")),
                 column(3, actionBttn(inputId = "group2_btn", label = "LM", style = "jelly", color = "danger")),
                 column(3, actionBttn(inputId = "group3_btn", label = "Preclinical", style = "jelly", color = "danger"))
                 
               ),
               fluidRow(
                 column(5, actionBttn(inputId = "group4_btn", label = "Other modality", style = "jelly", color = "danger")),
                 column(5, actionBttn(inputId = "group5_btn", label = "Image Analysis", style = "jelly", color = "danger"))
               ),
               fluidRow(
                 column(12, actionBttn(inputId = "all_btn", label = "Show all/Hide all", style = "jelly", color = "danger")),
               ))
    )
  ),
  
  dashboardBody(

    DTOutput("table"),
  )
)


######################
#SERVER###############
######################



server <- function(input, output, session) {

}

shinyApp(ui, server)

Solution

  • The reason for the behaviour you are observing is that whenever the location tab is active and you activate the technique tab without closing the location tab beforehand, all .treejs-nodes get display: none and this isn't overwritten at any time afterwards.

    The display style can be changed to block when clicking on the location tab. This will solve the problem. Below is a small example using a short JS script for implementing it.

    enter image description here

    library(shiny)
    library(shinydashboard)
    library(shinyWidgets)
    
    tree <- data.frame(
        Country = c("USA", "Canada", "UK", "France", "Germany"),
        City = c("New York", "Toronto", "London", "Paris", "Berlin"),
        Name = c("John", "Alice", "Michael", "Sophie", "David")
    )
    
    js <- "
    $(document).ready(function() {
    
        $('a[href=\"#shiny-tab-location\"').on('click', function() {
            $('.treejs-nodes').css('display', 'block');
        });
    
    })
    "
    
    ui <- dashboardPage(
        dashboardHeader(title = "Filters"),
        dashboardSidebar(
            # Increase the width of the sidebar panel
            width = 280,
            sidebarMenu(
                menuItem("By Location", tabName = "location", icon = icon("globe"),
                         fluidRow(
                             column(12, treeInput(inputId = "tree_loc",label = "Select facilities:",choices = create_tree(tree),selected = NULL,returnValue = "text",closeDepth = 0))
                         )),
                
                menuItem("By Technique", tabName = "technique", icon = icon("microscope"),
                         fluidRow(
                             # Adjust column sizing and spacing
                             column(3, actionBttn(inputId = "group1_btn", label = "EM", style = "jelly", color = "danger")),
                             column(3, actionBttn(inputId = "group2_btn", label = "LM", style = "jelly", color = "danger")),
                             column(3, actionBttn(inputId = "group3_btn", label = "Preclinical", style = "jelly", color = "danger"))
                             
                         ),
                         fluidRow(
                             column(5, actionBttn(inputId = "group4_btn", label = "Other modality", style = "jelly", color = "danger")),
                             column(5, actionBttn(inputId = "group5_btn", label = "Image Analysis", style = "jelly", color = "danger"))
                         ),
                         fluidRow(
                             column(12, actionBttn(inputId = "all_btn", label = "Show all/Hide all", style = "jelly", color = "danger")),
                         ))
            )
        ),
        
        dashboardBody(
            tags$head(tags$script(JS(js))),
            DTOutput("table"),
        )
    )
    
    
    ######################
    #SERVER###############
    ######################
    
    
    
    server <- function(input, output, session) {
        
    }
    
    shinyApp(ui, server)