使用动态数量的ui元素更新模块中的输入

Question

我想编写一个动态数字n的模块,比如UI元素.我发现input插槽与当前的元素数量不对应,但是在会话期间选择的最大数量:

library(shiny)
library(plyr)

testUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns("container"))
}

test <- function(input, output, session, numElems) {
   output$container <- renderUI(do.call(tagList, llply(1:numElems(), function(i) 
            selectInput(session$ns(paste0("elem", i)), 
                        label = i, choices = LETTERS[sample(26, 3)]))))
   getNames <- reactive(reactiveValuesToList(input))
   list(getNames = getNames)
}

ui <- fluidPage(numericInput("n", "Number of Elems", value = 3), 
                testUI("column1"), 
                verbatimTextOutput("debug"))

server <- function(input, output, session) {
   getN <- reactive(input$n)
   handler <- callModule(test, "column1", getN)
   output$debug <- renderPrint(handler$getNames())
}

shinyApp(ui, server)

如果您在数字输入字段,从改变元素的个数3来2,我们看到,仍有3中的元素input.这种行为是故意的吗？如果是这样,我如何更新input它只包含有效的插槽？

更新

以下是2个相关的截图:

Answer 1

我知道 OP 提出这个问题已有 6 年了，但这是我对这个话题的两分钱。

长话短说

这种行为是故意的吗？

我不知道。但它是一致的。renderUI您在示例中使用，我在下面的代表中使用insertUI/ removeUI，并且行为是相同的。

如何更新input以确保它仅包含有效的插槽？

您可以将“无效”插槽设置为NULL，然后使用req()或isTruthy()来检查有效性。

解释

这是我到目前为止所知道的input：

1. input从应用程序的服务器来看是不可变的，除非您使用update*Input()

例如。如果你试试：

input$random_id <- "trial"

你会得到一个错误：Can't modify read-only reactive value 'random_id'。

2. 添加后，您无法从 中删除元素（输入 id）input，但可以更改其值（使用update*Input()或 JavaScript）

3. 将元素的值更改为NULL不会将其从 中删除input。

我的意思是，它的input行为不会像常规列表那样设置元素的值以将NULL其从列表中删除：

x <- list(a = 1, b = 2, c = 3)
x$a <- NULL
x

# $b
# [1] 2
#
# $c
# [1] 3

另外，您不能使用update*Input()将输入 id 的值设置为NULL。从?updateSelectInput：

任何带有值的参数都NULL将被忽略；它们不会导致客户端上的输入对象发生任何更改。

因此，要将元素的值设置input为，NULL您必须使用 JavaScript 并提供选项priority: "event"。参考。

Shiny.setInputValue(input_id, new_input_value, {priority: "event"})

4. 我们可以利用3上面的优势：将不需要的元素（UI 已被删除/删除的输入 id 值）设置为NULL。

这允许我们在需要时使用req()or 。isTruthy()

雷普莱克斯

在下面的表示中，我展示了如何将输入 id 值设置为NULL。

全局R

library(shiny)

ui.R

ui <- fluidPage(
  numericInput("n", "Number of Elems", value = 3), 
  mod_test_ui("column1"), 
  verbatimTextOutput("debug"),
  tags$script(src = "script.js")
)

服务器R

server <- function(input, output, session) {
  handler <- mod_test_server(
    id = "column1",
    numElems = reactive({ input$n })
  )
  output$debug <- renderPrint({ handler$getNames() })
}

R/mod_test_ui.R

mod_test_ui <- function(id) {
  ns <- NS(id)
  tags$div(id = ns("container"))
}

R/mod_test_server.R

mod_test_server <- \(id, numElems) {
  moduleServer(
    id = id,
    module = \(input, output, session) {
      ns <- session$ns
      # reactive to track added UI ids:
      rv_added_ids <- reactiveValues(ids = NULL)
      observeEvent(numElems(), {
        # do nothing if `numElems()` is less than zero:
        n <- numElems()
        if (n < 0) return()
        # remove previously rendered UIs:
        removeUI(
          selector = sprintf("#%s > *", ns("container")),
          multiple = TRUE,
          immediate = TRUE
        )
        # inform JS to set the removed input id values to NULL:
        lapply(rv_added_ids$ids, \(id) {
          session$sendCustomMessage(
            type = "set_to_null",
            list(id = id, value = NULL)
          )
        })
        # reset tracker:
        rv_added_ids$ids <- NULL
        # add new UIs:
        lapply(seq_len(n), \(i) {
          id <- ns(paste0("elem", i))
          # track new id:
          rv_added_ids$ids <- c(rv_added_ids$ids, id)
          insertUI(
            selector = paste0("#", ns("container")),
            where = "beforeEnd",
            ui = selectInput(
              inputId = id, 
              label = i,
              choices = LETTERS[sample(26, 3)]
            )
          )
        }
        )
      })
      getNames <- reactive(reactiveValuesToList(input))
      list(getNames = getNames)
    }
  )
}

www/script.js

$(document).ready(function() {
  Shiny.addCustomMessageHandler("set_to_null", (message) => {
    Shiny.setInputValue(message.id, message.value, {priority: "event"});
  });
});