R Shiny app - 渲染数据表条件

Posted 2023-03-24

【中文标题】R Shiny app - 渲染数据表条件

【英文标题】：RShiny app - rendering data table conditions

【发布时间】：2021-02-05 22:54:22

【问题描述】：

此反应函数的目标是在 RShiny 应用程序的初始测试期间显示原始 starwars 数据集（可从 dplyr 库中获得）。

在当前场景下，用户必须先点击Run Query才能弹出数据，然后可以进入过滤器，进行相应的过滤，再次点击Run Query才能显示结果。

理想的目标是让最终用户首先弹出数据，然后用户可以选择他们想要的过滤器，然后点击Run Query 以显示相应的结果。

任何帮助将不胜感激！谢谢！

library(DT)
library(shiny)
library(shinydashboard)
library(dplyr)
library(dbplyr)
library(tidyverse)
library(DBI)

ui <- function(request) 
  dashboardPage(
    dashboardHeader(title = "SW Pivot"),
    dashboardSidebar(
      actionButton("runit", "RUN QUERY"),
      hr(),
      h4(html("&nbsp"), "Filter Data Set"),
      
      uiOutput("hairColorFilter"),
      uiOutput("skinColorFilter")
    ),
    dashboardBody(dataTableOutput("data"))
    
  )


data <- starwars

server<-shinyServer(function(input, output, session) 
  
  # Identify Filter Choices -----------------------------------------------
  
  hairColorChoices <- sort(unique(data$hair_color))
  skinColorChoices <- sort(unique(data$skin_color))
  
  # Define User Inputs ----------------------------------------------------
  
  output$hairColorFilter <- renderUI(
    sidebarMenu(
      menuItem(
        text = "Hair Color",
        icon = icon("briefcase"),
        checkboxGroupInput(
          inputId = "hairColorChoices",
          label = NULL,
          choices = hairColorChoices,
          selected = hairColorChoices
        )
      )
    )
  )
  
  output$skinColorFilter <- renderUI(
    sidebarMenu(
      menuItem(
        text = "Skin Color",
        icon = icon("thermometer-half"),
        checkboxGroupInput(
          inputId = "skinColorChoices",
          label = NULL,
          choices = skinColorChoices,
          selected = skinColorChoices
        )
      )
    )
  )
  
  # Table Data --------------------------------------------------------------
  
  filterData <- reactive(
    input$runit

    isolate(
      filterData <- data %>%
        filter(
          hair_color %in% input$hairColorChoices,
          skin_color %in% input$skinColorChoices
        )
    )
  )
  
  output$data <- renderDataTable(
    filterData()
    
  )
)

shinyApp(ui, server)

【参考方案1】：

一种方法是创建一个可以在开头显示的reactiveValues 对象。然后eventReactive 可以创建过滤数据。试试这个

server<-shinyServer(function(input, output, session) 
  
  DF1 <- reactiveValues(data=NULL)
  # Identify Filter Choices -----------------------------------------------
  
  hairColorChoices <- sort(unique(data$hair_color))
  skinColorChoices <- sort(unique(data$skin_color))
  
  # Define User Inputs ----------------------------------------------------
  
  output$hairColorFilter <- renderUI(
    sidebarMenu(
      menuItem(
        text = "Hair Color",
        icon = icon("briefcase"),
        checkboxGroupInput(
          inputId = "hairColorChoices",
          label = NULL,
          choices = hairColorChoices,
          selected = hairColorChoices
        )
      )
    )
  )
  
  output$skinColorFilter <- renderUI(
    sidebarMenu(
      menuItem(
        text = "Skin Color",
        icon = icon("thermometer-half"),
        checkboxGroupInput(
          inputId = "skinColorChoices",
          label = NULL,
          choices = skinColorChoices,
          selected = skinColorChoices
        )
      )
    )
  )
  
  # Table Data --------------------------------------------------------------
  
  filterData <- eventReactive(input$runit, 
    
    isolate(
      filterData <- data %>%
        filter(
          hair_color %in% input$hairColorChoices,
          skin_color %in% input$skinColorChoices
        )
    )
  )
  
  observe(
    DF1$data <- starwars
    if (!is.null(filterData())) DF1$data <- filterData()
  )
  
  output$data <- renderDataTable(
    DF1$data
  )
)

shinyApp(ui, server)

【讨论】：

太棒了，谢谢！有没有办法使用“反应式”功能来创建过滤数据集？

如果您的目标是在单击“运行查询”时更新表，event reactive 就足够了。但是，如果您想在用户更改选择时更新表（不单击运行查询），请将eventReactive 更改为reactive。请注意，filteredData 是响应式的。

【参考方案2】：

我会试试这个来代替你为# Table Data 提供的东西。不要忘记关闭server 之后的最后一个)。在我闪亮的应用程序中，我使用observeEvent 进行此类操作。翻译成文字...当我按下runit 按钮时，我想使用我的inputs 过滤data，然后将该数据提供给DT 输出。

observeEvent(input$runit, 
    
      filterData <- data %>%
        filter(
          hair_color %in% isolate(input$hairColorChoices),
          skin_color %in% isolate(input$skinColorChoices)
        )
    
  output$data <- renderDataTable(
    DT::datatable(filterData)
  )

)