Question

我正在学习闪亮，并使用连接到许多selectizeInputs的numericInput。

如果数字输入等于1或2，我想分别创建1和2个selectizeInputs，并为每个selectizeInput EDIT选择一个名为“modalities”的向量的“i”模态：那些选择=仅仅是模态[i]（而非模态）
如果数字输入等于3或4，我想分别创建3个和4个selectizeInputs，它们相互连接（选择=模态）。换句话说：如果在其中一个选择输入中选择了一个项目，我希望它从其他选择输入的选项中消失。

另外（这就是我遇到的麻烦）我想在每次修改numericInput时“重置”所有选定的SelectizeInput。我尝试使用下面的observeEvent并试图使用隔离（输入$ ui_number），但我没有找到任何解决方案，因为我不明白该怎么做...！

感谢您的帮助！

      library(shiny)

      modalities <- LETTERS[1:10]

      ui = tabPanel("Change modalities",
                    numericInput("ui_number", label = "Number of modalities",
                                 min = 1, max = 4, value = 3),
                    uiOutput("renderui")
      )

      server = function(input, output, session) {

        # Generate modalities select lists
        output$renderui <- renderUI({
          output = tagList()
          for (i in seq_len(input$ui_number)) {
            output[[i]] = selectizeInput(paste0("ui_mod_choose", i), 
                                         label = paste0("Modality ", i),
                                         choices = modalities, multiple = TRUE)
          }
          return(output)
        })


        # if input$ui_number is modified to 3 or 4 : set selected to NULL ##### NOT WORKING
        observeEvent({input$ui_number},
                     {
                       n <- input$ui_number
                       if(n%in%c(3,4)){
                         for (i in seq_len(n)) {
                           updateSelectizeInput(session, paste0("ui_mod_choose",i),selected=NULL)
                         }
                       }

                     }

        )


        observe({

          n <- input$ui_number

          if(n%in%c(1,2)){ #if n=1 or 2 =>  Select the "i"th modality for each selectizeInput
            for (i in seq_len(n)) {
              updateSelectizeInput(session, paste0("ui_mod_choose",i),
                                   choices = modalities[i],
                                   selected = modalities[i]
              )
            }

          } else{   # if n=3 or 4 => Remove selected modalities from other select lists
            for (i in seq_len(n)) {
              vecteur <- unlist(lapply((1:n)[-i], function(i) 
                input[[paste0("ui_mod_choose",i)]]))
              updateSelectizeInput(session, paste0("ui_mod_choose",i),
                                   choices = setdiff(modalities, vecteur),
                                   selected = input[[paste0("ui_mod_choose",i)]])
            }

          }




        })

      }

      runApp(shinyApp(ui, server))

此问题对应于以下内容：

lapply function using a numericInput parameter around an observeEvent in RShiny

EDIT2：感谢@Aurèle的小提示。 剩下的唯一问题是1：100的lapply可能需要一些时间来加载（没有找到添加反应内容的解决方案，例如1：输入＆amp; ui_number围绕条件面板）

      library(shiny)

      modalities <- LETTERS[1:10]

      make_conditional_selectizeInputs <- function() {
        do.call(
          div,
          lapply(1:100, function(i)
            conditionalPanel(
              condition = sprintf("%d <= input.ui_number", i),
              selectizeInput(sprintf("ui_mod_choose%d", i), 
                             label = sprintf("Modality %d", i),
                             choices = character(0), multiple = TRUE, selected = NULL)
            )
          )
        )
      }



      ui <- tabPanel(
        "Change modalities",
        uiOutput("rendernumeric"),
        #numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L),
        make_conditional_selectizeInputs()
      )


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

        max <- 4

        output$rendernumeric <- renderUI({
          numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L)
        })





        n <- reactive({
          n <- input$ui_number
          if (is.null(n) || is.na(n) || !n >= 0) 0 else n
        })

        # Reset all
        observeEvent(
          eventExpr = n(), 
          handlerExpr = for (i in seq_len(max))
            updateSelectizeInput(
              session, sprintf("ui_mod_choose%d", i),
              choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities, 
              selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
            )
        )

        all_selected <- reactive({
          unlist(lapply(seq_len(max), function(i) 
            input[[sprintf("ui_mod_choose%d", i)]]))
        })

        # Update available modalities
        observeEvent(
          eventExpr = all_selected(),
          handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
            x <- input[[sprintf("ui_mod_choose%d", i)]]
            other_selected <- setdiff(all_selected(), x)
            updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
                                 choices = setdiff(modalities, other_selected),
                                 selected = x)
          }
        )

      }

      runApp(shinyApp(ui, server))

Answer 1

基本上，只要您重新生成selected = if (n %in% 1:2) modalities[i] else NULL，就需要再增加一行：selectizeInput。

library(shiny)

