闪亮：模块UI的updateSelectInput（在insertUI之后）

Question

以下闪亮的应用程序使用模块，可以正常工作：

library(shiny)


LHSchoices <- c("X1", "X2", "X3", "X4")

LHSchoices2 <- c("S1", "S2", "S3", "S4")

#------------------------------------------------------------------------------#

# MODULE UI ----
variablesUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(6,
             selectInput(ns("variable"),
                         paste0("Select Variable ", number),
                         choices = c("Choose" = "", LHSchoices)
             )
      ),

      column(6,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      )
    )
  )

}

#------------------------------------------------------------------------------#

# MODULE SERVER ----

variables <- function(input, output, session, variable.number){
  reactive({

    req(input$variable, input$value.variable)

    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,
      "variable" = input$variable,
      "value" = input$value.variable,
      stringsAsFactors = FALSE
    )

    return(df)

  })
}

#------------------------------------------------------------------------------#

# Shiny UI ----

ui <- fixedPage(
  tabsetPanel(type = "tabs",id="tabs",
              tabPanel("t1",value="t1"),
              tabPanel("t2",value="t2")),

  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line"),

  verbatimTextOutput("test1"),
  tableOutput("test2")
)

# Shiny Server ----

server <- function(input, output) {

  add.variable <- reactiveValues()

  add.variable$df <- data.frame("variable.number" = numeric(0),
                                "variable" = character(0),
                                "value" = numeric(0),
                                stringsAsFactors = FALSE)

  var1 <- callModule(variables, paste0("var", 1), 1)

  observe(add.variable$df[1, ] <- var1())

  observeEvent(input$insertBtn, {

    btn <- sum(input$insertBtn, 1)

    insertUI(
      selector = "h5",
      where = "beforeEnd",
      ui = tagList(
        variablesUI(paste0("var", btn), btn)
      )
    )

    newline <- callModule(variables, paste0("var", btn), btn)

    observeEvent(newline(), {
      add.variable$df[btn, ] <- newline()
    })

  })

  output$test1 <- renderPrint({
    print(add.variable$df)
  })

  output$test2 <- renderTable({
    add.variable$df
  })

}

#------------------------------------------------------------------------------#

shinyApp(ui, server)

现在，我想使用动态选择更新selectInput。为此，我发现了this answer，可以使用函数updateSelectInput。

但是在此应用中，selectInput在模块中。以下内容无效

  observe({
    updateSelectInput(session, "variable",
                      choices = choices_var()
    )})

choices_var()是一些反应性值（例如，可能取决于所选的标签）。

这是完整的代码。

library(shiny)


LHSchoices <- c("X1", "X2", "X3", "X4")

LHSchoices2 <- c("S1", "S2", "S3", "S4")

#------------------------------------------------------------------------------#

# MODULE UI ----
variablesUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(6,
             selectInput(ns("variable"),
                         paste0("Select Variable ", number),
                         choices = c("Choose" = "", LHSchoices)
             )
      ),

      column(6,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      )
    )
  )

}

#------------------------------------------------------------------------------#

# MODULE SERVER ----

variables <- function(input, output, session, variable.number){
  reactive({

    req(input$variable, input$value.variable)

    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,
      "variable" = input$variable,
      "value" = input$value.variable,
      stringsAsFactors = FALSE
    )

    return(df)

  })
}

#------------------------------------------------------------------------------#

# Shiny UI ----

ui <- fixedPage(
  tabsetPanel(type = "tabs",id="tabs",
              tabPanel("tab1",value="t1"),
              tabPanel("tab2",value="t2")),

  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line"),

  verbatimTextOutput("test1"),
  tableOutput("test2")
)

# Shiny Server ----

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


  choices_var <- reactive({
    if (input$tabs=="t1"){

      choices_var <- LHSchoices
    }
    if (input$tabs=="t2") {
      choices_var <- LHSchoices2
    }
    return(choices_var)
  })

  observe({
    updateSelectInput(session, "variable",
                      choices = choices_var()
    )})


  add.variable <- reactiveValues()

  add.variable$df <- data.frame("variable.number" = numeric(0),
                                "variable" = character(0),
                                "value" = numeric(0),
                                stringsAsFactors = FALSE)

  var1 <- callModule(variables, paste0("var", 1), 1)

  observe(add.variable$df[1, ] <- var1())

  observeEvent(input$insertBtn, {

    btn <- sum(input$insertBtn, 1)

    insertUI(
      selector = "h5",
      where = "beforeEnd",
      ui = tagList(
        variablesUI(paste0("var", btn), btn)
      )
    )

    newline <- callModule(variables, paste0("var", btn), btn)

    observeEvent(newline(), {
      add.variable$df[btn, ] <- newline()
    })

  })

  output$test1 <- renderPrint({
    print(add.variable$df)
  })

  output$test2 <- renderTable({
    add.variable$df
  })

}

#------------------------------------------------------------------------------#

