Home > Back-end >  How to hide multiple shiny ui by condition, and how to use session$userData?
How to hide multiple shiny ui by condition, and how to use session$userData?

Time:10-23

I am a beginer of shiny, and I am building a shiny app using win10 system, rstudio, and shiny version 1.7.1. I would like to make it more user oriented. It means that other parts of the application will be hid unless user uploads correct data. After many attempts, I decided to use session$userData and shinyjs::toggle to develop this app. But I am confused by session$userData. In the beginning, by reading the official documentation, I think it just like the global environment of r. But obviously not. So I just want to know how to use it correctly, or how to realize the features I want. There are three examples I had tried, they are for your reference.

Please note that the third example is almost what I want, but I don't think it's elegant since the continue button is somewhat redundant.

Examples 1: I would like to check whether there is data input or whether the input data is a csv format, if true, show the data, and if not, the rest part of the app will be hid. In this case you can see, although you data have passed the check, the tablepanel b will still show nothing, unless before input data you have clicked tablepanel b, or unless after data checking you clicked button go again.

##### 1. packages #####
library(shiny)
library(shinyjs)

##### 2. ui #####
ui <- fluidPage(
  useShinyjs(), 
  tabsetPanel(
    tabPanel("a",
             sidebarLayout(
               sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
               mainPanel(uiOutput("ui_p1_main"))
             )),
    tabPanel("b",
             sidebarLayout(
               sidebarPanel(uiOutput("ui_p2_sidebar")), 
               mainPanel(uiOutput("ui_p2_main"))
             ))
  )
)

##### 3. server #####
server <- function(input, output, session) {
  output$ui_p1_sidebar1 <- renderUI({
    fileInput(inputId = "p1s_inputdata", 
              label = "Input data",
              multiple = FALSE, 
              accept = ".csv")
  })
  output$ui_p1_sidebar2 <- renderUI({
    shiny::actionButton(inputId = "p1s_go", 
                        label = "go", 
                        icon = icon("play"))
  })
  observeEvent(input$p1s_go,{
    isolate({
      data <- input$p1s_inputdata
    })
    output$ui_p1_main <- renderUI({
      tagList(
        h3("Data check: "),
        verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
        h3("Data show: "),
        verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
      )
    })
    output$p1m_datacheck <- renderPrint({
      # data check part, the result of checking is stored by session$userData$sig
        if(is.null(data)){
          cat("There is no data input! \n")
          session$userData$sig <- F
        } else{
          dataExt <- tools::file_ext(data$name)
          if(dataExt != "csv"){
            cat("Please input csv data! \n")
            session$userData$sig <- F
          } else{
            cat("Data have passed the check!")
            session$userData$data <- read.csv(data$datapath)
            session$userData$sig <- T
          }
        }
      })
    output$p1m_datashow <- renderPrint({
      if(session$userData$sig){
        print(session$userData$data)
      } else{
        cat("Please check the data!")
      }
    })
    output$ui_p2_sidebar <- renderUI({
      radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
    })
    output$ui_p2_main <- renderUI({
      verbatimTextOutput(outputId = "p2m_print", placeholder = T)
    })
    output$p2m_print <- renderPrint({print(letters[1:10])})
    observe({
      toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
      toggle(id = "ui_p2_main", condition = session$userData$sig)
    })
  })
}

##### 4. app #####
shinyApp(ui = ui, server = server)

Example 2: In this small case you can see, in a samle module, session$userData$... changed timely, but in another module, it will not change unless you click the button again. It that means session$userData$... could have different values at the same time?

##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(uiOutput("ui_sidebar")), 
    mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
  )
)
##### 3. server #####
server <- function(input, output, session) {
  output$ui_sidebar <- renderUI({
    tagList(
      radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
      shiny::actionButton(inputId = "go1", 
                          label = "GO1",
                          icon = icon("play"))
    )
  })
  observeEvent(input$go1, {
    output$ui_main1 <- renderUI({
      tagList(
        h3("module 1: shared value changes timely."),
        verbatimTextOutput(outputId = "m1", placeholder = T),
        h3("module 2: shared value changes by button."),
        verbatimTextOutput(outputId = "m2", placeholder = T)
      )
    })
    output$m1 <- renderPrint({
      out <- switch (input$s_letter,
                     "a" = "choose a",
                     "b" = "choose b",
                     "c" = "choose c")
      session$userData$sharedout <- out  
      cat("out: \n")
      print(out)
      cat("sharedout: \n")
      print(session$userData$sharedout)
    })
    output$m2 <- renderPrint({
      cat("sharedout: \n")
      print(session$userData$sharedout)
    })
  })
}
##### 4. app #####
shinyApp(ui = ui, server = server)

Example 3: I also tried other solutions. There is a modification of example 1, I have added a continue button to realize my thought. It works well, but I hope the hidden action is based on conditions rather than events. So how to remove the button and let the rest part displayed automatically if data passed checking?

