闪亮的应用程序：使用操作按钮删除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组件一样多的侦听器。

潜在的增强功能

：

• 最初添加的用户界面。

由于您手动添加了一行，因此相应的侦听器也必须手动添加。为了使代码不会太长，我没有添加此部分，但是我很高兴进行编辑。

• 计算行数

现在，您用btn <- sum(input$insertBtn, 1)计算ui的数量。因此，这些行是按曾经添加的单位数量而不是可见行的数量进行编号的。因此，如果用户添加两行，将其删除并添加另一行，则将出现第1行和第4行。

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

• 删除服务器端的输入

现在，您已经清理了用户界面。但是输入仍将在服务器端可用。如果还需要清理，请参见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)