R 在Shiny中动态创建反应式UI输入和按钮

我希望能够动态添加UI输入，使用输入值，并使操作与动态添加的UI按钮关联

我能找到的最接近的解决方案是，它能处理我需要的前两件事。但是，我不知道如何将被动操作与动态添加的按钮的单击操作相关联

最简单的用例是在许多现代网站上经常看到的（并且使用HTML/CSS/JS很容易实现）：

有一行输入，下面有一个按钮，上面写着“添加”。当您单击“添加”按钮时，会添加另一行，以及该行末尾的一个按钮，该按钮允许您删除该行。通过这种方式，您可以通过单击“添加”按钮在列表底部添加另一行，或者通过单击该行中的“删除”按钮删除显示的任何行

如上面的stackoverflow链接所示，可以使用动态呈现UI外部的按钮添加行。通过在动态呈现的UI之外添加类似的按钮，可以同样轻松地删除行，但这只允许删除最后一行（或某些硬编码的行号）。我想要的是在每一行上都有动态呈现的按钮，当单击时，这些按钮会删除该行

我遇到的主要问题是，假设每一行都有一个ID号1、2、3等，那么每个按钮可能都有一个ID“remove1”、“remove2”、“remove3”等。但是，据我所知，我无法为可能具有可变值的ID创建通用的observeEvent：

observeEvent(input$removei,{
    # remove row i
})

当然，我希望更通用—按钮不一定要删除该行，我可能还希望它打开一个模式/另一个面板，显示与该行相关的数据

有人能提供一些关于如何做到这一点的见解吗？提前谢谢

编辑：一段代码片段（从上面的stackoverflow链接修改），它演示了我想要的内容。理想情况下，我希望能够单击“x”按钮并删除与其关联的行

library(shiny)

ui <- shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
               fluidRow(column(12,
                               h3('Features'),
                               uiOutput('uiOutpt')
               )), # END fluidRow
               fluidRow(
                 column(4,div()),
                 column(4,actionButton("add", "Add!")),
                 column(4,actionButton('goButton',"Analyze"))
               ) # END fluidRow
  ), # END sidebarPanel
  mainPanel(
    verbatimTextOutput("nText"),
    textOutput("text2"),
    tableOutput('tbl')
  )
))

server <- shinyServer(function(input, output) {
  features <- reactiveValues(renderd=c(1))

  ntext <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      # Get input values by namw
      sprintf( 'Variable: %s',input[[vn]] )
    })
    do.call(paste,c(out,sep="\n"))
  })

  df <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      data.frame(Variable=input[[vn]] )
    })
    do.call(rbind,out)
  })

  output$nText <- renderText({
    ntext()
  })
  output$text2 <- renderText({ 
    sprintf("You have selected feature: %s", 
paste(features$renderd,collapse=", "))
  })

  output$tbl <- renderTable({
    df()
  })

  # Increment reactive values used to store how may rows we have rendered
  observeEvent(input$add,{
    if (max(features$renderd) > 2) return(NULL)
    features$renderd <- c(features$renderd, max(features$renderd)+1)
  })

  # If reactive vector updated we render the UI again
  observe({
    output$uiOutpt <- renderUI({
      # Create rows
      rows <- lapply(features$renderd,function(i){
        fluidRow(
          selectInput(paste0('Feature',i), 
                                 label = "", 
                                 choices = 
list("Feature1","Feature2","Feature3"), 
                                 selected = paste0('Feature',i)),   
          actionButton(paste0('remove',i), label="x")
        )
      })
      do.call(shiny::tagList,rows)

    })
  })
})

shinyApp(ui=ui,server=server)

库（闪亮）
ui如果没有一个可重复的例子，很难给你一个好的答案。我认为这应该解决你的问题：

## loop over the ids ( we have an event by id)
for(ii in id_list){
  local({
    ## just wrap the observeEvent part under local
    i <- ii
    observeEvent(input[[paste0("remove",i)]],{
    # remove row i
   })
 )}
}

