From 626dc8f24df5fdd803c89e8945b43874e3e6ff4c Mon Sep 17 00:00:00 2001 From: patrycjalazna Date: Wed, 23 Jun 2021 14:40:48 +0200 Subject: [PATCH] streamgraph added --- proj3/projekt.R | 172 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 117 insertions(+), 55 deletions(-) diff --git a/proj3/projekt.R b/proj3/projekt.R index be5fb4c..20e70b9 100644 --- a/proj3/projekt.R +++ b/proj3/projekt.R @@ -1,5 +1,6 @@ +# dataset: https://www.kaggle.com/aiaiaidavid/airplane-crash-fatalities-since-1908-dv-03032020 # setup srodowiska #### -install.packages('shinyjs') +setwd('/Users/patrycjalazna/Desktop/wizualizacja-danych/projekt_3/') # importy #### library(shiny) @@ -57,64 +58,57 @@ airplane_crashes$btwn_6PM_6AM <- if_else # ShinyApp #### -load_data <- function() { - Sys.sleep(2) - hide("loading_page") - show("main_content") -} + ui <- fluidPage( - useShinyjs(), - div( - id = "loading_page", - h1("Loading...") - ), - hidden( - div( - id = "main_content", - navbarPage("Airplane crashes from 1908 to 2020", - tabPanel("General overview", - sidebarLayout( - sidebarPanel( - # wybór daty - dateRangeInput('dates', - 'Date range:', - min(airplane_crashes$Date), - max(airplane_crashes$Date)), - # wybor godziny - timeInput("time", "Time (local):", seconds = FALSE) - ), - mainPanel( - # wykresiki - plotlyOutput("weekdayCrashes") - - ) - ) - ), - tabPanel("Map", - mainPanel( - # mapy - plotlyOutput("mapPlot") - #plotOutput("mapPlot") - ) - ), - tabPanel("Data", - sidebarPanel( - dateRangeInput('dataDates', - 'Date range:', - min(airplane_crashes$Date), - max(airplane_crashes$Date)) - ), - mainPanel( - DT::dataTableOutput('allData') - )) - ) - ) + id = "main_content", + navbarPage("Airplane crashes from 1908 to 2020", + tabPanel("General overview", + sidebarLayout( + sidebarPanel( + # wybór daty + dateRangeInput('dates', + 'Date range:', + min(airplane_crashes$Date), + max(airplane_crashes$Date)), + # wybor godziny + timeInput("time", "Time (local):", seconds = FALSE) + ), + mainPanel( + # wykresiki + plotlyOutput("weekdayCrashes") + + ) + ) + ), + tabPanel("Streamgraph", + mainPanel( + streamgraphOutput("operatorCrashes") + ) + ), + + tabPanel("Map", + mainPanel( + # mapy + plotlyOutput("mapPlot") + #plotOutput("mapPlot") + ) + ), + tabPanel("Data", + sidebarPanel( + dateRangeInput('dataDates', + 'Date range:', + min(airplane_crashes$Date), + max(airplane_crashes$Date)) + ), + mainPanel( + DT::dataTableOutput('allData') + )) ) ) + server <- function(input, output, session) { - load_data() # godzina observe(print(strftime(input$time, "%R"))) @@ -147,6 +141,32 @@ server <- function(input, output, session) { }) + + output$operatorCrashes <- renderStreamgraph({ + + main_type_wise_year <- airplane_crashes %>% + select(Year, Type) %>% + # replace model number by empty strings + mutate(main_type = str_replace_all(Type, "[A-Za-z]*-?\\d+-?[A-Za-z]*.*", "")) %>% + # skip empty strings row + filter(main_type > 'A') %>% + group_by(Year, main_type) %>% + summarize(n = n()) %>% + group_by(Year) %>% + top_n(5, n) + + # i teraz z tego streamgraph + main_type_wise_year <- main_type_wise_year %>% arrange(-n) + streamgraph <- main_type_wise_year %>% + group_by(Year, main_type) %>% + tally(wt=n) %>% + streamgraph("main_type", "n", "Year", interpolate="cardinal") %>% + sg_fill_brewer("PuOr") %>% + sg_legend(TRUE) + + streamgraph + }) + output$mapPlot <- renderPlotly({ states_list <- c('Alabama','Alaska','Alaksa','Arizona','Arkansas',"California", @@ -226,7 +246,7 @@ server <- function(input, output, session) { scale_fill_manual(values = map_pal, na.value = 'whitesmoke') + theme(legend.position='right', legend.justification = "top") + guides(fill = guide_legend(reverse = TRUE)) - + ggplotly( p = ggplot_obj, tooltip = "all", @@ -239,7 +259,7 @@ server <- function(input, output, session) { # poprawic szerkosc wierszy output$allData <- DT::renderDataTable({ airplane_crashes %>% - # filter(Year == input$dataDates) %>% + # filter(Year == input$dataDates) %>% DT::datatable() }) @@ -247,3 +267,45 @@ server <- function(input, output, session) { shinyApp(ui = ui, server = server) + + + +# tutaj sb rysuje wykresiki demo, zeby nie odpalac shiny za kazdym razem #### + +# number of fatal accidents by operator - top 5 + +## +# extract and group by manufacturer +# main_type_wise_year <- airplane_crashes %>% +# select(Year, Type) %>% +# # replace model number by empty strings +# mutate(main_type = str_replace_all(Type, "[A-Za-z]*-?\\d+-?[A-Za-z]*.*", "")) %>% +# # skip empty strings row +# filter(main_type > 'A') %>% +# group_by(Year, main_type) %>% +# summarize(n = n()) %>% +# group_by(Year) %>% +# top_n(5, n) +# #%>% mutate(main_type = reorder_within(-n, main_type, Year)) +# +# # i teraz z tego streamgraph +# main_type_wise_year <- main_type_wise_year %>% arrange(-n) +# main_type_wise_year %>% +# group_by(Year, main_type) %>% +# tally(wt=n) %>% +# streamgraph("main_type", "n", "Year", interpolate="cardinal") %>% +# sg_fill_brewer("PuOr") %>% +# sg_legend(TRUE) + +#### +# airplane_operators <- airplane_crashes %>% count(Operator, sort = TRUE) +# airplane_operators <- head(airplane_operators, 5) +# ggplot(airplane_operators, aes(x = Operator, y = n)) + +# geom_point(color = "#765432", alpha = 0.8) + +# labs(title = "No. of fatal accidents by operator", x = '', y = '') +# +# airplane_operators %>% +# streamgraph(key="Operator", value=, date="Year", offset="zero") %>% +# sg_fill_brewer("BuPu") + +# wykres ile wypadkow kazdego operatora w kazdym roku