反应式过滤和添加闪亮

Posted 2023-03-24

【中文标题】反应式过滤和添加闪亮

【英文标题】：Reactive filtering and adding in shiny

【发布时间】：2020-04-11 15:52:46

【问题描述】：

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

假设您将年龄滑块调整为 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)

【问题讨论】：

您可以通过任何方式共享数据或使您的代码与示例数据一起工作。会更容易理解你在追求什么。

@teofil 啊，我以为我之前做了那个编辑。抱歉，它现在在新脚本中。另外：df <- read.csv('https://raw.githubusercontent.com/gooponyagrinch/sample_data/master/datasheet.csv')

@gooponyagrinch 你的问题很不清楚。也许发布您想要实现的每个步骤的 R 闪亮应用程序的屏幕截图

【参考方案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)

【讨论】：

感谢您的回答。我可以问一下这部分是做什么的，为什么它不在server 方面：accumulated_df2 <- reactiveVal(NULL) df2 <- reactiveVal(df2)

我没有写任何'df2'？

但一般情况下，reactiveVal 会实例化一个反应变量，您可以在服务器端引用该变量。我不认为它需要在服务器端启动，但如果它是，或者你更喜欢它，把它移到那里。

shiny.rstudio.com/reference/shiny/1.3.0/reactiveVal.html

accumulated_df()reactiveVal 被初始化为一个全局变量，而不是 UI 变量，如果这是混乱的来源。我建议您在服务器函数中对其进行初始化，原因很简单，即在全局中存储响应式意味着响应式由应用程序的所有会话共享。我认为演示解决方案避免了由此产生的任何后果，但您应该养成只在服务器函数中使用响应式的习惯