闪亮的应用程序：删除带有操作按钮的 UI 对象

Question

使用以下代码，可以在 Shiny 中创建 UI 对象。

library(shiny)


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


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

# 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(
  verbatimTextOutput("test1"),
  tableOutput("test2"),
  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line")

)

# 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)

现在，如果我们单击它，我想为每一行添加一个按钮以删除它。

首先我不太明白variables 函数是如何工作的：在函数内部，我们可以看到使用了input$variable，但它怎么知道使用了哪个selectInput？我想我不明白ns("variable") 是如何工作的。

所以现在，很难创建删除按钮。我在尝试： 我使用this link创建了一个删除按钮，但我不知道如何使每个按钮工作。

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(3,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      ),
      column(3,
             actionButton(ns("rmvv"),"Remove UI")
      ),
    )
  )

}

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

# 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"),

  actionButton("rmv", "Remove UI"),
  textInput("txt", "This is no longer useful")
)

# Shiny Server ----

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

  # this remove button works, from https://shiny.rstudio.com/reference/shiny/latest/removeUI.html
  observeEvent(input$rmv, {
    removeUI(
      selector = "div:has(> #txt)"
    )
  })

  # trying to make the following work
  observeEvent(input$rmvv, {
    removeUI(
      selector = "h5"
    )
  })


  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)

Answer 1

应该有多种方法可以做到这一点。 removeUI() 的文档中建议了一个：将添加的 ui 部分包装在带有 id 的 div 中。

那么你的选择器会很容易添加：

removeUI(
        selector = paste0("#var", btn)
)

，其中# 是 jquery 选择器中 id 的标识符。

接下来，您必须添加多个观察事件。这可能令人惊讶，但这实际上可以在其他反应式上下文中完成。因此，在创建新 ui 时添加此侦听器可能是最简单的方法。 所以在observeEvent(input$insertBtn, {...}) 中你可以添加：

observeEvent(input[[paste0("var", btn,"-rmvv")]], {
  removeUI(
    selector = paste0("#var", btn)
  )
})

那么你就有了和你（新添加的）ui 组件一样多的监听器。

潜在的增强功能：

• 最初添加的 ui。

由于您手动添加了一行，因此也必须手动添加相应的侦听器。为了保持代码不会太长，我没有添加这部分，但我很乐意编辑。

• 计算行数

现在你用btn <- sum(input$insertBtn, 1) 来计算用户界面的数量。因此，行的编号是根据添加的单位数量，而不是可见行的数量。因此，如果用户添加 2 行，删除它们并添加另一行，就会有第 1 行和第 4 行。

如果不希望这样做，可以尝试将计数机制放在全局反应变量中。

• 删除服务器端的输入

现在你清理了 ui 端。但是输入在服务器端仍然可用。如果这也应该清理，这里有一个关于如何清理的示例：https://www.r-bloggers.com/shiny-add-removing-modules-dynamically/。

可重现的例子：

library(shiny)


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

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

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

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

  ns <- NS(id)

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

        column(3,
               numericInput(ns("value.variable"),
                            label = paste0("Value ", number),
                            value = 0, min = 0
               )
        ),
        column(3,
               actionButton(ns("rmvv"),"Remove UI")
        ),
      )
    )
  )

}

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

# 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"),

  actionButton("rmv", "Remove UI"),
  textInput("txt", "This is no longer useful")
)

# Shiny Server ----

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

  # this remove button works, from https://shiny.rstudio.com/reference/shiny/latest/removeUI.html
  observeEvent(input$rmv, {
    removeUI(
      selector = "div:has(> #txt)"
    )
  })

  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()
    })

    observeEvent(input[[paste0("var", btn,"-rmvv")]], {
      removeUI(
        selector = paste0("#var", btn)
      )
    })


  })

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

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

}

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

shinyApp(ui, server)