##在id上循环（我们有一个按id的事件）
用于（id_列表中的ii）{
本地的({
##只需将观察到的部分包在本地
我您似乎正在寻找闪亮的模块，它可以让您创建一组协同工作的ui。您可以在上查看示例。稍后，我将尝试将其调整为适合您的问题

更新：针对问题的闪亮模块自适应

library(shiny)

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

    fluidRow(
        selectInput(ns("Feature"),
                    label = "",
                    choices =
                        list("Feature1","Feature2","Feature3"),
                    selected = paste0("Feature", id)),
        actionButton(ns("remove"), label="x")
    )
}

cellSever <- function(input, output, features, feature, session) {
    observeEvent(input$remove, {
        features$renderd[features$renderd == feature] <- NULL
    })
}

ui <- shinyUI(pageWithSidebar(
    headerPanel("Add Features"),
    sidebarPanel(width=4,
                 fluidRow(column(12,
                                 h3('Features'),
                                 uiOutput('uiOutpt')
                 )), # END fluidRow
                 fluidRow(
                     column(4,div()),
                     column(4,actionButton("add", "Add!")),
                     column(4,actionButton('goButton',"Analyze"))
                 ) # END fluidRow
    ), # END sidebarPanel
    mainPanel(
        verbatimTextOutput("nText"),
        textOutput("text2"),
        tableOutput('tbl')
    )
))

server <- shinyServer(function(input, output) {
    features <- reactiveValues(renderd=list(1))

    ntext <- eventReactive(input$goButton, {
        out <- lapply(features$renderd,function(i){
            vn <- paste0('Feature')
            # Get input values by namw
            sprintf( 'Variable: %s',input[[NS(i)(vn)]] )
        })
        do.call(paste,c(out,sep="\n"))
    })

    df <- eventReactive(input$goButton, {
        out <- lapply(features$renderd,function(i){
            vn <- paste0('Feature')
            data.frame(Variable=input[[NS(i)(vn)]] )
        })
        do.call(rbind,out)
    })

    output$nText <- renderText({
        ntext()
    })
    output$text2 <- renderText({
        sprintf("You have selected feature: %s",
                paste(features$renderd,collapse=", "))
    })

    output$tbl <- renderTable({
        df()
    })

    # Increment reactive values used to store how may rows we have rendered
    observeEvent(input$add,{
        if (features$renderd[[length(features$renderd)]] > 2) return(NULL)
        features$renderd <- c(features$renderd, features$renderd[[length(features$renderd)]]+1)
    })

    # If reactive vector updated we render the UI again
    observe({
        output$uiOutpt <- renderUI({
            # Create rows
            rows <- lapply(features$renderd,function(i){
                fluidRow(
                    cellUI(i)
                )
            })
            lapply(features$renderd, function(i) callModule(cellSever, i, features = features, feature = i))
            do.call(shiny::tagList,rows)

        })
    })
})

shinyApp(ui=ui,server=server)

库（闪亮）
cellUI我找到了一个不错的解决方案，使用闪亮的模块解决了这个问题。它允许你按一个按钮添加行，并根据自己的选择删除任意行。问题之一是，现在行的给定“id”只是不断递增，以确保每个“id”是独一无二的。如果有人有更好的方法，请告诉我。谢谢

library(shiny)

rowInput <- function(id){
  ns <- NS(id)
  fluidRow(
    selectInput(ns(id), 
                label = "", 
                choices = list("Feature1","Feature2","Feature3")),
    conditionalPanel('!output.bool', actionButton(ns('remove'), label="x"))
  )
} 

row <- function(input, output, session, features, id){
  observeEvent(input$remove, {
    if(length(features$renderd) < 2){
      print(features$renderd)
      return()
    }
    features$renderd <- features$renderd[features$renderd != id]
  })
}

ui <- shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
               fluidRow(column(12,
                               h3('Features'),
                               uiOutput('uiOutpt')
               )), # END fluidRow
               fluidRow(
                 column(4,div()),
                 column(4,actionButton("add", "Add!")),
                 column(4,actionButton('goButton',"Analyze"))
               ) # END fluidRow
  ), # END sidebarPanel
  mainPanel(
    verbatimTextOutput("nText"),
    textOutput("text2"),
    tableOutput('tbl'),
    textOutput("bool")
  )
))

server <- shinyServer(function(input, output) {
  features <- reactiveValues(renderd=c(1))

  nextId <- 2
  minModuleCalled <- 0

  output$bool <- reactive({
    length(features$renderd) == 1
  })

  ntext <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      # Get input values by namw
      sprintf( 'Variable: %s',input[[vn]] )
    })
    do.call(paste,c(out,sep="\n"))
  })

  df <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      data.frame(Variable=input[[vn]] )
    })
    do.call(rbind,out)
  })

  output$nText <- renderText({
    ntext()
  })
  output$text2 <- renderText({ 
    sprintf("You have selected feature: %s", 
paste(features$renderd,collapse=", "))
  })

  output$tbl <- renderTable({
    df()
  })

  # Increment reactive values used to store how may rows we have rendered
  observeEvent(input$add,{
    features$renderd <- c(features$renderd, nextId)
    nextId <<- nextId + 1
  })

  # If reactive vector updated we render the UI again
  observe({
    output$uiOutpt <- renderUI({
      # Create rows
      rows <- lapply(features$renderd, function(i){
        rowInput(paste0("Feature",i))
      })
      lapply(features$renderd, function(i){
        if(i > minModuleCalled){
          print(paste("new module",i))
          callModule(row, paste0("Feature",i), features, i)
          minModuleCalled <<- i
        }
      })
      do.call(shiny::tagList,rows)
    })
  })
})

shinyApp(ui=ui,server=server)

库（闪亮）
RoePosits你能更详细地考虑一下放置for循环吗？我需要能够连续地监视“IDILIST”中的可变数量的标签。因此，该值可能会发生很大变化-我看不出通过变化列表的for循环是如何工作的。我将尝试尽快发布一个可复制的示例。@rupayannelogy一旦您放置了一个示例，您可能会获得更多详细信息。将其包装在observe（）中在服务器代码中，我的id_列表是一个被动值。工作起来很有魅力。谢谢。太棒了，我现在会查看链接-如果你能提出一个解决方案，解释如何将这个问题应用到一个闪亮的模块中，我将非常感谢！@rupayannelogy很抱歉回复太晚，我最近很忙。基本上你需要定义
cellUI
和
cellServer
功能。在cellUI和其他地方，您需要使用
input[[NS（id）（“inputname”）]
，
output[[NS（id）（“outputname”）]]
引用特定的输入和输出，在cellServer中，您可以只引用
input$inputname
之类的内容。您可以查看
callModule
，了解有关
cellServer
功能的更多详细信息。这个答案非常有效，但在尝试之后，我得到了一个更强大的解决方案—它仍然是我的不是完美的，所以如果你或其他人想改进它，那就太好了。现在我将对此进行投票，但请将我的答案标记为正确，因为它似乎做了我希望它做得最好的事情。谢谢你的帮助！