R 保存和加载屏幕中的过滤器设置

我想添加到Shining dashboard中，以保存和加载过滤器设置。我认为用户应该有可能保存许多过滤器设置，给它们命名并从列表中加载它们

---

有人知道有哪些模板或示例可以帮助您吗？

我不知道有哪些模板，但您可以自己编写：

我在UI的第一列中定义了输入

默认值在会话启动时初始化

之后，您可以使用

save

按钮保存过滤器设置，或使用

load

按钮加载过滤器设置

其他需要注意的事项：

• 您可以将过滤器设置保存到文件/db，以便在用户/会话之间使用它们
• 我忽略了使用现有名称保存过滤器。也可以覆盖它

代码：

库（闪亮）
图书馆（shinyjs）
图书馆（dplyr）
太好了！这是我需要的东西。我需要对它进行一点扩展，但现在我有了一个基本代码。谢谢。
library(shiny)
library(shinyjs)
library(dplyr)

ui <- fluidPage(
  useShinyjs(),

  wellPanel(
  fluidRow(
      column(4, 
             sliderInput("sepal_length", label = "Select Sepal length", min = 0, max = 10, value = c(4, 6), step = 0.2),
             sliderInput("sepal_width", label = "Select Sepal length", min = 0, max = 10, value = c(4, 6), step = 0.2)
      ),
      column(2,
             h4("Save/Load filter settings"),
             selectInput("filters", label = "Load filters", choices = NULL),
             textInput("name", ""),
             actionButton("save", label = "Save"),
             actionButton("load", label = "Load")      
      )
    ) 
  ),
  tableOutput("out")
)

server <- function(input, output, session) {
  init <- F
  rv <- reactiveValues(filters = NULL)

  observeEvent(input$save, ignoreNULL = F, {
    if(!init) {
      rv$filters <- data.frame(
        id = "default",
        sepal_length_min = input$sepal_length[1],
        sepal_length_max = input$sepal_length[2],
        sepal_width_min = input$sepal_width[1],
        sepal_width_max = input$sepal_width[2],
        stringsAsFactors = F) 
      init <<- T
    } else {

      if(input$name == "") shinyjs::alert("Filters should be named!")
      else {
        if(input$name %in% rv$filters$id) {
          shinyjs::alert(sprintf("Cannot save filter: %s already exists", input$name))
        } else {
          rv$filters <- rbind(rv$filters, c(
            id = input$name,
            sepal_length_min = input$sepal_length[1],
            sepal_length_max = input$sepal_length[2],
            sepal_width_min = input$sepal_width[1],
            sepal_width_max = input$sepal_width[2]))
        }
      }
    }

    updateTextInput(session, "name", value = "")
    updateSelectInput(session, "filters", choices = rv$filters$id)
  })

  observeEvent(input$load, {
    selected <- rv$filters %>% filter(id == input$filters)

    updateSliderInput(session, "sepal_length", value = c(selected$sepal_length_min, selected$sepal_length_max))
    updateSliderInput(session, "sepal_width", value = c(selected$sepal_width_min, selected$sepal_width_max))
  })


  output$out <- renderTable(iris %>% filter(
    between(Sepal.Length, input$sepal_length[1], input$sepal_length[2]),
    between(Sepal.Width, input$sepal_width[1], input$sepal_width[2])
  ))
}

shinyApp(ui, server)