rshinyshinydashboard

How to trigger observerEvent on child tabPanel only once during initialization


In the application below there are many tabs, some are parent tabs and some are child tabs. I want to trigger observerEvent when someone clicks at the child tabPanel for the first time. Right now, all the observerEvent functions are triggered when someone clicks on any of the child tabs, which is wrong. Can someone show me the right way to trigger the observerEvent only once, whenever a child tab is clicked?

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(
  collapsed = FALSE,
  sidebarMenu(id = "menu_sidebar",
              conditionalPanel(
                condition = "input.main_tab == 'mother_tab' && (input.group_tab == 't_child1' || input.group_tab == 't_child2' || input.group_tab == 't_child3')",
                selectizeInput(inputId = "tc", label = "Select by:", choices = c("APPLE", "ORANGE", "PEAR"), selected = "APPLE")
              ),
              conditionalPanel(
                condition = "input.main_tab == 'tab_1'",
                selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40)))
              ),
              conditionalPanel(
                condition = "input.main_tab == 'tab_2'",
                selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50)))
              )
  )
)


body <- dashboardBody(
  fluidRow(
    tabsetPanel(id = "main_tab",
                selected = "mother_tab",
                tabPanel(title = "tab_1", "Tab content 1"),
                tabPanel(title = "tab_2", "Tab content 2"),
                tabPanel(title = "mother_tab",
                         tabsetPanel(type = "tabs", id = "group_tab", selected = "t_child2",
                                     tabPanel(title = "child_1", value = "t_child1", "Tab child content 1"),
                                     tabPanel(title = "child_2", value = "t_child2", "Tab child content 2"),
                                     tabPanel(title = "child_3", value = "t_child3", "Tab child content 3")
                         )
                )
                
    )
  )
)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    sidebar,
    body
  ),
  server = function(input, output, session) {
    observeEvent(eventExpr = input$main_tab, handlerExpr = {
      if(input$main_tab == 'tab_1')
        print("Tab content 1")
      else if(input$main_tab == 'tab_2')
        print("Tab content 2")
    })
    
    observeEvent(eventExpr = {input$group_tab == 't_child1'}, handlerExpr = {
        print("Child content 1")
      }, once = TRUE, ignoreInit = TRUE)
    
    observeEvent(eventExpr = {input$group_tab == 't_child2'}, handlerExpr = {
      print("Child content 2")
    }, once = TRUE, ignoreInit = TRUE)
    
    observeEvent(eventExpr = {input$group_tab == 't_child3'}, handlerExpr = {
      print("Child content 3")
    }, once = TRUE, ignoreInit = TRUE)
  }
)

Solution

  • observeEvent listens for changes in input$group_tab value, not TRUE or FALSE.Instead we can use a switch function (or multiple if statements) inside the observer like this:

    library(shiny)
    library(shinydashboard)
    
    sidebar <- dashboardSidebar(
      collapsed = FALSE,
      sidebarMenu(
        id = "menu_sidebar",
        conditionalPanel(
          condition = "input.main_tab == 'mother_tab' && (input.group_tab == 't_child1' || input.group_tab == 't_child2' || input.group_tab == 't_child3')",
          selectizeInput(inputId = "tc", label = "Select by:", choices = c("APPLE", "ORANGE", "PEAR"), selected = "APPLE")
        ),
        conditionalPanel(
          condition = "input.main_tab == 'tab_1'",
          selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40)))
        ),
        conditionalPanel(
          condition = "input.main_tab == 'tab_2'",
          selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50)))
        )
      )
    )
    
    
    body <- dashboardBody(
      fluidRow(
        tabsetPanel(
          id = "main_tab",
          selected = "",
          tabPanel(title = "tab_1", "Tab content 1"),
          tabPanel(title = "tab_2", "Tab content 2"),
          tabPanel(
            title = "mother_tab",
            tabsetPanel(
              type = "tabs", id = "group_tab", selected = "",
              tabPanel(title = "child_1", value = "t_child1", "Tab child content 1"),
              tabPanel(title = "child_2", value = "t_child2", "Tab child content 2"),
              tabPanel(title = "child_3", value = "t_child3", "Tab child content 3")
            )
          )
        )
      )
    )
    
    
    shinyApp(
      ui = dashboardPage(
        dashboardHeader(title = "tabBoxes"),
        sidebar,
        body
      ),
      server = function(input, output, session) {
        nms_not_used <- reactiveVal(c("t_child1", "t_child2", "t_child3"))
    
        observeEvent(eventExpr = input$main_tab, handlerExpr = {
          if (input$main_tab == "tab_1") {
            print("Tab content 1")
          } else if (input$main_tab == "tab_2") {
            print("Tab content 2")
          }
        })
    
        observeEvent(input$group_tab, handlerExpr = {
    
          # create a vector with all the tabs names
    
          index <- which(nms_not_used() == input$group_tab)
    
          if (length(index) > 0) {
            # store the value
            cur_value <- nms_not_used()[[index]]
            # remove it from the names that are not used
            nms_not_used(nms_not_used()[-index])
    
            switch(cur_value,
              "t_child1" = print("Child content 1"),
              "t_child2" = print("Child content 2"),
              "t_child3" = print("Child content 3")
            )
          }
        }, , ignoreInit = TRUE)
      }
    )