首页 > 解决方案 > 如何为闪亮的仪表板创建基于聚合和过滤数据的折线图?

问题描述

所以我最近开始尝试闪亮,我非常喜欢。然而,到目前为止,我只有非常简单的可视化。现在我正在尝试创建一个折线图,其中包含聚合数据(数量 = yaxis)并基于 x 轴的离散值(YearsMon fi 201901)。

所以我的想法是我有一个滑块输入,我可以在其中指定年份的范围和一个过滤器,使我能够过滤不同类别的聚合数据。

下面提供了数据集的示例。

 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" 

所以这是我尝试的以下代码:


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()
    })
}

所以我想看到的基本上是一个折线图。在 x 轴上,可以使用 SliderInput 过滤的 Generation (YearMon)。在 y 轴上,自金额在同一年重复多次以来的总金额。所以我想看看今年的总数以便绘制它。最后但并非最不重要的一点是,我希望能够看到评级 A 和评级 B 的情节。

不幸的是,我仍然对反应性概念感到困惑,因此,我不知道如何以这种方式使其具有反应性。

我尝试在网上查找一些解决方案,但我只找到了一个我根本不理解的解决方案(带有聚合数据点的折线图仪表板)。因此,任何帮助都非常受欢迎!

标签: rfiltershinyshinydashboard

解决方案


考虑到GyD的评论,这里是一个简单的例子。我已经简化了你的代码,还有改进的余地:

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)

更新

对于以下评论中的问题 1:

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)

请注意我如何向 df1 添加了一个测试列,并且评级和测试都在过滤器中,但不在 group_by 中。

对于下面评论中的问题2:

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)

注意只有两行选项需要颜色参数。基本上,selectInput 或radioButton 只是表示用户界面中的选择(您可以根据需要重命名),真正的工作发生在服务器中。同样,我确信还有其他方法可以做到这一点,但如果你掌握了 tidyverse 函数,你将能够随心所欲地操纵数据。


推荐阅读