反应式过滤和添加闪亮

Question

我正在尝试根据独特的值创建一个反应性计数。

假设您将年龄滑块调整为 Age >= 50 和 Current Score >= 10，它返回 1571 个唯一客户 ID 的计数，然后显示在表格中。然后您单击Add to List 按钮并添加那些1571。但与此同时，那些 1571 也会从您正在使用的过滤数据集中删除。现在，在您进行添加后，所有输入都会自行重置。然后假设你想用Current Score >= 20添加所有西班牙裔人，所以你移动我设置它的方式，它会返回一个值 310，但是通过过滤设置到我想要实现的目标，它会仅返回尚未过滤掉的唯一客户 ID，这些 ID 将被添加到总计数/表中。

这有意义吗？

df <- read.csv('https://raw.githubusercontent.com/gooponyagrinch/sample_data/master/datasheet.csv')

ui <- fluidPage(
  fluidRow(
    column("",
           width = 10, offset = 1,
           tags$h3("Select Area"),
           panel(
             sliderInput("current", "Current Score", min = 0, max = 100, value = 20),
             sliderInput("projected", "Projected Score", min = 0, max = 100, value = 20),
             sliderInput("age", "Age", min = 18, max = max(df$age), value = c(18,24)),
             checkboxGroupInput("ethnicity", label = "Ethnicity", 
                                choices = list("Caucasian" = "Caucasian",
                                               "African-American" = "African-American",
                                               "Hispanic" = "Hispanic",
                                               "Other" = "Other")),
             checkboxInput('previous', label = "Previous Sale"),
             checkboxInput('warm', label = "Warm Lead"),
             actionButton("button", "Add to List")), 
           textOutput("counter"),
           DT::dataTableOutput("table")
    )
  )
)

server <- function(input, output, session) {

  filtered_df <- reactive({

    res <- df %>% filter(current_grade >= input$current)
    res <- res %>% filter(projected_grade >= input$projected)
    res <- res %>% filter(age >= input$age[1] & age <= input$age[2])
    res <- res %>% filter(ethnicity %in% input$ethnicity | is.null(input$ethnicity))

    if(input$previous == TRUE)
      res <- res %>% filter(previous_sale == 1)

    if(input$warm == TRUE)
      res <- res %>% filter(warm_lead == 1)

    res
  })

  output$counter <- renderText({
    res <- filtered_df() %>% select(customer_id) %>% n_distinct()
    res
  })

  output$table <- renderDataTable({
    res <- filtered_df() %>% distinct(customer_id)
    res
  })
}

shinyApp(ui, server)

Answer 1

应该这样做

library(shiny)
library(tidyverse)
library(DT)
df <- read.csv("https://raw.githubusercontent.com/gooponyagrinch/sample_data/master/datasheet.csv")

ui <- fluidPage(
  fluidRow(
    column("",
      width = 10, offset = 1,
      tags$h3("Select Area"),
      div(
        sliderInput("current", "Current Score",
          min = 0, max = 100, value = 20
        ),
        sliderInput("projected", "Projected Score",
          min = 0, max = 100, value = 20
        ),
        sliderInput("age", "Age",
          min = 18, max = max(df$age), value = c(18, 24)
        ),
        checkboxGroupInput("ethnicity",
          label = "Ethnicity",
          choices = list(
            "Caucasian" = "Caucasian",
            "African-American" = "African-American",
            "Hispanic" = "Hispanic",
            "Other" = "Other"
          )
        ),
        checkboxInput("previous", label = "Previous Sale"),
        checkboxInput("warm", label = "Warm Lead"),
        actionButton("button", "Add to List")
      ),
      textOutput("counter"),
      p("Remaining Input Table"),
      DT::dataTableOutput("input_table"),
      p("Filtered Table"),
      DT::dataTableOutput("filtered_table"),
      p("Accumulated Table"),
      DT::dataTableOutput("accumulated_table")
    )
  )
)

accumulated_df <- reactiveVal(NULL)
df <- reactiveVal(df)

server <- function(input, output, session) {



  filtered_df <- reactive({
    res <- df() %>% filter(current_grade >= input$current)
    res <- res %>% filter(projected_grade >= input$projected)
    res <- res %>% filter(age >= input$age[1] & age <= input$age[2])
    res <- res %>% filter(ethnicity %in% input$ethnicity | is.null(input$ethnicity))

    if (input$previous == TRUE) {
      res <- res %>% filter(previous_sale == 1)
    }

    if (input$warm == TRUE) {
      res <- res %>% filter(warm_lead == 1)
    }

    res
  })

  output$counter <- renderText({
    res <- filtered_df() %>%
      select(customer_id) %>%
      n_distinct()

    res
  })

  observeEvent(input$button, {

    if(! is.null(accumulated_df()))
    accumulated_df(
      union(
        accumulated_df(),
        filtered_df()
      )
    ) else 
      accumulated_df( filtered_df())



    df(setdiff(df(),
               filtered_df())

    )

  })

  output$input_table <- renderDataTable({
    df()
  })
  output$filtered_table <- renderDataTable({
    filtered_df()
  })
  output$accumulated_table <- renderDataTable({
    accumulated_df()
  })
}

shinyApp(ui, server)