Shiny - 将用户选择的观察添加/附加到观察列表中以进行分析

Question

我正在开发的 Shiny 应用程序的用户界面应该以下列方式工作：

1. 用户在应用一组过滤器后找到所需的观察结果。
2. 用户单击“添加”操作按钮，因此选定的观察结果被添加到要分析的观察结果的运行列表/向量/等中。
3. 用户修改过滤器以查找要包含的其他观察结果。
4. 根据用户需要多次循环回到步骤 1。

我似乎找不到保存此待分析观察列表的方法。在我附加的示例中，“观察 ID”是汽车型号的名称（使用 mtcars）。我也没有包括任何数据分析，因为我认为这没有必要。本质上，整个数据集 (mtcars) 应该在响应式环境中使用 dplyr 进行过滤，以仅包含所选观察的运行列表。

代码如下：

data("mtcars")
mtcars$model <- rownames(mtcars)

ui <- fluidPage(
    
    
    titlePanel("sample"),
    
    
    sidebarLayout(
        sidebarPanel(
            uiOutput("disp"),
            uiOutput("qsec"),
            uiOutput("model"),
            actionButton("add", "Add"),
            uiOutput("selectedModel")
        ),
        
        
        mainPanel(
            plotOutput("data_analysis")
        )
    )
)

server <- function(input, output) {
    
    output$disp <- renderUI({
        selectInput(
            "disp_sel",
            "Select disp:",
            unique(mtcars$disp),
            selected = NULL,
            multiple = T,
            selectize = T
        )
    })
    
    output$qsec <- renderUI({
        
        temp = mtcars
        
        if (!is.null(input$disp_sel)){temp = temp %>% filter(disp %in% input$disp_sel)}
        
        selectInput(
            "qsec_sel",
            "Select qsec:",
            unique(temp$qsec),
            selected = NULL,
            multiple = T,
            selectize = T
        )
    })
    
    output$model <- renderUI({
        temp = mtcars
        if (!is.null(input$disp_sel)){temp = temp %>% filter(disp %in% input$disp_sel)}
        if (!is.null(input$qsec_sel)){temp = temp %>% filter(qsec %in% input$qsec_sel)}
        
        selectInput(
            "model_sel",
            "Select model:",
            unique(temp$model),
            selected = NULL,
            multiple = T,
            selectize = T
        )
        
    })
    
    output$selectedModel <- renderUI({
        req(input$add)
        
        selectInput(
            "list_of_selections",
            "Selected models:",
            unique(mtcars$model),
            selected = NULL, # this should change when "Add" is pressed
            multiple = T,
            selectize = T
        )
        
    })
    
    r_data = eventReactive(input$add,{
        mtcars %>% filter(model %in% input$list_of_selections)
    })
    
    output$data_analysis <- renderPlot({
        # do something with r_data (filtered data)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

我研究了模块化代码、反应式列表和其他我什至不记得的东西......非常感谢任何帮助。

Answer 1

试试这个

data("mtcars")
mtcars$model <- rownames(mtcars)

df1 <- mtcars

ui <- fluidPage(
  
  
  titlePanel("sample"),
  
  
  sidebarLayout(
    sidebarPanel(
      uiOutput("disp"),
      uiOutput("qsec"),
      uiOutput("model"),
      actionButton("add", "Add"),
      uiOutput("selectedModel")
    ),
    
    
    mainPanel(
      DTOutput("selecteddata"),
      plotOutput("data_analysis")
    )
  )
)

server <- function(input, output) {
  
  output$disp <- renderUI({
    selectInput(
      "disp_sel",
      "Select disp:",
      unique(mtcars$disp),
      selected = NULL,
      multiple = T,
      selectize = T
    )
  })
  
  output$qsec <- renderUI({
    
    temp = mtcars
    
    if (!is.null(input$disp_sel)){temp = temp %>% filter(disp %in% input$disp_sel)}
    
    selectInput(
      "qsec_sel",
      "Select qsec:",
      unique(temp$qsec),
      selected = NULL,
      multiple = T,
      selectize = T
    )
  })
  
  output$model <- renderUI({
    temp = mtcars
    if (!is.null(input$disp_sel)){temp = temp %>% filter(disp %in% input$disp_sel)}
    if (!is.null(input$qsec_sel)){temp = temp %>% filter(qsec %in% input$qsec_sel)}
    
    selectInput(
      "model_sel",
      "Select model:",
      unique(temp$model),
      selected = NULL,
      multiple = T,
      selectize = T
    )
    
  })
  
  selected_data <- eventReactive(input$add,{
    df1 %>% filter(model %in% input$model_sel)
  })
  
  output$selecteddata <- renderDT(
    selected_data(), # reactive data
    class = "display nowrap compact", # style
    filter = "top", # location of column filters
    options = list(  # options
      scrollX = TRUE # allow user to scroll wide tables horizontally
    )
  )
  
  output$selectedModel <- renderUI({
    req(input$add)
    
    selectInput(
      "list_of_selections",
      "Selected models:",
      choices = unique(selected_data()$model),
      selected = unique(selected_data()$model), # this should change when "Add" is pressed
      multiple = T,
      selectize = T
    )
    
  })
  
  r_data = eventReactive(input$add,{
    mtcars %>% filter(model %in% input$list_of_selections)
  })
  
  output$data_analysis <- renderPlot({
    ggplot(data=selected_data(), aes(x=disp, y=qsec)) + geom_point()
    # do something with r_data (filtered data)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

找到了答案。我包括了

selected <- reactiveValues(s = NULL)
observeEvent(input$add,{selected$s = c(selected$s, input$model})

进入服务器部分。然后将选中的模型存储在selected$s中。