Как создать линейную диаграмму, основанную на агрегированных и отфильтрованных данных для блестящей панели инструментов? - PullRequest
Новая
       11

Как создать линейную диаграмму, основанную на агрегированных и отфильтрованных данных для блестящей панели инструментов?

1 голос
/ 04 июля 2019

Итак, я недавно начал экспериментировать с блеском, и мне очень нравится. Однако до сих пор у меня были только очень простые визуализации. Сейчас я пытаюсь создать линейную диаграмму, которая содержит агрегированные данные (amount = yaxis) и основана на конкретных значениях для оси x (YearsMon f.i. 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()
    })
}

Так что я хотел бы видеть в основном линейный график. На оси абсцисс - Поколение (YearMon), которое можно отфильтровать с помощью SliderInput. На яси суммарное количество, так как сумма повторяется многократно в одном и том же году. Поэтому я хотел бы увидеть итоги за год, чтобы составить график. И последнее, но не менее важное: я хочу видеть график для рейтинга A и рейтинга B.

К сожалению, я все еще борюсь с концепцией реактивности и, следовательно, я не знаю, как именно сделать ее реактивной таким образом.

Я попытался найти некоторые решения в Интернете, но нашел только одно, которое совсем не понял ( Панель инструментов линейной диаграммы с агрегированными точками данных ). Так что любая помощь очень ценится!

1 Ответ

1 голос
/ 05 июля 2019

Принимая во внимание комментарий 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)

Обратите внимание, как я добавил столбец Test в 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, вы сможете манипулировать данными, как вы хотите.

...