##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
  tabsetPanel(
    tabPanel("a",
             sidebarLayout(
               sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
               mainPanel(uiOutput("ui_p1_main"))
             )),
    tabPanel("b",
             sidebarLayout(
               sidebarPanel(uiOutput("ui_p2_sidebar")), 
               mainPanel(uiOutput("ui_p2_main"))
             ))
  )
)
##### 3. server #####
server <- function(input, output, session) {
  output$ui_p1_sidebar1 <- renderUI({
    fileInput(inputId = "p1s_inputdata", 
              label = "Input data",
              multiple = FALSE, 
              accept = ".csv")
  })
  output$ui_p1_sidebar2 <- renderUI({
    shiny::actionButton(inputId = "p1s_go", 
                        label = "go", 
                        icon = icon("play"))
  })
  observeEvent(input$p1s_go,{
    isolate({
      data <- input$p1s_inputdata
    })
    output$ui_p1_main <- renderUI({
      tagList(
        h3("Data check: "),
        verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
        uiOutput("ispass"),
        h3("Data show: "),
        verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
      )
    })
    output$p1m_datacheck <- renderPrint({
      if(is.null(data)){
        cat("There is no data input! \n")
        session$userData$sig <- F
      } else{
        dataExt <- tools::file_ext(data$name)
        if(dataExt != "csv"){
          cat("Please input csv data! \n")
          session$userData$sig <- F
        } else{
          cat("Data have passed the check!")
          session$userData$data <- read.csv(data$datapath)
          session$userData$sig <- T
        }
      }
    })
    output$ispass <- renderUI({
      if(isFALSE(session$userData$sig)){
        return()
      } else{
      shiny::actionButton(inputId = "ispass", 
                          label = "continue", 
                          icon = icon("play"))
      }
    })
  })
  observeEvent(input$ispass,{
    output$p1m_datashow <- renderPrint({
      if(session$userData$sig){
        print(session$userData$data)
      } else{
        cat("Please check the data!")
      }
    })
    output$ui_p2_sidebar <- renderUI({
      radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
    })
    output$ui_p2_main <- renderUI({
      verbatimTextOutput(outputId = "p2m_print", placeholder = T)
    })
    output$p2m_print <- renderPrint({print(letters[1:10])})
  })
}
##### 4. app #####
shinyApp(ui = ui, server = server)

CodePudding user response:

I hope the following refactoring will help and does what you want. An essential tool for hiding,showing and updating UI elements can be the renderUI, but often this is overkill because of rerenderings. But I would suggest using the shinyjs-package which gives you functions like shinyjs::show and shinyjs::hide for showing and hiding. For updating UI-elements, there are functions like shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, .... It is (always) useful to give your UI-elements IDs, like the tabsetPanel. Moreover, a nice tool too is shiny::conditionalPanel, but you will dive into all this stuff when programming more apps. :)

##### 1. packages #####
library(shiny)

myapp <- function() {
  ##### 2. ui #####
  ui <- fluidPage(
    tabsetPanel(
      tabPanel("a",
               sidebarLayout(
                 sidebarPanel(
                   fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
                 ),
                 mainPanel(uiOutput("ui_p1_main"))
               )),
      tabPanel("b",
               sidebarLayout(
                 sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))), 
                 mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
               )),
      id = "TABSETPANEL"
    )
  )
  ##### 3. server #####
  server <- function(input, output, session) {
    
    shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
    
    observeEvent(input$p1s_inputdata, {
      data <- input$p1s_inputdata
      
      dataCheckText <- NULL
      if(is.null(data)){
        dataCheckText <- "There is no data input!"
        session$userData$sig <- F
      } else{
        dataExt <- tools::file_ext(data$name)
        if(dataExt != "csv"){
          dataCheckText <- "Please input csv data!"
          session$userData$sig <- F
        } else{
          dataCheckText <- "Data have passed the check!"
          session$userData$data <- read.csv(data$datapath)
          session$userData$sig <- T
        }
      }
      
      output$p1m_datacheck <- renderPrint(dataCheckText)
      
      if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
      else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
      
      main1Taglist <- tagList(
        h3("Data check: "),
        verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
      )
      
      if(session$userData$sig) {
        shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
        
        output$p1m_datashow <- renderPrint({
          print(session$userData$data)
        })
        
        main1Taglist <- c(main1Taglist, tagList(
          h3("Data show: "),
          verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
        ))
        
        #Update stuff in panel b according to the new data
        updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
        output$p2m_print <- renderPrint({print(letters[1:10])})
      }
      
      output$ui_p1_main <- renderUI(main1Taglist)
    })
    
  }
  ##### 4. app #####
  shinyApp(ui = ui, server = server)
}

myapp()

CodePudding user response:

You're somewhat on the right track. Try something like this:

observeEvent(input$go1, {
  # Perform data validation here. 
  # This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
  # If data file is no good, do nothing, exit this function: return()
  # Else, data file is good, continue

  # Do your output$* <- render*() functions here
})

You don't need to isolate() inside the handlerExpr of observeEvent(). It will already be executed in an isolate() scope.

  • Related