Shinyのフィルタ設定を保存して読み込む

Question

光沢のあるダッシュボードに追加して、フィルタ設定を保存して読み込むことができます。そのユーザーは、多くのフィルタ設定を保存し、名前を付けてリストから読み込む可能性があると思います。

参考になるテンプレートや例を知っている人はいますか？私は任意のテンプレートについては知らないが、あなたがあなた自身を書くことができ

Answer 1

：

1. 私は、UIの最初の列に入力を定義しました。
2. セッションはあなたがsaveボタンでフィルタの設定を保存するか、注意するloadボタン

他のものでそれらをロードすることができた後

を開始したときに、デフォルト値が初期化されています

• フィルタ設定をファイル/ dbに保存して、ユーザー/セッション間でそれらを使用できるようにすることができます。
• 既存の名前のフィルタを保存するのを無視しました。上書きすることもできます。

コード：

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)