r - 使用 actionButtons 根据索引动态添加和删除 uiOutput 元素

Question

我正在尝试添加和删除 uiOutput元素使用索引来跟踪每个单独的元素。有一个actionButton用于向列表中添加和元素，以及 x 删除所选项目的每个元素的按钮，如下图所示:



我正在使用一个包含 ui 的 .Rmd 文件和 server代码。我目前的解决方案(我无法产生上面显示的所需功能——它基本上什么都不做)如下:

actionButton("addFilter", "Add filter", icon=icon("plus", class=NULL, lib="font-awesome"))

i <- 0

observeEvent(input$addFilter, {
  i <<- i + 1
  uiOutput(paste("filterPage",i,sep=""))

  output[[paste("filterPage",i,sep="")]] = renderUI({
    fluidPage(
      fluidRow(
        column(6, selectInput(paste("filteringFactor",i,sep=""), "Choose factor to filter by:",
                              choices=c("factor A", "factor B", "factor C"), selected="factor B",
                              width="100%")),
        column(6, actionButton(paste("removeFactor",i,sep=""), "",
                               icon=icon("times", class = NULL, lib = "font-awesome")))
      )
    )
  })

  observeEvent(input[[paste("removeFactor",i,sep="")]], {
    output[[paste("filterPage",i,sep="")]] = renderUI({})
  })

})

当我放 uiOutput和删除按钮 observeEvent添加按钮之外 observeEvent代码有效，但我需要每个索引有一个单独的语句，如下所示:

uiOutput(paste("filterPage",1,sep=""))
uiOutput(paste("filterPage",2,sep=""))
uiOutput(paste("filterPage",3,sep=""))
uiOutput(paste("filterPage",4,sep=""))

actionButton("addFilter", "Add filter", icon=icon("plus", class=NULL, lib="font-awesome"))

i <- 0

observeEvent(input$addFilter, {
  i <<- i + 1
  output[[paste("filterPage",i,sep="")]] = renderUI({
    fluidPage(
      fluidRow(
        column(6, selectInput(paste("filteringFactor",i,sep=""), "Choose factor to filter by:",
                              choices=c("factor A", "factor B", "factor C"), selected="factor B",
                              width="100%")),
        column(6, actionButton(paste("removeFactor",i,sep=""), "",
                               icon=icon("times", class = NULL, lib = "font-awesome")))
      )
    )
  })
})

observeEvent(input[[paste("removeFactor",1,sep="")]], {
  output[[paste("filterPage",1,sep="")]] = renderUI({})
})
observeEvent(input[[paste("removeFactor",2,sep="")]], {
  output[[paste("filterPage",2,sep="")]] = renderUI({})
})
observeEvent(input[[paste("removeFactor",3,sep="")]], {
  output[[paste("filterPage",3,sep="")]] = renderUI({})
})
observeEvent(input[[paste("removeFactor",4,sep="")]], {
  output[[paste("filterPage",4,sep="")]] = renderUI({})
})

我无法创建 for 循环或 lapply打电话上类(这看起来像是我不明白的范围问题)。由于预先硬编码不知道元素的数量，因此这些值对我不起作用。有谁知道如何使这项工作？谢谢。

Answer 1

我为您提供了一个修复程序，这在后端可能不美观，但使生活变得非常轻松。我建议您将所有元素嵌套在一起。制作 uiOutput号码 i包含 uiOutput对于下一个。这样，您可以连续添加它们，而无需担心元素的大小或总数。性能方面这也没关系，特别是因为我认为您不会创建数千个过滤器。有关更多详细信息，请参阅代码。

对于删除，您已经看到跟踪所有按钮输入值很乏味。所以我建议你设计一个变量来观察，它告诉你被点击的元素编号。我们可以通过自定义 onclick 来实现这一点我们的按钮的函数，将按钮编号发送到一个单一的输入变量。您可能想让自己熟悉 JavaScript 客户端函数 Shiny.onInputChange .简单地说:它在给定的变量名下向 R 后端发送一个值。

删除相应的 ui 元素很容易。

如果您想深入了解并设计更清晰、更精细的解决方案，请尝试 this page和相关问题。在那里您可以获得有关如何设计动态 ui 块并将其添加到文档中的输入，而无需使用常用的单个 uiOutput wrapper 。

下面的代码(我做了一个普通的 ui-server 应用程序):

library(shiny)

ui <- shinyUI(
  fluidPage(

    actionButton("addFilter", "Add filter", icon=icon("plus", class=NULL, lib="font-awesome")),

    uiOutput("filterPage1")
  )
)

server <- function(input, output){
  i <- 0

  observeEvent(input$addFilter, {
    i <<- i + 1
    output[[paste("filterPage",i,sep="")]] = renderUI({
      list(
        fluidPage(
          fluidRow(
            column(6, selectInput(paste("filteringFactor",i,sep=""), "Choose factor to filter by:",
                                choices=c("factor A", "factor B", "factor C"), selected="factor B",
                                width="100%")),
            column(6, actionButton(paste("removeFactor",i,sep=""), "",
                                 icon=icon("times", class = NULL, lib = "font-awesome"),
                                 onclick = paste0("Shiny.onInputChange('remove', ", i, ")")))
          )
        ),
        uiOutput(paste("filterPage",i + 1,sep=""))
      )
    })
  })

  observeEvent(input$remove, {
    i <- input$remove

    output[[paste("filterPage",i,sep="")]] <- renderUI({uiOutput(paste("filterPage",i + 1,sep=""))})
  })
}

shinyApp(ui, server)