R Shiny 显示没有过滤器输入的完整数据帧，直到改变过滤器输入

Question

我正在尝试构建一个将数据框显示为数据表的应用程序。我想为用户提供使用侧边栏面板上的 selectinput 和 daterangeinput 过滤器对数据表进行子集化的能力。

当我遇到问题时，

• 仅在选择所有输入时才对数据表进行子集化
• 它在加载应用程序时显示一个空数据表
• 当其中一个输入被改回时，它不会更新 数据表。

这是我的闪亮应用示例代码

Region <- c("USA","UK","JPN","JPN","UK","USA","USA")
Company <- c("A","B","C","A","B","C","A")
Status <- c("Completed","In Production","In Design","New","In Production","In Design","New")
date <- c("2015-05-01","2015-05-01","2015-06-04","2015-06-20","2015-07-15","2015-08-12","2015-08-12")
date <- as.Date(date,"%Y-%m-%d")

df <- data.frame(Region, Company, Status, date)

ui文件是

ui.R

shinyUI(
   fluidPage(
       titlePanel("Summary"),

sidebarLayout(
        sidebarPanel(

            selectInput("region", 
                        label = "Choose a Region",
                        choices = c("", unique(df$Region))),

            selectInput("company", 
                        label = "Choose a company",
                        choices = c("", unique(df$Company))),

            selectInput("status", 
                        label = "Choose Proj status",
                        choices = c("", unique(df$Status))),

            dateRangeInput("projdate", 
                        label = "Date of interest:",
                        start = Sys.Date() - 60, 
                        end = Sys.Date())
            ),

        mainPanel(
            dataTableOutput("table")
        )
        )
    ))

服务器文件是

    server.R

shinyServer(function(input,output){

    output$table <- renderTable({
    datadf %>% as.data.frame() %>% filter(Region == input$region & Company == input$company & Status == input$status)
        })
})

当应用启动时，它不会在未应用任何过滤器的情况下显示表格。 我不确定我是否在 output$table 函数中做所有事情以获得我想要的输出。

如果有人可以指导我如何在没有任何用户输入的情况下显示数据表，然后数据表会随着用户输入的更改而更新。

我尝试将输入因子放置在响应式环境中，但随后弹出没有响应式上下文的操作。

Answer 1

服务器.R

shinyServer(function(input,output,session){


  data_update <- reactive({

    # Compose data frame
    data.frame(
      Name = c("Region", 
               "Company",
               "Status"),
      Value = as.character(c(input$region, 
                             input$company,
                             input$status)), 
      stringsAsFactors=FALSE)
  }) 

  # Show the values using an HTML table
  output$table <- renderTable({
    data_update()
  })
})

UI.R

shinyUI(
  fluidPage(
    titlePanel("Summary"),

    sidebarLayout(
      sidebarPanel(

        selectInput("region", 
                    label = "Choose a Region",
                    choices = c("", unique(df$Region)), selected= '1'),

        selectInput("company", 
                    label = "Choose a company",
                    choices = c("", unique(df$Company)), selected= '1'),

        selectInput("status", 
                    label = "Choose Proj status",
                    choices = c("", unique(df$Status)), selected= '1'),

        dateRangeInput("projdate", 
                       label = "Date of interest:",
                       start = Sys.Date() - 60, 
                       end = Sys.Date())
      ),

      mainPanel(
        tableOutput("table")
      )
    )
  ))

GLOBAL.R

library(shiny)
library(dplyr)
library(DT)

Region <- c("USA","UK","JPN","JPN","UK","USA","USA")
Company <- c("A","B","C","A","B","C","A")
Status <- c("Completed","In Production","In Design","New","In Production","In Design","New")
date <- c("2015-05-01","2015-05-01","2015-06-04","2015-06-20","2015-07-15","2015-08-12","2015-08-12")
date <- as.Date(date,"%Y-%m-%d")

df <- data.frame(Region, Company, Status, date)

我还建议使用 DT 包来绘制表格。

希望对您有所帮助！干杯

Answer 2

===更新答案===

这是一个可行的解决方案。

library(shiny)
library(dplyr)

Region <- c("USA","UK","JPN","JPN","UK","USA","USA")
Company <- c("A","B","C","A","B","C","A")
Status <- c("Completed","In Production","In Design","New","In Production","In Design","New")
date <- c("2015-05-01","2015-05-01","2015-06-04","2015-06-20","2015-07-15","2015-08-12","2015-08-12")
date <- as.Date(date,"%Y-%m-%d")

df <- data.frame(Region, Company, Status, date)

ui <- shinyUI(
  fluidPage(
    titlePanel("Summary"),

    sidebarLayout(
      sidebarPanel(

        selectInput("region", 
                    label = "Choose a Region",
                    choices = c("", as.vector(unique(df$Region)))),

        selectInput("company", 
                    label = "Choose a company",
                    choices = c("", as.vector(unique(df$Company)))),

        selectInput("status", 
                    label = "Choose Proj status",
                    choices = c("", as.vector(unique(df$Status)))),

        dateRangeInput("projdate", 
                       label = "Date of interest:",
                       start = Sys.Date() - 60, 
                       end = Sys.Date())
      ),

      mainPanel(
        tableOutput("table")
      )
    )
  ))

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

  output$table <- renderTable({
    region_sel <- if (nchar(input$region)==0) unique(as.vector(df$Region)) else input$region
    company_sel <- if (nchar(input$company)==0) unique(as.vector(df$Company)) else input$company
    status_sel <- if (nchar(input$status)==0) unique(as.vector(df$Status)) else input$status

    filter(df, Region %in% region_sel, Company %in% company_sel, Status %in% status_sel)
  })
})

shinyApp(ui = ui, server = server)

===上一个答案===

不是直接的答案，但这里有一个非常相似的示例，可能会对您有所帮助。

library(shiny)
library(dplyr)

ui <- shinyUI(fluidPage(

   titlePanel("Old Faithful Geyser Data"),

   sidebarLayout(
      sidebarPanel(
        selectInput("cyl", "cyl", unique(mtcars$cyl), multiple = TRUE),
        selectInput("vs", "vs", unique(mtcars$vs), multiple = TRUE),
        selectInput("am", "am", unique(mtcars$am), multiple = TRUE)
      ),

      mainPanel(
         tableOutput("table")
      )
   )
))

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

    output$table <- renderTable({
        cyl_sel <- if (is.null(input$cyl)) unique(mtcars$cyl) else as.numeric(input$cyl)
        vs_sel <- if (is.null(input$vs)) unique(mtcars$vs) else as.numeric(input$vs)
        am_sel <- if (is.null(input$am)) unique(mtcars$am) else as.numeric(input$am)
        filter(mtcars, cyl %in% cyl_sel, vs %in% vs_sel, am %in% am_sel)
    })

})

shinyApp(ui = ui, server = server)