Question

我想添加闪亮的仪表板，以保存和加载过滤器设置。我想用户应该可以保存许多过滤器设置，为它们命名并从列表中加载它们。

有谁知道任何有用的模板或示例？

Answer 1

我不知道任何模板，但您可以编写自己的模板：

我在UI的第一列中定义了输入。
会话启动时初始化默认值
之后，您可以使用save按钮保存过滤器设置，或使用load按钮

其他注意事项：

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

代码：

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)

在Shiny中保存和加载过滤器设置

1 个答案: