s434742/wizualizacja-danych
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

streamgraph added

Browse Source
This commit is contained in:
patrycjalazna 2021-06-23 14:40:48 +02:00
parent 998979918f
commit 626dc8f24d
1 changed files with 117 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
proj3/projekt.R
View File

@ -1,5 +1,6 @@
# dataset: https://www.kaggle.com/aiaiaidavid/airplane-crash-fatalities-since-1908-dv-03032020
# setup srodowiska #### # setup srodowiska ####
install.packages('shinyjs') setwd('/Users/patrycjalazna/Desktop/wizualizacja-danych/projekt_3/')
# importy #### # importy ####
library(shiny) library(shiny)
@ -57,64 +58,57 @@ airplane_crashes$btwn_6PM_6AM <- if_else
# ShinyApp #### # ShinyApp ####
load_data <- function() {
Sys.sleep(2)
hide("loading_page")
show("main_content")
}
ui <- fluidPage( ui <- fluidPage(
useShinyjs(), id = "main_content",
div( navbarPage("Airplane crashes from 1908 to 2020",
id = "loading_page", tabPanel("General overview",
h1("Loading...") sidebarLayout(
), sidebarPanel(
hidden( # wybór daty
div( dateRangeInput('dates',
id = "main_content", 'Date range:',
navbarPage("Airplane crashes from 1908 to 2020", min(airplane_crashes$Date),
tabPanel("General overview", max(airplane_crashes$Date)),
sidebarLayout( # wybor godziny
sidebarPanel( timeInput("time", "Time (local):", seconds = FALSE)
# wybór daty ),
dateRangeInput('dates', mainPanel(
'Date range:', # wykresiki
min(airplane_crashes$Date), plotlyOutput("weekdayCrashes")
max(airplane_crashes$Date)),
# wybor godziny )
timeInput("time", "Time (local):", seconds = FALSE) )
), ),
mainPanel( tabPanel("Streamgraph",
# wykresiki mainPanel(
plotlyOutput("weekdayCrashes") streamgraphOutput("operatorCrashes")
)
) ),
)
), tabPanel("Map",
tabPanel("Map", mainPanel(
mainPanel( # mapy
# mapy plotlyOutput("mapPlot")
plotlyOutput("mapPlot") #plotOutput("mapPlot")
#plotOutput("mapPlot") )
) ),
), tabPanel("Data",
tabPanel("Data", sidebarPanel(
sidebarPanel( dateRangeInput('dataDates',
dateRangeInput('dataDates', 'Date range:',
'Date range:', min(airplane_crashes$Date),
min(airplane_crashes$Date), max(airplane_crashes$Date))
max(airplane_crashes$Date)) ),
), mainPanel(
mainPanel( DT::dataTableOutput('allData')
DT::dataTableOutput('allData') ))
))
)
)
) )
) )
server <- function(input, output, session) { server <- function(input, output, session) {
load_data()
# godzina # godzina
observe(print(strftime(input$time, "%R"))) 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({ output$mapPlot <- renderPlotly({
states_list <- c('Alabama','Alaska','Alaksa','Arizona','Arkansas',"California", 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') + scale_fill_manual(values = map_pal, na.value = 'whitesmoke') +
theme(legend.position='right', legend.justification = "top") + theme(legend.position='right', legend.justification = "top") +
guides(fill = guide_legend(reverse = TRUE)) guides(fill = guide_legend(reverse = TRUE))
ggplotly( ggplotly(
p = ggplot_obj, p = ggplot_obj,
tooltip = "all", tooltip = "all",
@ -239,7 +259,7 @@ server <- function(input, output, session) {
# poprawic szerkosc wierszy # poprawic szerkosc wierszy
output$allData <- DT::renderDataTable({ output$allData <- DT::renderDataTable({
airplane_crashes %>% airplane_crashes %>%
# filter(Year == input$dataDates) %>% # filter(Year == input$dataDates) %>%
DT::datatable() DT::datatable()
}) })
@ -247,3 +267,45 @@ server <- function(input, output, session) {
shinyApp(ui = ui, server = server) 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