在 R 闪亮模块中捕获选择输入值

问题描述

我正在构建一个带有选择输入的闪亮应用。
输入中的选择取决于基础数据中的 id。
在我的真实应用中,数据通过调用 API 进行更新。
当我点击“更新数据”按钮时,我希望在 selectize 输入中选择的 id 选项保持不变。

在使用闪亮的模块之前,我能够做到这一点。但是,当我尝试将代码转换为使用闪亮的模块时,它无法保存选定的 id 值,并且每次更新基础数据时都会重置选择输入。

以下示例在没有模块的情况下很有帮助,但是当我使用该模块时,它似乎不起作用...link here

下面是一个reprex。感谢您的帮助。

library(shiny)
library(tidyverse)


# module UI

mymod_ui <- function(id){
      ns <- NS(id)
      tagList(
                
                uIoUtput(ns("ids_lookup")),)        
      
}


# module server

mymod_server <- function(input,output,session,data,actionb){
      ns <-session$ns
      
      ids <- reactive(
                
                data() %>%
                          filter(!is.na(first_name) & !is.na(last_name) & !is.na(ages)) %>%
                          mutate(ids = paste(first_name,last_name,sep = " ")) %>%
                          select(ids)
      )
      
      
      output$ids_lookup <- renderUI({
                
                selectizeInput(ns("lookup"),label = "Enter id:",choices = c("Type here ...",ids()),multiple = FALSE)
                
      })
      
      # here is where I would like to hold on to the selected ids when updating the table
      # when I click the "reload_data" button I don't want the name to change
      # I pass the button from the main server section into the module
      
      current_id_selection <- reactiveVal("NULL")
      
      observeEvent(actionb(),{
                
                current_id_selection(ns(input$ids_lookup))
                
                updateSelectizeInput(session,inputId = ns("lookup"),choices = ids(),selected = current_id_selection())
      })
     
}


ui <- fluidPage(
      titlePanel("Test module app"),br(),# this button reloads the data
      actionButton(
                
                inputId = "reload_data",label = "Reload data"
      ),# have a look at the data
      h4("Raw data"),tableOutput("mytable"),# Now select a single id for further analysis in a much larger app
      mymod_ui("mymod"),)


server <- function(input,session) {
      
     
      
      df <- eventReactive(input$reload_data,{
                
                # in reality,df is a dataframe which is updated from an API call everytime you press the action button
                
                df <- tibble(
                          first_name = c("john","james","jenny","steph"),last_name = c("x","y","z",NA),ages = runif(4,30,60)
                )
      
                
                return(df)
                
      }
      )
      
      
      output$mytable <- renderTable({
                
                df()
                
      })
      
      
      # make the reload data button a reactive val that can be passed to the module for the selectize Input
      
      mybutton <- reactive(input$reload_data)
      
      callModule(mymod_server,"mymod",data = df,actionb = mybutton)
      

      
      
}


shinyApp(ui,server)

解决方法

只需在 inputId = "lookup" 中使用 inputId = ns("lookup") 而不是 updateSelectizeInput() 即可。此外,你还有另一个错字。试试这个

library(shiny)
library(tidyverse)


# module UI

mymod_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("ids_lookup")),verbatimTextOutput(ns("t1"))
  )        
  
}


# module server

mymod_server <- function(input,output,session,data,actionb){
  ns <-session$ns
  
  ids <- reactive(
    
    data() %>%
      filter(!is.na(first_name) & !is.na(last_name) & !is.na(ages)) %>%
      mutate(ids = paste(first_name,last_name,sep = " ")) %>%
      select(ids)
  )
  
  
  output$ids_lookup <- renderUI({
    
    selectizeInput(ns("lookup"),label = "Enter id:",choices = c("Type here ...",ids()),multiple = FALSE)
    
  })
  
  # here is where I would like to hold on to the selected ids when updating the table
  # when I click the "reload_data" button I don't want the name to change
  # I pass the button from the main server section into the module
  
  current_id_selection <- reactiveValues(v=NULL)
  
  observeEvent(actionb(),{
    req(input$lookup)
    current_id_selection$v <- input$lookup
    
    output$t1 <- renderPrint(paste0("Current select is ",current_id_selection$v))
    
    updateSelectizeInput(session,inputId = "lookup",choices =  ids(),selected = current_id_selection$v )
  })
  
}


ui <- fluidPage(
  titlePanel("Test module app"),br(),# this button reloads the data
  actionButton(inputId = "reload_data",label = "Reload data"
  ),# have a look at the data
  h4("Raw data"),tableOutput("mytable"),# now select a single id for further analysis in a much larger app
  mymod_ui("mymod")
  
)


server <- function(input,session) {
  
  df <- eventReactive(input$reload_data,{
    
    # in reality,df is a dataframe which is updated from an API call everytime you press the action button
    
    df <- tibble(
      first_name = c("john","james","jenny","steph"),last_name = c("x","y","z",NA),ages = runif(4,30,60)
    )
    
    return(df)
    
  })
  
  
  output$mytable <- renderTable({
    
    df()
    
  })
  
  
  # make the reload data button a reactive val that can be passed to the module for the selectize Input
  
  mybutton <- reactive(input$reload_data)
  
  callModule(mymod_server,"mymod",data = df,actionb = mybutton)
  
}

shinyApp(ui,server)

output