R 以闪亮的颜色呈现输入值，以便这些选择是可删除的

为了过滤带有大量变量的

data.frame

，我创建了一个

selectizeInput

，允许您选择数据的一列。然后为所选变量创建另一个

selectizeInput

，该变量可用于对数据进行子集设置。第二个

selectizeInput

的选定值如下所示

这就是它看起来的样子

我希望呈现这些输入的选定值，以便用户可以通过单击黑十字删除这些值。此外，当筛选器

selectizeInput

更改为var1时，不应删除对var2的选择

所以它应该是这样的（假设用户之前在var2中选择了值z，然后在var1中选择了值a）

有人知道一个好的解决方案吗

代码如下：

library(shiny)

data <- data.frame(var1 = c("a", "b"), var2 = c("y", "z"))

ui <- fluidPage(
  selectizeInput("filter", label = "Filter",
    multiple = FALSE, choices = c("var1", "var2")),
  uiOutput("filter_var"),
  uiOutput("selected_filter_value")
)

server <- function(input, output) {
  observeEvent(input$filter, {
    # dynamically generate selectizeInput for filter
    output$filter_var <- renderUI({
      selectizeInput(input$filter, label = input$filter,
        choices = data[input$filter], multiple = TRUE)
    })
  })

  # show selected filter values
  # selected filter values should stay when choosing new input filter variable
  # these should be deletable
  observeEvent(input[[input$filter]], {
    output$selected_filter_value <- renderUI({
      textOutput("text_out")
    })
    output$text_out <- renderText({
      paste0(input$filter, ": ", input[[input$filter]])
    })
  })
}

shinyApp(ui, server)

库（闪亮）
数据嗯，我不得不重新安排了很多，而整个问题更多的是为您的案例找到正确的实现

你可能只需看看这篇文章末尾的代码就可以推断出其中的大部分

主要说明：您实际上没有说明删除对您意味着什么。因此我只是假设您希望单元格不再出现在选择框中。为此，我排除了
NAs
，并将单元格替换为
NA
，以显示它们已被删除

我重新排列了select值，这样我们实际上可以删除某些单元格，给出行和列名，而不仅仅是它们的值

最重要的是，您要创建的按钮是带有动态观察者的动态UI元素，然后对这些元素进行寻址以删除特定单元格

注意：这个解决方案不是最优的，因为我的目标是只停留在
shinny
的
R
方面。如果使用
JavaScript
和shinny的自定义消息，您可以获得一个更加优雅和节省资源的解决方案

另外：如果第一个选择框发生更改，我没有处理您让所选值可见的请求。但是如果您重新考虑设置，这是一个相当小的问题。我不想与您的原始代码有太多分歧，以免混淆

立即编码：

library(shiny)

data <- data.frame(var1 = c("a", "b"), var2 = c("y", "z"))

ui <- fluidPage(
  selectizeInput("filter", label = "Filter",
                 multiple = FALSE, choices = c("var1", "var2")),
  uiOutput("filter_var"),
  uiOutput("selected_filter_value")
)

server <- function(input, output) {

  # Pulled out from original observeEvent
  makeSecondInput <- function() {

    output$filter_var <- renderUI({

      # Names are not enough when wanting to delete data.frame rows (because of duplicates).
      # So we instead use row numbers and set the actual values as labels.
      choiceData <- na.exclude(data[input$filter])
      choices <- rownames(choiceData)
      names(choices) <- choiceData[, input$filter]

      selectizeInput(input$filter, label = input$filter, selected = input[[input$filter]],
                     choices = choices, multiple = TRUE)
    })
  }

  observeEvent(input$filter, {
    makeSecondInput()
  })

  # Install a manual trigger to redraw input field, when an option is killed.
  trigger <- reactiveVal()
  observeEvent(trigger(), ignoreNULL = TRUE, {
    makeSecondInput()
  })

  # Keep track of created observers, so dynamic creation does not wildly stack them up.
  observersCreated <- character()
  makeButtonObserver <- function(buttonname, colname, rowname) {

    # For each delete-button created, install observer to delete data.frame cell.
    observeEvent(input[[buttonname]], {

      data[rowname, colname] <<- NA

      # Force re-evaluation of observer above.
      trigger(runif(1))
    })

    # Track that this button is equipped. (And re-creation of the same button does not add another obs.)
    # Note: Observers DON'T get automagically removed after actionButton is no longer in the UI.
    observersCreated <<- c(observersCreated, buttonname)
  }

  observeEvent(input[[input$filter]], {

    output$selected_filter_value <- renderUI({

      # Could be a list, so splitting that up.
      lapply(input[[input$filter]], function(v) {

        buttonname <- paste("kill", input$filter, v, sep = "_")

        if (!(buttonname %in% observersCreated)) {
          makeButtonObserver(buttonname, input$filter, v)
        }

        span(
          paste0(input$filter, ": ", data[v, input$filter]),
          actionButton(buttonname, "x")
        )
      })
    })
  })
}

