Question

以diamonds数据集为例，按下按钮后，应出现两个pickerInput。在第一个中，用户在diamonds数据集的三列之间进行选择。选择一个值后，应用程序应根据所选列的唯一值更新第二个pickertInput的选择。

该应用程序无需模块化即可正常运行。在阅读了有关模块的一些讨论之后，我仍然不清楚如何正确声明用于访问不同input$...的反应性值。

模块

module.UI <- function(id){
    ns <- NS(id)
    
    actionButton(inputId = ns("add"), label = "Add")
}

module <- function(input, output, session, data, variables){
    ns <- session$ns
    
    observeEvent(input$add, {
        insertUI(
            selector = "#add",
            where = "beforeBegin",
            ui = fluidRow(
                pickerInput(inputId = "picker_variable",
                            choices = variables,
                            selected = NULL
                ),
                pickerInput(inputId = "picker_value",
                            choices = NULL,
                            selected = NULL
                )
            )
        )
    })
    
    observeEvent(input$picker_variable,{
        updatePickerInput(session,
                          inputId = "picker_value",
                          choices = as.character(unlist(unique(data[, input$picker_variable]))),
                          selected = NULL
        )
    })
}

APP

ui <- fluidPage(
    mainPanel(
        module.UI(id = "myID")
    )
)

server <- function(input, output, session) {
    callModule(module = module, id = "myID", data = diamonds, variables=c("cut", "color", "clarity"))
}

shinyApp(ui = ui, server = server)

编辑用户应该能够多次单击按钮，以创建多个pickerInput对。

编辑＃2 根据@starja代码，尝试返回2个选择器的值将导致NULL对象。

library(shiny)
library(shinyWidgets)
library(ggplot2)

module.UI <- function(id, variables){
  ns <- NS(id)
  
  ui = fluidRow(
    pickerInput(inputId = ns("picker_variable"),
                choices = variables,
                selected = NULL
    ),
    pickerInput(inputId = ns("picker_value"),
                choices = NULL,
                selected = NULL
    )
  )
}

module <- function(input, output, session, data, variables){
  module_out <- reactiveValues(variable=NULL, values=NULL)

  observeEvent(input$picker_variable,{
    updatePickerInput(session,
                      inputId = "picker_value",
                      choices = as.character(unlist(unique(data[, input$picker_variable]))),
                      selected = NULL
    )
  })
  
  observe({
    module_out$variable <- input$picker_variable
    module_out$values <- input$picker_value
  })

  return(module_out)
}

ui <- fluidPage(
  mainPanel(
    actionButton(inputId = "add",
                 label = "Add"),
    tags$div(id = "add_UI_here")
  )
)

list_modules <- list()
current_id <- 1

server <- function(input, output, session) {
  
  observeEvent(input$add, {
    
    new_id <- paste0("module_", current_id)
    
    list_modules[[new_id]] <<-
      callModule(module = module, id = new_id,
                 data = diamonds, variables = c("cut", "color", "clarity"))
    
    insertUI(selector = "#add_UI_here",
             ui = module.UI(new_id, variables = c("cut", "color", "clarity")))
    
    current_id <<- current_id + 1
    
  })

  req(input$list_modules)
  print(list_modules)
  
}

shinyApp(ui = ui, server = server)

编辑＃3 仍然难以返回列表中的两个选择器的值，以便于进一步访问（下面的示例）：

module_out
$module_1
$module_1$variable
[1] "cut"

$module_1$values
[1] "Ideal"   "Good"

$module_2
$module_2$variable
[1] "color"

$module_2$values
[1] "E"   "J"

Answer 1

您的代码有2个问题：

如果您通过insertUI在模块中插入UI元素，则UI元素的ID必须具有正确的命名空间：ns(id)
因为您在selector的{{1}}中使用的ID是在模块中创建的，所以它也被命名空间，因此insertUI参数也必须被命名空间

selector

顺便说一句：我认为，将代码模块化的更自然的方法是在主应用程序中使用library(shiny) library(shinyWidgets) library(ggplot2) module.UI <- function(id){ ns <- NS(id) actionButton(inputId = ns("add"), label = "Add") } module <- function(input, output, session, data, variables){ ns <- session$ns observeEvent(input$add, { insertUI( selector = paste0("#", ns("add")), where = "beforeBegin", ui = fluidRow( pickerInput(inputId = ns("picker_variable"), choices = variables, selected = NULL ), pickerInput(inputId = ns("picker_value"), choices = NULL, selected = NULL ) ) ) }) observeEvent(input$picker_variable,{ updatePickerInput(session, inputId = "picker_value", choices = as.character(unlist(unique(data[, input$picker_variable]))), selected = NULL ) }) } ui <- fluidPage( mainPanel( module.UI(id = "myID") ) ) server <- function(input, output, session) { callModule(module = module, id = "myID", data = diamonds, variables=c("cut", "color", "clarity")) } shinyApp(ui = ui, server = server)按钮，然后动态插入模块的实例，以便您的模块仅包含逻辑/一种Add / picker_variable组合的用户界面

编辑

谢谢您的发言。实际上，在模块中使用相同的picker_value创建多个pickerInput并没有多大意义。我更改了代码以反映inputId在主应用程序中的模式，并且每个模块仅包含一组输入：

actionButton

编辑2

您可以直接从模块返回library(shiny) library(shinyWidgets) library(ggplot2) module.UI <- function(id, variables){ ns <- NS(id) ui = fluidRow( pickerInput(inputId = ns("picker_variable"), choices = variables, selected = NULL ), pickerInput(inputId = ns("picker_value"), choices = NULL, selected = NULL ) ) } module <- function(input, output, session, data, variables){ observeEvent(input$picker_variable,{ updatePickerInput(session, inputId = "picker_value", choices = as.character(unlist(unique(data[, input$picker_variable]))), selected = NULL ) }) } ui <- fluidPage( mainPanel( actionButton(inputId = "add", label = "Add"), tags$div(id = "add_UI_here") ) ) list_modules <- list() current_id <- 1 server <- function(input, output, session) { observeEvent(input$add, { new_id <- paste0("module_", current_id) list_modules[[new_id]] <<- callModule(module = module, id = new_id, data = diamonds, variables = c("cut", "color", "clarity")) insertUI(selector = "#add_UI_here", ui = module.UI(new_id, variables = c("cut", "color", "clarity"))) current_id <<- current_id + 1 }) } shinyApp(ui = ui, server = server)，并在主应用程序的反应式上下文中使用它：

input

R闪亮：模块

1 个答案:

编辑

编辑2