modalities <- LETTERS[1:10]

ui = tabPanel("Change modalities",
              numericInput("ui_number", label = "Number of modalities",
                           min = 1, max = 4, value = 3),
              uiOutput("renderui"))

server = function(input, output, session) {

  # Generate modalities select lists
  output$renderui <- renderUI({
    output = tagList()
    n <- input$ui_number
    n <- if (is.null(n) || is.na(n) || ! n >= 0) 0 else n
    for (i in seq_len(n)) {
      output[[i]] = selectizeInput(paste0("ui_mod_choose", i), 
                                   label = paste0("Modality ", i),
                                   choices = if (n %in% 1:2) modalities[i] else modalities, 
                                   multiple = TRUE,
                                   # Add this
                                   selected = if (n %in% 1:2) modalities[i] else NULL)
    }
    output
  })

  # Remove selected modalities from other select lists
  observe({
    n <- isolate(input$ui_number)
    if (!n %in% 1:2) for (i in seq_len(n)) {
      vecteur <- unlist(lapply((1:n)[-i], function(i) 
        input[[paste0("ui_mod_choose",i)]]))
      updateSelectizeInput(session, paste0("ui_mod_choose",i),
                           choices = setdiff(modalities, vecteur),
                           selected = input[[paste0("ui_mod_choose",i)]])
    }
  })

}

runApp(shinyApp(ui, server))

Answer 2

（这与单独的答案不同）。

在https://shiny.rstudio.com/articles/dynamic-ui.html中，建议采用四种不同的Shiny动态UI方法，按难度排序：

conditionalPanel函数，用于ui.R并包装一组需要动态显示/隐藏的UI元素。

renderUI功能（server.R与uiOutput中的ui.R功能一起使用）可让您生成对UI功能的调用并使结果显示在用户界面中的预定位置。

insertUI和removeUI函数，在server.R中使用，允许您添加和删除任意数量的UI代码（彼此独立），可以根据需要多次添加和删除，随时随地都可以。

使用JavaScript修改网页

你的尝试使用第二种方法，这个答案使用第一种方法（虽然它应该可以与任何方法一起使用）：

library(shiny)

modalities <- LETTERS[1:10]
max <- 4L

首先，构建UI的辅助函数。 selectizeInput的数量不再是动态的，而是固定为max，并且它们会根据input$ui_number显示/隐藏：

make_conditional_selectizeInputs <- function(max) {
  do.call(
    div,
    lapply(seq_len(max), function(i)
      conditionalPanel(
        condition = sprintf("%d <= input.ui_number", i),
        selectizeInput(sprintf("ui_mod_choose%d", i), 
                       label = sprintf("Modality %d", i),
                       choices = character(0), multiple = TRUE, selected = NULL)
      )
    )
  )
}

ui <- tabPanel(
  "Change modalities",
  numericInput("ui_number", label = "Number of modalities",
               min = 1L, max = max, value = 1L),
  make_conditional_selectizeInputs(max)
)

服务器函数有两个反应式表达式，它们有助于模块化代码，但对其逻辑（n()和all_expected()）并不重要。

不再有renderUI()（selectizeInput已经一劳永逸地生成了。

有observeEvent()依赖input$ui_number并在更改时重置所有选择和选项。

最后observeEvent()依赖于所有input$ui_mod_choose[i]，并在有新选择时更新所有选项。

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

  n <- reactive({
    n <- input$ui_number
    if (is.null(n) || is.na(n) || !n >= 0) 0 else n
  })

  # Reset all
  observeEvent(
    eventExpr = n(), 
    handlerExpr = for (i in seq_len(max))
      updateSelectizeInput(
        session, sprintf("ui_mod_choose%d", i),
        choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities, 
        selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
      )
  )

  all_selected <- reactive({
    unlist(lapply(seq_len(max), function(i) 
      input[[sprintf("ui_mod_choose%d", i)]]))
  })

  # Update available modalities
  observeEvent(
    eventExpr = all_selected(),
    handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
      x <- input[[sprintf("ui_mod_choose%d", i)]]
      other_selected <- setdiff(all_selected(), x)
      updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
                           choices = setdiff(modalities, other_selected),
                           selected = x)
    }
  )

}

基本上它与第二种方法（renderUI）的不同之处在于它删除了input$ui_number和input$ui_mod_choose[i]之间的部分依赖关系，至少在它们生成时（但由于updateSelectizeInput而导致重置，因此存在剩余依赖关系。我并不完全清楚为什么我可以使用此方法而不是renderUI使用它

runApp(shinyApp(ui, server))

这是reactlog的截图，虽然它没有显示整个图片，因为updateSelectizeInput()的必要杂质混合了UI和服务器逻辑，创建循环依赖，可能很难理解：

每次修改RShiny

2 个答案: