如何阻止反应函数在 Shiny 中重复？

Question

我正在尝试简化 Shiny 应用程序中的搜索功能，并注意到反应函数不断重复和覆盖我想要显示的内容。

我想让用户搜索两个变量 1) 县和 2) 邮政编码。我想根据 单选按钮 selected（县或邮政编码）更改搜索框上方的标签，并理想地减少可用选项列表 select.

因此，如果您输入 select 邮政编码，您会看到一个邮政编码列表，如果您输入 select 县，您只会看到县列表。从下面的代码中可以看出，它在输出方面有些功能，但动态标签和动态 select 列表并不总是有效。

library(shiny)
library(dplyr)    
library(tidyverse)
library(tibble)
library(DT)

county_list = c('Kings','Rockland','Orange','New York','Richmond','Kings','Rockland','Orange','New York','Richmond')
zip_list = c('11230','10901','12550','10023','10044','11230','10901','12550','10023','10044')
store_name = c('Store 1','Store 2', 'Store 3','Store 4', 'Store 5','Store 1','Store 7', 'Store 8','Store 9', 'Store 10')

db = tibble(Store = store_name ,County = county_list, ZipCode = zip_list)

ui <- fluidPage(  
  
  titlePanel("Title"),
  tabsetPanel(
    tabPanel('Data',  
             
             radioButtons("county_or_zip_select","Choose:",choices=c("County","ZipCode")),
             selectInput("search4_all", "search_box:", selectize = FALSE,choices=unique(c(county_list,zip_list))),
             DT::DTOutput('data')
             )
    ))

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

    getData <- reactive({
      if(input$county_or_zip_select=='County'){
        df<-db[grep(input$search4_all, db$County,ignore.case = T),]
        updateSelectInput(session,"search4_all",label='Select County:')
        
      }else{
        df<-db[grep(input$search4_all, db$ZipCode, ignore.case = T),]}
        updateSelectInput(session,"search4_all",label='Select Zip Code:')
      
      df  
    })

    output$data <- DT::renderDT(getData(),options = list(lengthMenu = c(5, 10), pageLength = 5)) # Refers to DT::DTOutput('data') in main panel section
       
} 
shinyApp(ui = ui, server = server)

注意：我发布了一个类似 question the other day which I have since deleted (or tried to), but I did not incorporate updatSelectInput and more importantly, I did not provide an MWE 的帖子。抱歉。

Answer 1

您可以创建两个单独的 selectInput 并使用 shinyjs 根据单选按钮值切换一个或另一个：

library(shiny)
library(shinyjs)
library(dplyr)    
library(tidyverse)
library(tibble)
library(DT)

county_list = c('Kings','Rockland','Orange','New York','Richmond','Kings','Rockland','Orange','New York','Richmond')
zip_list = c('11230','10901','12550','10023','10044','11230','10901','12550','10023','10044')
store_name = c('Store 1','Store 2', 'Store 3','Store 4', 'Store 5','Store 1','Store 7', 'Store 8','Store 9', 'Store 10')

db = tibble(Store = store_name ,County = county_list, ZipCode = zip_list)

ui <- fluidPage(  
  
  titlePanel("Title"),
  shinyjs::useShinyjs(),
  tabsetPanel(
    tabPanel('Data',  
             
             radioButtons("county_or_zip_select","Choose:",choices=c("County","ZipCode")),
             selectInput("selectCounty", "Select county", selectize = FALSE,choices=unique(county_list)),
             selectInput("selectZipcode", "Select zip code", selectize = FALSE,choices=unique(zip_list)),
             DT::DTOutput('data')
    )
  ))

server <- function(input, output, session) {
  
  observe( {
    shinyjs::toggle('selectCounty',condition = input$county_or_zip_select=='County')
    shinyjs::toggle('selectZipcode',condition = input$county_or_zip_select=='ZipCode')
  })

  getData <- reactive({
    if(input$county_or_zip_select=='County'){
      db[grep(input$selectCounty, db$County,ignore.case = T),]
    } else {
      db[grep(input$selectZipcode, db$ZipCode, ignore.case = T),]}
  })
  
  output$data <- DT::renderDT(getData(),options = list(lengthMenu = c(5, 10), pageLength = 5)) # Refers to DT::DTOutput('data') in main panel section
  
} 
shinyApp(ui = ui, server = server)

请注意，UI 中需要调用 shinyjs::useShinyjs()，以便 shinyjs 正常工作。

Answer 2

另一种方法是

county_list = c('Kings','Rockland','Orange','New York','Richmond','Kings','Rockland','Orange','New York','Richmond')
zip_list = c('11230','10901','12550','10023','10044','11230','10901','12550','10023','10044')
store_name = c('Store 1','Store 2', 'Store 3','Store 4', 'Store 5','Store 1','Store 7', 'Store 8','Store 9', 'Store 10')

db = tibble(Store = store_name ,County = county_list, ZipCode = zip_list)

ui <- fluidPage(  
  
  titlePanel("Title"),
  tabsetPanel(
    tabPanel('Data',  
             
             radioButtons("county_or_zip_select","Choose:",choices=c("County","ZipCode")),
             uiOutput("crz"),
             DT::DTOutput('data')
    )
  ))

server <- function(input, output, session) {
  
  output$crz <- renderUI({
    if (input$county_or_zip_select == "County") {
      mychoices <- unique(c(county_list))
      mylabel <- "Select County: "
    }else {
      mychoices <- unique(c(zip_list))
      mylabel <- "Select Zip Code: "
    }
    selectInput("search4_all", mylabel, selectize = FALSE, choices=mychoices )
  })
  
  getData <- reactive({
    if(input$county_or_zip_select=='County'){
      df<-db[grep(input$search4_all, db$County,ignore.case = T),]
    }else{
      df<-db[grep(input$search4_all, db$ZipCode, ignore.case = T),]}
    
    df  
  })
  
  output$data <- DT::renderDT(getData(),options = list(lengthMenu = c(5, 10), pageLength = 5)) # Refers to DT::DTOutput('data') in main panel section
  
} 
shinyApp(ui = ui, server = server)

如何阻止反应函数在 Shiny 中重复？

How to stop reactive functions from repeating in Shiny?

r

shiny

shiny-reactivity