shinyApp(ui, server)

库（闪亮）
数据这就是我目前拥有的。仍然有一些问题我无法解决

问题：


如果我在input1中进行一些选择，然后从input1切换到input2，然后从input1中取消单击其中一个选择，然后切换回input1，这些更改将被取消编码
当添加新复选框时，复选框将重新排序，并在此过程中排序，从而更改顺序

代码：

库（闪亮）
图书馆（shinyWidgets）
数据将
selectInput（'in6'，'Options'，state.name，multiple=TRUE，selectize=TRUE）
成为您的一个选项？对不起，我不明白这将如何解决问题？您能提供一个最简单的工作示例吗？右下角的一个，。。。
library(shiny)
library(shinyWidgets)

data <- data.frame(var1 = c("a", "b"), var2 = c("y", "z"))

ui <- fluidPage(
  selectizeInput("filter", label = "Filter",
    multiple = FALSE, choices = c("var1", "var2")),
  uiOutput("filter_var"),
  uiOutput("selected_filter_value")
)

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

  values <- reactiveValues(
    filter_vals = list(var1 = list(), var2 = list()),
    observers = NULL
  )

  # dynamically generate selectizeInput for variable selected in filter
  # set selected values to previous selections
  observeEvent(input$filter, {
    output$filter_var <- renderUI({
      selectInput(input$filter, label = input$filter,
        selected = values$filter_vals[[input$filter]],
        choices = data[input$filter], multiple = TRUE, selectize = TRUE)
    })
  })

  # store selected values in list
  observeEvent(input[[input$filter]], {
    values$filter_vals[[input$filter]] <- input[[input$filter]]
  })

  # we need this because observeEvent is not triggered if input is empty after deleting all selections
  observe({
    if (is.null(input[[input$filter]])) {
      values$filter_vals[[input$filter]] <- list()
    }
  })

  # add an observer for newly created checkbox
  # if checkbox is clicked delete entry in list
  # keep a list of all existing observers
  make_delete_observer <- function(name) {
    observeEvent(input[[name]], {
      req(input[[name]] == FALSE)
      var <- stringr::str_split(name, "_")[[1]][1]
      val <- as.integer(stringr::str_split(name, "_")[[1]][2])
      values$filter_vals[[var]] <- intersect(values$filter_vals[[var]][-val],
        values$filter_vals[[var]])
      updateSelectInput(session, var, selected = values$filter_vals[[var]])
    })
  }

  # render selected values which are stored in a list as checkboxes
  # add an observeEvent for each checkbox
  # store selected values in list
  output$selected_filter_value <- renderUI({
    req(values$filter_vals[[input$filter]])
    req(any(sapply(values$filter_vals, length) > 0))
    tag_list <- tagList()
    for (i in seq_along(values$filter_vals)) {
      for (j in seq_along(values$filter_vals[[i]])) {
        new_input_name <- paste0(names(values$filter_vals)[i], "_", j)
        new_input <- prettyCheckbox(
          inputId = new_input_name, value = TRUE,
          label = paste0(names(values$filter_vals)[i], ": ", values$filter_vals[[i]][j]),
          icon = icon("close"), status = "danger", outline = FALSE, plain = TRUE
        )
        # create observer only if it does not exist yet
        if (!(new_input_name %in% values$observers)) {
          values$observers <- append(values$observers, new_input_name)
          make_delete_observer(new_input_name)
        }
        tag_list <- tagAppendChild(tag_list, new_input)
      }
    }
    tag_list
  })
}

shinyApp(ui, server)