shinyApp(ui, server)

我想如何修改代码，以便可以修改选择。

编辑：通过添加以下代码，我成功更新了第一个UI。所以现在我的问题是：我们如何动态到达variablesUI？

  choices_var <<- reactive({
    if (input$tabs=="t1"){

      choices_var <- LHSchoices
    }
    if (input$tabs=="t2") {
      choices_var <- LHSchoices2
    }
    return(choices_var)
  })

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var1-variable",
                      choices = choices_var())
  })

编辑2 ：我可以按如下所示手动进行操作，但这确实很丑陋，并且添加的UI数量应受到限制。

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var1-variable",
                      choices = choices_var())
  })

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var2-variable",
                      choices = choices_var())
  })

编辑3

现在我的问题变得更加具体：使用selectInput插入insertUI时，如何用selectInput更新新插入的updateSelectInput的选择？

Answer 1

您的variable输入位于模块中。您正在尝试从主要的server函数进行更新。因此，您有一个名称空间不匹配。它也违反了模块应该是独立的原则。

理想情况下，您应该在定义它的模块中更新variable输入。如果更新依赖于模块外部存在的值，则可以将它们作为响应传递给模块服务器功能。

*编辑* 这是一个简单的，自我添加的示例，用于响应OP请求演示如何使用主要selectInput函数提供的数据更新模块内部的server。我删除了与演示目的不直接相关的所有内容。

该应用程序包含模块的两个实例（由moduleUI和moduleController定义）。每个实例都有自己的id，因此服务器可以在它们之间进行区分。主UI还包括一对selectInput，每个seelctinput告诉一个模块实例要显示什么。

完成这项工作的关键是将控制mod1 <- callModule(moduleController, "Module1", reactive({input$module1Mode})) 的值传递给模块相应实例的控制器，例如：

moduleController <- function(input, output, session, selector) { ... }

模块控制器功能如下

selector

请注意名为selectInput的附加参数，它对应于控制 observeEvent(selector(), { updateSelectInput(session, "select", choices=choiceLists[[selector()]]) }) 的当前值。该模块使用其对控制器的更改做出反应

  returnValue <- reactive({
    input$select
  })

  return(returnValue)

并使用

将值返回到主服务器

library(shiny)

moduleUI <- function(id) {
  ns <- NS(id)

  wellPanel(
    h4(paste0("This is module id"), id),
    selectInput(ns("select"), label="Make a choice: ", choices=c())
  )
}

moduleController <- function(input, output, session, selector) {
  ns <- session$ns

  choiceLists <- list(
    "Animals"=c("Cat", "Dog", "Rabbit", "Fish"),
    "Fruit"=c("Apple", "Orange", "Pear", "Rambutan"),
    "Sports"=c("Football", "Cricket", "Rugby", "Volleyball"),
    "Countries"=c("Great Britain", "China", "USA", "France")
  )

  observeEvent(selector(), {
    updateSelectInput(session, "select", choices=choiceLists[[selector()]])
  })

  returnValue <- reactive({
    input$select
  })

  return(returnValue)
}

ui <- fixedPage(
  selectInput("module1Mode", label="Select module 1 mode", choices=c("Animals", "Fruit")),
  moduleUI("Module1"),
  selectInput("module2Mode", label="Select module 2 mode", choices=c("Sports", "Countries")),
  moduleUI("Module2"),
  textOutput("mod1Text"),
  textOutput("mod2Text")
)

server <- function(input, output, session) {
  mod1 <- callModule(moduleController, "Module1", reactive({input$module1Mode}))
  mod2 <- callModule(moduleController, "Module2", reactive({input$module2Mode}))

  observe({
    if (is(mod1(), "character")) print("Ah-ha!")
  })

  output$mod1Text <- renderText({
    paste("Module 1 selection is", mod1())
  })

  output$mod2Text <- renderText({
    paste("Module 2 selection is", mod2())
  })
}

shinyApp(ui, server)

如果您使用该应用程序，则会看到该模块的每个实例显示的选择列表可以独立控制，并且服务器可以区分该模块的每个实例返回的值（并对它们做出反应）。

这是完整的代码：

void static jsonStringify(v8::Local<v8::Context> context, v8::Local<v8::Value> value) {
  auto isolate = context->GetIsolate();
  auto global = context->Global();
  auto json = global->Get(context, v8::String::NewFromUtf8(isolate, "JSON", v8::NewStringType::kNormal).ToLocalChecked()).ToLocalChecked().As<v8::Object>();
  auto stringify = json->Get(context, v8::String::NewFromUtf8(isolate, "stringify", v8::NewStringType::kNormal).ToLocalChecked()).ToLocalChecked().As<v8::Function>();
  auto v = stringify->Call(context, Undefined(isolate), 1, &value).ToLocalChecked();
  v8::String::Utf8Value json_value(isolate, v);
  std::cout << "your json value" << &json_value;
}