如何为闪亮的仪表板创建基于汇总和过滤数据的折线图？

Question

So I recently started experimenting with shiny and I like very much. However, so far I had only very simple visualizations. Now I am trying to create a line chart which contains aggregated data (amounts=yaxis) and based on descrete values for the x-axis (YearsMon fi 201901).

So the idea is that i have a slider input where i can specify the range for the years and a filter which enables for me to filter the aggregated data for different categories.

A sample of the data set is provided below.

 Generation Amount Rating
 [1,] "201806"   "100"  "A"   
 [2,] "201807"   "200"  "B"   
 [3,] "201808"   "300"  "A"   
 [4,] "201809"   "200"  "B"   
 [5,] "201810"   "200"  "A"   
 [6,] "201811"   "100"  "B"   
 [7,] "201812"   "130"  "A"   
 [8,] "201901"   "400"  "B"   
 [9,] "201902"   "300"  "A"   
[10,] "201903"   "200"  "B"   
[11,] "201806"   "300"  "A"   
[12,] "201807"   "100"  "B"   
[13,] "201808"   "400"  "A"   
[14,] "201809"   "320"  "B"   
[15,] "201810"   "200"  "A"   
[16,] "201811"   "90"   "B"   
[17,] "201812"   "230"  "A"   
[18,] "201901"   "430"  "B"   
[19,] "201902"   "190"  "A"   
[20,] "201903"   "320"  "B" 

So this is the following code I tryed:

Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )

df1 = cbind(Generation, Amount, Rating)


ui1 <- fluidPage(
  theme = shinytheme("slate"),
                       sidebarLayout(
                         sidebarPanel(
                           sliderTextInput(inputId = "range", 
                                       label = "Choose range", 
                                       choices = Generation, 
                                       selected = range(Generation), 
                                       grid = TRUE),
                           selectInput(inputId = "rat",
                                       label = "Chose the rating",
                                       choices = unique(df1$rating))
                         ),#sidebar panel
                         mainPanel(verbatimTextOutput("graph1")
                         )# closing main panel
                       )# closing sidebarlayout
)# closing fluidpage


server1 = function(input, output) {

  #interactive range
  my_range <- reactive({
    cbind(input$range[1],input$range[2])
  })

  #create the filter
  df_final <- reactive({
    filter(df1, between(Generation,input$range[1],input$range[2])) %>% 
      select(Generation,input$rat) 
  })



  # createn the aggregation 
  df_final2 = reactive({
  df_final() %>%
    select(Generation, Rating, Amount) %>%
    group_by(Generation) %>%
    summarise(sum_amount = sum(Amount))
  })

  # plot the graph 
  output$graph1 <- renderPlot({

    req(df_fianl2())

     ggplot(df_final2(), aes(x = Generation, y = sum_amount)) +
      geom_line(aes(colour = Rating)) +
      geom_point()
    })
}

So what I would like to see is basically a line chart. On the x-axis the Generation (YearMon) which can be filtered with the SliderInput. On the yaxis the aggregated amount since the amount repeat themself multiple times in the same year. So I would like to see the total for the year in order to plot it. Last but not least I want to be able to see the plot for rating A and rating B.

Unfortunetly, I still struggle with the reactivity concept and therefore, I dont know how exactly to make it reactive in this way.

I tryed looking up some solutions online but I found only one which I did not understand at all ( Line Chart Dashboard with Aggregated Data Points ). So any help is highly appriciated!

Answer 1

Taking GyD 's comment into account, here is a simple example. I have simplified your code and there is still room for improvement:

library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)

Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )

df1 = data.frame(Generation, Amount, Rating)


ui1 <- fluidPage(
    theme = shinytheme("slate"),
    sidebarLayout(
        sidebarPanel(
            sliderTextInput(inputId = "range", 
                            label = "Choose range", 
                            choices = Generation, 
                            selected = range(Generation), 
                            grid = TRUE),
            selectInput(inputId = "rat",
                        label = "Choose the rating",
                        choices = unique(df1$Rating))
        ),#sidebar panel
        mainPanel(plotOutput("graph1")
        )# closing main panel
    )# closing sidebarlayout
)# closing fluidpage


