在 Shiny 中根据用户输入汇总和显示数据

Question

我目前正在阅读 Hadley Wickham 的 Mastering Shiny，并探索构建仪表板以用于报告目的背后的流程。

jpdugo17 解决了我的第一个问题，如何使用日期范围和时间段来过滤和分组服务器中的数据框？我尝试将inputId = "daterange_Revenue" 放在带括号的过滤器内，但这并没有给我任何结果。 关于分组，我已经设法使用Chapter 12 中的示例对信息进行分组，但我无法让我的图表显示线性时间。我尝试使用scale_x_continuous(date_labels = "%b %Y")，但它会产生错误并阻止应用程序运行。我的目标是根据用户日期范围输入显示每日、每月或每年的点数。有什么建议吗？

正在进行的代码 V2：

Transactions <- structure(list(Date = structure(c(1577836800, 1577836800, 1580515200, 
                                                  1580515200, 1583020800, 1583020800, 1585699200, 1585699200, 1588291200, 
                                                  1588291200, 1590969600, 1590969600, 1593561600, 1593561600, 1596240000, 
                                                  1596240000, 1598918400, 1598918400, 1601510400, 1601510400, 1604188800, 
                                                  1604188800, 1606780800, 1606780800, 1609459200, 1609459200, 1612137600, 
                                                  1612137600), class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                               total_price = c(2919, 2448, 2308, 1917, 2842, 1496, 2225, 
                                               1501, 1135, 1786, 2129, 1739, 1414, 1810, 2091, 2596, 1191, 
                                               2217, 1084, 2819, 2435, 2418, 1992, 2116, 2312, 1037, 2355, 
                                               2990)), row.names = c(NA, -28L), class = c("tbl_df", "tbl", 
                                                                                         "data.frame"))
ui <- fluidPage(
  dateRangeInput(
    inputId = "daterange_Revenue",
    label = "Choose a date range:",
    start = min(Transactions$Date),
    end = max(Transactions$Date)
  ),
  # User Input Select
  selectInput(
    inputId = "period_Revenue",
    label = "Choose time span:",
    choices = list("Daily" = "Day", "Monthly" = "Month", "Yearly" = "Year"),
    selected = 1
  ),
  #User Select Radio Botton
  radioButtons(
    inputId = "geom_Revenue", 
    label = "Plot type:",
    choices = c("Bar", "Line"),
    selected = "Bar"
  ),
  
  plotOutput(outputId = "graph_revenue")
)


server <- function(input, output) {
  

  # Prepare Data Set
  Transactions_reactive <- reactive({
    Transactions %>%
      mutate(Day= day(Date), 
             Month = month(Date, label = FALSE), 
             MonthName = month(Date, label = TRUE),
             Year = year(Date)) %>%
      filter(Date >= input$daterange_Revenue[1] & Date <= input$daterange_Revenue[2])
  })

  #Time Span
  period_reactive <- reactive({
    if (input$period_Revenue == "Day") {
      Transactions_reactive() %>%
        group_by(Year,Month,Day) %>% #input$period_Revenue
        summarise(revenue = sum(total_price))
    } else if (input$period_Revenue == "Month") {
      Transactions_reactive() %>%
        group_by(Year,Month) %>% #input$period_Revenue
        summarise(revenue = sum(total_price))    
      } else if (input$period_Revenue == "Year"){
        Transactions_reactive() %>%
          group_by(Year) %>% #input$period_Revenue
          summarise(revenue = sum(total_price))
    }
    })
  
  # GEOM SELECTION
  plot_geom <- reactive({
    switch(input$geom_Revenue,
           Bar = geom_col(),
           Line = geom_line()
    )
  })
  
  output$graph_revenue <- renderPlot({
    period_reactive() %>%
      ggplot(aes(.data[[input$period_Revenue]], revenue)) +
      #How to reference geom using user input
      plot_geom() +
      labs(title = str_c("Revenue obtained between ", format(input$daterange_Revenue[1], "%d/%m/%y"), " and ", format(input$daterange_Revenue[2], "%d/%m/%y")),
           caption = str_c("Generated on: ", format(Sys.Date(), "%d/%m/%y")),
           x = "Period",
           y = "Dolar Amount in AUD") +
      theme(plot.title = element_text(hjust = 0.5)) +
      #scale_x_continuous(date_labels = "%b %Y") +
      scale_y_continuous(labels = comma)
    
  })
  
  observe({
    print(names(Transactions_reactive()))
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

您需要在输入名称前添加input$。我对应用程序进行了一些小改动，例如，需要将转到标题的字符串粘贴在一起。

library(shiny)
library(tidyverse)
library(kableExtra)

Transactions <- structure(list(Date = structure(c(1577836800, 1577836800, 1580515200, 
                                                  1580515200, 1583020800, 1583020800, 1585699200, 1585699200, 1588291200, 
                                                  1588291200, 1590969600, 1590969600, 1593561600, 1593561600, 1596240000, 
                                                  1596240000, 1598918400, 1598918400, 1601510400, 1601510400, 1604188800, 
                                                  1604188800, 1606780800, 1606780800, 1609459200, 1609459200, 1612137600, 
                                                  1612137600), class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                               total_price = c(2919, 2448, 2308, 1917, 2842, 1496, 2225, 
                                               1501, 1135, 1786, 2129, 1739, 1414, 1810, 2091, 2596, 1191, 
                                               2217, 1084, 2819, 2435, 2418, 1992, 2116, 2312, 1037, 2355, 
                                               2990)), row.names = c(NA, -28L), class = c("tbl_df", "tbl", 
                                                                                          "data.frame"))



ui <- fluidPage(
  
  titlePanel("Test"),
  
  sidebarLayout(
    sidebarPanel(
      dateRangeInput(inputId = "daterange_Revenue", 
                     label = "Choose a date range:",
                     start = min(Transactions$Date),
                     end = max(Transactions$Date)),
      selectInput(inputId = "period_Revenue",
                  label = "Choose time span:",
                  choices = list("Daily" = "daily", "Monthly" = "monthly", "Yearly" = "yearly"), 
                  selected = 1),
    ),
    
    mainPanel(
      
      tabsetPanel(
        
        tabPanel("Graph", 
                 plotOutput(outputId = "graph_revenue")),
        
        tabPanel("Table", 
                 tableOutput(outputId = "table_revenue"))
      )
    )
  )
)

server <- function(input, output) {
  

  #Prepare Data Set
  Transactions_reactive <- reactive({Transactions %>%
    
    filter(Date >= input$daterange_Revenue[1] & Date <= input$daterange_Revenue[2]) %>%
    
    group_by(input$period_Revenue) %>%
    summarise(revenue = sum(total_price))
  })
  
  
  output$graph_revenue <- renderPlot({
    Transactions_reactive() %>%
    ggplot(aes(input$period_Revenue, revenue)) +
      geom_col() +
      ggtitle(label = str_c("Revenue obtained between ", format(input$daterange_Revenue[1],'%d/%m/%y'), " and ", format(input$daterange_Revenue[2],'%d/%m/%y')),
           subtitle  = str_c("Generated on: ", format(Sys.Date(), '%d/%m/%y')))
    })


    output$table_revenue <- function(){
      Transactions_reactive() %>%
        #rename("Period" = period_Revenue, "Revenue" = revenue) %>%
        knitr::kable(caption = str_c("Revenue obtained between ", format(input$daterange_Revenue[1],'%d/%m/%y'), " and ", format(input$daterange_Revenue[2],'%d/%m/%y'))) %>%
              kableExtra::kable_classic(full_width = T, html_font = "Cambria")
    }
    
    observe({
      print(names(Transactions_reactive()))
    })

  }

shinyApp(ui = ui, server = server)