如何按條件隱藏多個閃亮的ui，以及如何使用session$userData？-有解無憂

我是閃亮的初學者，我正在使用 win10 系統、rstudio 和閃亮的 1.7.1 版構建閃亮的應用程式。我想讓它更加面向用戶。這意味著除非用戶上傳正確的資料，否則應用程式的其他部分將被隱藏。經過多次嘗試，我決定使用session$userData并shinyjs::toggle開發這個應用程式。但我很困惑 session$userData。一開始，通過閱讀官方檔案，我認為它就像r的全域環境。但顯然不是。所以我只想知道如何正確使用它，或者如何實作我想要的功能。我試過三個例子，供大家參考。

請注意，第三個示例幾乎是我想要的，但我認為它并不優雅，因為繼續按鈕有些多余。

示例1： 我想檢查是否有資料輸入或輸入資料是否為csv格式，如果為真，則顯示資料，如果沒有，則隱藏應用程式的其余部分。在這種情況下，您可以看到，盡管您的資料已通過檢查，但表格面板 b 仍然不會顯示任何內容，除非您在輸入資料之前單擊了表格面板 b，或者除非在資料檢查后您再次單擊按鈕 go。

##### 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)

示例2： 在這個小案例中，您可以看到，在一個示例模塊中，session$userData$...及時更改，但在另一個模塊中，除非您再次單擊該按鈕，否則它不會更改。這意味著 session$userData$...可以同時具有不同的值嗎？

##### 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)

示例 3：我還嘗試了其他解決方案。例子1有一個修改，我添加了一個continue按鈕來實作我的想法。它運作良好，但我希望隱藏的動作是基于條件而不是事件。那么如何去掉按鈕，讓其余部分在資料校驗通過后自動顯示呢？

##### 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)

uj5u.com熱心網友回復：

我希望以下重構會有所幫助，并且可以滿足您的需求。隱藏、顯示和更新 UI 元素的基本工具可以是renderUI，但由于重新渲染，這通常是矯枉過正。不過，我會建議使用的shinyjs，讓你喜歡的功能-packageshinyjs::show和shinyjs::hide用于顯示和隱藏。為了更新 UI 元素，有像shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, .... 提供您的 UI 元素 ID（例如tabsetPanel. 此外，一個不錯的工具也是shiny::conditionalPanel，但是在撰寫更多應用程式時，您將深入研究所有這些內容。:)

##### 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()

uj5u.com熱心網友回復：

你有點走在正確的軌道上。嘗試這樣的事情：

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
})

你不需要isolate()在handlerExprof里面observeEvent()。它將已經在一個isolate()范圍內執行。

轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/336842.html

標籤：r 会议闪亮的

上一篇：Pangram檢測

下一篇：使用Typescript表達mysql會話存盤