server1 = function(input, output) {

    #interactive range
    # my_range <- reactive({
    #     cbind(input$range[1],input$range[2])
    # })

    #create the filter and aggregation
    df_final <- reactive({
        df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat) %>% 
            group_by(Generation, Rating) %>%
            summarise(sum_amount = sum(Amount))
    })

    # plot the graph 
    output$graph1 <- renderPlot({

        req(df_final())

        ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
            geom_line(aes(colour = Rating)) +
            geom_point()
    })
}

shinyApp(ui1, server1)

Update

For question 1 from the comment below:

library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)

Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )
Test <- c(1, 2, 1, 1, 1, 2, 2, 1, 2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 2, 1)

df1 = data.frame(Generation, Amount, Rating, Test)


ui1 <- fluidPage(
    theme = shinytheme("slate"),
    sidebarLayout(
        sidebarPanel(
            sliderTextInput(inputId = "range", 
                            label = "Choose range", 
                            choices = Generation, 
                            selected = range(Generation), 
                            grid = TRUE),
            selectInput(inputId = "rat",
                        label = "Choose the rating",
                        choices = unique(df1$Rating)),
            selectInput(inputId = "test",
                        label = "Choose the test",
                        choices = unique(df1$Test))
        ),#sidebar panel
        mainPanel(plotOutput("graph1")
        )# closing main panel
    )# closing sidebarlayout
)# closing fluidpage


server1 = function(input, output) {

    #interactive range
    # my_range <- reactive({
    #     cbind(input$range[1],input$range[2])
    # })

    #create the filter and aggregation
    df_final <- reactive({
        df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat, Test == input$test) %>% 
            group_by(Generation) %>%
            summarise(sum_amount = sum(Amount))
    })

    # plot the graph 
    output$graph1 <- renderPlot({

        req(df_final())

        ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
            geom_line() +
            geom_point()
    })
}

shinyApp(ui1, server1)

Notice how I added a Test column to df1 and both Rating and Test are in filter but not group_by.

For question 2 from the comment below:

library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)

Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )

df1 = data.frame(Generation, Amount, Rating)


ui1 <- fluidPage(
    theme = shinytheme("slate"),
    sidebarLayout(
        sidebarPanel(
            sliderTextInput(inputId = "range", 
                            label = "Choose range", 
                            choices = Generation, 
                            selected = range(Generation), 
                            grid = TRUE),
            selectInput(inputId = "rat",
                        label = "Choose the rating",
                        choices = c("A", "B", "A & B - one line", "A & B - two lines"))
        ),#sidebar panel
        mainPanel(plotOutput("graph1")
        )# closing main panel
    )# closing sidebarlayout
)# closing fluidpage


server1 = function(input, output) {

    #interactive range
    # my_range <- reactive({
    #     cbind(input$range[1],input$range[2])
    # })

    #create the filter and aggregation
    df_final <- reactive({
        if(input$rat %in% c("A", "B")) {
            df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat) %>% 
                group_by(Generation) %>%
                summarise(sum_amount = sum(Amount))
        }else if(input$rat == "A & B - one line"){
            df1 %>% filter(between(Generation,input$range[1],input$range[2])) %>% 
                group_by(Generation) %>%
                summarise(sum_amount = sum(Amount))
        }else if(input$rat == "A & B - two lines"){ # this if isn't necessary but included for clarity
            df1 %>% filter(between(Generation,input$range[1],input$range[2])) %>% 
                group_by(Generation, Rating) %>%
                summarise(sum_amount = sum(Amount))
        }

    })

    # plot the graph 
    output$graph1 <- renderPlot({

        req(df_final())
        if(input$rat != "A & B - two lines"){
            ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
                geom_line() +
                geom_point()
        }else{
            ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
                geom_line(aes(colour = Rating)) +
                geom_point()
        }

    })
}

shinyApp(ui1, server1)

Notice how only the two lines option needs a colour parameter. Basically, the selectInput or radioButton just indicates the selection in the ui (you can rename these as you desire), the real work happens in the server. Again, I'm sure there are other ways of doing this but if you master the tidyverse functions you'll be able to manipulate the data as you wish.