Question

要过滤包含大量变量的data.frame，我创建了一个selectizeInput，您可以选择其中一列数据。然后，这将为所选变量创建另一个selectizeInput，该变量可用于对数据进行子集化。第二个selectizeInput的选定值将在下方呈现。

这就是它的样子

我想渲染这些输入的选定值，以便用户可以通过单击黑色十字来删除这些值。当过滤器selectizeInput更改为var1时，也不应删除选择的var2。

所以它看起来应该是这样的（假设用户先前在var2中选择了值z，然后在var1中为a值。

任何人都知道shiny中有一个很好的解决方案吗？

这是代码：

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)

Answer 1

好吧，我不得不重新排列很多，这整个问题更多的是为你的案例找到合适的实现。

你可以在本帖子末尾看一下代码中的大部分内容。

主要内容解释：您实际上没有说出删除对您意味着什么。所以我假设您希望细胞不再出现在选择框中。为此，我排除了NAs并用NA替换了单元格，以表明它们已被删除。

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

最重要的是，您想要创建的按钮是带有动态观察者的动态UI元素，然后将其发送到删除特定单元格。

注意：此解决方案不是最佳解决方案，因为我专门针对仅留在R的{{1}}侧。如果您使用shiny和有光泽的自定义消息，则可以实现更加优雅且节省资源的解决方案。

另外：如果第一个选择框发生更改，我没有解决您的选择值。但是，如果您重新考虑您的设置，这是一个相当小的问题。而且我并不想与原始代码分歧太多而不会混淆。

现在代码：

JavaScript

Answer 2

这就是我现在拥有的。还有一些我无法解决的问题。

问题：

如果我在input1中做了一些选择，然后从input1切换到input2并从input1中取消选择其中一个选项，然后切换回input1，这些更改将被取消
添加新复选框时会重新呈现复选框，并在此过程中对已更改顺序

代码：

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)

以闪亮方式渲染输入值，以便这些选择可删除

2 个答案: