Project shiny - gotowy.

This commit is contained in:
Maciej 2020-06-28 15:52:07 +02:00
commit 45be243237
7 changed files with 709 additions and 0 deletions

BIN
.RData Normal file

Binary file not shown.

170
.Rhistory Normal file
View File

@ -0,0 +1,170 @@
shiny::runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
dat_nuts <- get_eurostat(id = 'tran_r_acci', time_format = 'num')
runApp()
runApp()
runApp()
runApp()
shiny::runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
View(temp_dat_veh)
dat_population <- get_eurostat(id = 'tps00001', time_format = 'num') %>%
rename(population = values)
View(dat_population)
runApp()
runApp()
View(dat_population)
?left_join
runApp()
View(get_eurostat(id = 'tran_sf_roadve', time_format = 'num'))
runApp()
runApp()
runApp()
View(get_eurostat(id = 'tran_sf_roadve', time_format = 'num'))
# mapa (wypełnienie w skali ciągłej)
ggplot(mapdata, aes(fill = values)) +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
scale_fill_gradient(low="white", high="red") +
coord_sf(xlim = c(-20,44), ylim = c(30,70)) +
labs(title = 'Ofiary śmiertelne wypadków drogowych, 2018',
subtitle = 'Średnia na 100 tys. mieszkańców',
fill = 'Wynik',
caption = 'Mapa 2.')
runApp()
zaju infrastruktury drogowej
runApp()
runApp()
runApp()
View(get_eurostat(id = 'tran_sf_roadus', time_format = 'num', filters = list(time = '2017'))
end
View(get_eurostat(id = 'tran_sf_roadus', time_format = 'num', filters = list(time = '2017')))
runApp()
runApp()
runApp()
runApp()
shiny::runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
install.packages("rsconnect")
rsconnect::setAccountInfo(name='maciejk',
token='107B5C72895BEE97EA9DB8290D24D0A8',
secret='OrYzipRFI2sHMFV7289G1rWgedzfVuBVJFUR3a+P')
library(rsconnect)
runApp()
runApp()
runApp()
runApp()
runApp()
View(min_cat)
min_cat
View(min_cat)
min(min_cat$cat)
?first
runApp()
runApp()
runApp()
shiny::runApp()
shiny::runApp()
runApp()
runApp()
View(min_cat)
runApp()
View(min_cat)
runApp()
runApp()
install.packages("shinycssloaders")
runApp()
runApp()
runApp()
shiny::runApp()
runApp()
shiny::runApp()
runApp()
library(eurostat)
library(tidyverse)
library(dplyr)
library(ggplot2)
runApp()
shiny::runApp()
library(eurostat)
library(tidyverse)
library(dplyr)
library(ggplot2)
runApp()
runApp()
runApp()
runApp()
runApp()
library(rsconnect)
rsconnect::deployApp('wypadki-ue')
rsconnect::deployApp('app')
rsconnect::deployApp('\')
rsconnect::deployApp()
shiny::runApp()
runApp()
runApp()
rsconnect::deployApp()
rsconnect::forgetDeployment()
rsconnect::deployApp()
runApp()
rsconnect::deployApp()
library(rsconnect)
install.packages("shinythemes")
shiny::runApp()
runApp()
runApp()
runApp()
runApp()
shiny::runApp()
runApp()
?showModal
?modalDialog
runApp()
runApp()
runApp()
runApp()
?renderText
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
runApp()
library(rsconnect)
rsconnect::deployApp()

6
app.R Normal file
View File

@ -0,0 +1,6 @@
# Project: Fatal road accidents in EU
# Author: Maciej Karczewski
library(shiny)
runApp("~/shinyapp")

13
road_accidents_eu.Rproj Normal file
View File

@ -0,0 +1,13 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX

View File

@ -0,0 +1,10 @@
name: road_accidents_eu
title:
username:
account: maciejk
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 2499098
bundleId: 3316228
url: https://maciejk.shinyapps.io/road_accidents_eu/
when: 1593104752.90011

178
server.R Normal file
View File

@ -0,0 +1,178 @@
library(shiny)
library(eurostat)
library(cshapes)
library(tidyverse)
library(dplyr)
library(ggplot2)
dat <- get_eurostat(id = 'sdg_11_40', time_format = 'num') %>%
filter(!geo %in% c('EU28', 'EU27_2020', 'TR')) %>%
mutate(country = label_eurostat(geo, dic = "geo", lang = 'en', custom_dic = c(DE = "Germany")))
geo <- get_eurostat_geospatial(nuts_level = 0, resolution = 20, output_class = "sf")
dat_vehicle <- get_eurostat(id = 'tran_sf_roadve', time_format = 'num') %>%
mutate(country = label_eurostat(geo, dic = "geo", lang = 'en', custom_dic = c(DE = "Germany")))
dat_users <- get_eurostat(id = 'tran_sf_roadus', time_format = 'num') %>%
mutate(country = label_eurostat(geo, dic = "geo", lang = 'en', custom_dic = c(DE = "Germany")))
dat_road <- get_eurostat(id = 'tran_sf_roadro', time_format = 'num') %>%
mutate(country = label_eurostat(geo, dic = "geo", lang = 'en', custom_dic = c(DE = "Germany")))
dat_nuts <- get_eurostat(id = 'tran_r_acci', time_format = 'num')
geo_nuts <- get_eurostat_geospatial(nuts_level = 2)
hist_geo <- cshapes::cshp(as.Date("1989-1-1"), useGW = TRUE)
hist_geo@data$geo_code <- as.character(hist_geo@data$ISO1AL3)
div_de <- hist_geo[hist_geo@data$geo_code %in% c('DDR'), ]
shinyServer(function(input, output) {
output$roadAccidentsPlot <- renderPlot({
dat %>%
filter(time == input$year & unit == ifelse(input$factor, 'RT', 'NR')) %>%
ggplot(aes(x = reorder(country, values), y = values, fill = ifelse(geo == "PL", "Highlighted", "Normal"))) +
geom_bar(stat = "identity") +
theme(legend.position = "none", axis.title.y = element_blank()) +
labs(y = 'Ofiary', x = NULL, caption = "Źródło: Eurostat") +
coord_flip()
}, width = 687, height = 700)
output$mapPlot <- renderPlot({
mapdata <- geo %>%
right_join(filter(dat, time == input$year & unit == ifelse(input$factor, 'RT', 'NR'))) %>%
mutate(cat = cut_to_classes(values, n = 4, decimals = 1))
ggplot(mapdata, aes(fill = cat)) +
scale_fill_brewer(palette = 'Reds') +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
coord_sf(xlim = c(-20,44), ylim = c(30,70)) +
labs(fill = 'Ofiary', caption = "Źródło: Eurostat")
}, width = 800, height = 700)
output$roadAccidentsByVehiclePlot <- renderPlot({
dat_vehicle %>%
filter(time == input$vehYear & vehicle == input$vehicle) %>%
ggplot(aes(x = reorder(country, values), y = values, fill = ifelse(geo == "PL", "Highlighted", "Normal"))) +
geom_bar(stat = "identity") +
theme(legend.position = "none", axis.title.y = element_blank()) +
labs(y = 'Ofiary', x = NULL, caption = "Źródło: Eurostat") +
coord_flip()
}, width = 687, height = 'auto')
output$mapByVehiclePlot <- renderPlot({
mapdata_veh <- geo %>%
right_join(filter(dat_vehicle, time == input$vehYear & vehicle == input$vehicle))
ggplot(mapdata_veh, aes(fill = values)) +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
scale_fill_gradient(low="white", high="red") +
coord_sf(xlim = c(-20,44), ylim = c(30,70)) +
labs(fill = 'Ofairy', caption = "Źródło: Eurostat")
}, width = 800, height = 700)
output$roadAccidentsByUserPlot <- renderPlot({
dat_users %>%
filter(time == input$userYear & pers_inv == input$user) %>%
ggplot(aes(x = reorder(country, values), y = values, fill = ifelse(geo == "PL", "Highlighted", "Normal"))) +
geom_bar(stat = "identity") +
theme(legend.position = "none", axis.title.y = element_blank()) +
labs(y = 'Ofiary', x = NULL, caption = "Źródło: Eurostat") +
coord_flip()
}, width = 687, height = 'auto')
output$mapByUserPlot <- renderPlot({
mapdata_user <- geo %>%
right_join(filter(dat_users, time == input$userYear & pers_inv == input$user))
ggplot(mapdata_user, aes(fill = values)) +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
scale_fill_gradient(low="white", high="red") +
coord_sf(xlim = c(-20,44), ylim = c(30,70)) +
labs(fill = 'Ofairy', caption = "Źródło: Eurostat")
}, width = 800, height = 700)
output$roadAccidentsByRoadTypePlot <- renderPlot({
dat_road %>%
filter(time == input$roadTypeYear & tra_infr == input$roadType) %>%
ggplot(aes(x = reorder(country, values), y = values, fill = ifelse(geo == "PL", "Highlighted", "Normal"))) +
geom_bar(stat = "identity") +
theme(legend.position = "none", axis.title.y = element_blank()) +
labs(y = 'Ofiary', x = NULL, caption = "Źródło: Eurostat") +
coord_flip()
}, width = 687, height = 'auto')
output$mapByRoadTypePlot <- renderPlot({
mapdata_road <- geo %>%
right_join(filter(dat_road, time == input$roadTypeYear & tra_infr == input$roadType))
ggplot(mapdata_road, aes(fill = values)) +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
scale_fill_gradient(low="white", high="red") +
coord_sf(xlim = c(-20,44), ylim = c(30,70)) +
labs(fill = "Ofiary", caption = "Źródło: Eurostat")
}, width = 800, height = 700)
output$timeChangePlot <- renderPlot({
dat_timechange <- dat %>%
filter(unit == ifelse(input$timeChangefactor, 'RT', 'NR') & geo %in% input$countries)
dat_timechange %>%
ggplot(aes(x = time, y = values, color = geo, label = country)) +
geom_line(size = .9, alpha = .5) +
geom_text(data = dat_timechange %>% group_by(geo) %>% filter(time == max(time)), size = 3) +
theme(legend.position = 'none') +
labs(x = "Rok", y = "Ofiary", caption = "Źródło: Eurostat")
}, width = 800, height = 'auto')
output$nutsPlot <- renderPlot({
mapdata_nuts <- geo_nuts %>%
left_join(dat_nuts) %>%
filter(time == input$nutsYear, victim == input$victimType, unit == ifelse(input$nutsfactor, 'P_MHAB', 'NR'), CNTR_CODE != 'TR') %>%
mutate(cat = cut_to_classes(values, n = 5, decimals = 1))
ggplot(mapdata_nuts, aes(fill = cat)) +
scale_fill_brewer(palette = 'Reds') +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
xlim(c(-12,44)) + ylim(c(35,70)) +
labs(fill = "Ofiary", caption = "Źródło: Eurostat")
}, width = 800, height = 700)
output$germanyPlot <- renderPlot({
mapdata_de <- geo_nuts %>%
left_join(dat_nuts) %>%
filter(time == input$germanyYear, victim == input$germanyVictimType, unit == ifelse(input$germanyFactor, 'P_MHAB', 'NR'), CNTR_CODE == 'DE') %>%
mutate(cat = cut_to_classes(values, n = 5, decimals = 1))
min_cat <- mapdata_de %>%
filter(values == min(values)) %>%
slice(1)
if (input$ddrBorder == FALSE) {
ggplot(mapdata_de, aes(fill = cat)) +
scale_fill_brewer(palette = 'Reds') +
geom_sf(color = alpha('black', 1/3), alpha = .6) +
xlim(c(5,15)) + ylim(c(47,55)) +
labs(fill = "Ofiary", caption = "Źródło: Eurostat")
} else {
ggplot() +
geom_sf(data = mapdata_de, mapping = aes(fill = cat), color = alpha('white', 1/3)) +
scale_fill_brewer(palette = 'Reds', direction = 1, guide = 'legend') +
geom_polygon(data = div_de, mapping = aes(long, lat, group = group, fill = min_cat$cat, alpha = 1), color = 'black', show.legend = FALSE) +
labs(fill = "Ofiary", caption = "Źródło: Eurostat")
}
}, width = 800, height = 700)
output$info <- renderText({
"Test"
})
})

332
ui.R Normal file
View File

@ -0,0 +1,332 @@
library(shiny)
library(markdown)
library(tidyverse)
library(dplyr)
library(shinycssloaders)
library(shinythemes)
shinyUI(navbarPage(
theme = shinytheme("flatly"),
"Wypadki w UE",
tabPanel(
"Dane ogólne",
pageWithSidebar(
headerPanel("Ofiary śmiertelne wypadków drogowych w UE"),
sidebarPanel(
selectInput(
"year",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
checkboxInput("factor", "w przeliczeniu na 100 tys. mieszkańców", TRUE)
),
mainPanel(tabsetPanel(
tabPanel("Wykres", plotOutput("roadAccidentsPlot") %>% withSpinner(color="#0dc5c1")),
tabPanel("Mapa", plotOutput("mapPlot") %>% withSpinner(color="#0dc5c1"))
))
)
),
tabPanel(
"Dane wg pojazdu",
pageWithSidebar(
headerPanel("Ofiary śmiertelne wypadków drogowych w UE wg pojazdu"),
sidebarPanel(
selectInput(
"vehYear",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
selectInput(
"vehicle",
"Rodzaj pojazdu:",
list(
"Samochód osobowy" = "CAR",
"Rower" = "BIKE",
"Bus" = "BUS",
"Ciężarówka > 3.5 tony" = "VG_GT3P5",
"Pojazd ostawczy <= 3.5 tony" = "VG_LE3P5"
)
)
),
mainPanel(tabsetPanel(
tabPanel("Wykres", plotOutput("roadAccidentsByVehiclePlot") %>% withSpinner(color="#0dc5c1")),
tabPanel("Mapa", plotOutput("mapByVehiclePlot") %>% withSpinner(color="#0dc5c1"))
))
)
),
tabPanel(
"Dane wg użytkowników dróg",
pageWithSidebar(
headerPanel("Ofiary śmiertelne wypadków drogowych w UE wg użytkowników dróg"),
sidebarPanel(
selectInput(
"userYear",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
selectInput(
"user",
"Typ użytkownika:",
list(
"Piesi" = "PED",
"Kierujący" = "DRIV",
"Pasażerowie" = "PAS"
)
)
),
mainPanel(tabsetPanel(
tabPanel("Wykres", plotOutput("roadAccidentsByUserPlot") %>% withSpinner(color="#0dc5c1")),
tabPanel("Mapa", plotOutput("mapByUserPlot") %>% withSpinner(color="#0dc5c1"))
))
)
),
tabPanel(
"Dane wg rodzaju dróg",
pageWithSidebar(
headerPanel("Ofiary śmiertelne wypadków drogowych w UE wg rodzaju dróg"),
sidebarPanel(
selectInput(
"roadTypeYear",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
selectInput(
"roadType",
"Typ drogi:",
list(
"Autostrada" = "MWAY",
"Teren zabudowany" = "RD_URB",
"Droga wiejska" = "RD_RUR"
)
)
),
mainPanel(tabsetPanel(
tabPanel("Wykres", plotOutput("roadAccidentsByRoadTypePlot") %>% withSpinner(color="#0dc5c1")),
tabPanel("Mapa", plotOutput("mapByRoadTypePlot") %>% withSpinner(color="#0dc5c1"))
))
)
),
tabPanel(
"Trend",
pageWithSidebar(
headerPanel("Ofiary śmiertelne wypadków drogowych w UE w latach 2000-2018"),
sidebarPanel(
checkboxGroupInput("countries", label = h3("Wybierz państwa:"),
choices = list("Polska" = "PL",
"Niemcy" = "DE",
"Francja" = "FR",
"Wielka Brytania" = "UK",
"Hiszpania" = "ES",
"Szwecja" = "SE",
"Włochy" = "IT",
"Austria" = "AT",
"Portugalia" = "PT"),
selected = "PL"),
checkboxInput("timeChangefactor", "w przeliczeniu na 100 tys. mieszkańców", TRUE)
),
mainPanel(plotOutput("timeChangePlot") %>% withSpinner(color="#0dc5c1"))
)
),
tabPanel(
"NUTS-2",
pageWithSidebar(
headerPanel("Ofiary wypadków drogowych w UE wg podziału NUTS-2"),
sidebarPanel(
selectInput(
"nutsYear",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
selectInput(
"victimType",
"Rodzaj ofiary:",
list(
"Zabici" = "KIL",
"Ranni" = "INJ"
)
),
checkboxInput("nutsfactor", "w przeliczenia na 1 mln. mieszkańców", TRUE)
),
mainPanel(plotOutput("nutsPlot") %>% withSpinner(color="#0dc5c1"))
)
),
tabPanel(
"Niemcy",
pageWithSidebar(
headerPanel("Ofiary wypadków drogowych w RFN"),
sidebarPanel(
selectInput(
"germanyYear",
"Rok:",
list(
"2000" = "2000",
"2001" = "2001",
"2002" = "2002",
"2003" = "2003",
"2004" = "2004",
"2005" = "2005",
"2006" = "2006",
"2007" = "2007",
"2008" = "2008",
"2009" = "2009",
"2010" = "2010",
"2011" = "2011",
"2012" = "2012",
"2013" = "2013",
"2014" = "2014",
"2015" = "2015",
"2016" = "2016",
"2017" = "2017",
"2018" = "2018"
)
),
selectInput(
"germanyVictimType",
"Rodzaj ofiary:",
list(
"Zabici" = "KIL",
"Ranni" = "INJ"
)
),
checkboxInput("germanyFactor", "w przeliczenia na 1 mln. mieszkańców", TRUE),
checkboxInput("ddrBorder", "historyczne granice NRD", FALSE)
),
mainPanel(plotOutput("germanyPlot") %>% withSpinner(color="#0dc5c1"))
)
),
tabPanel(
"O programie",
fluidPage(
fluidRow(
column(2, strong("Autor:")),
column(4, strong("Maciej Karczewski"))
),
fluidRow(
column(2, strong("Projekt:")),
column(4, strong("Wypadki drogowe w UE"))
),
fluidRow(
column(2, strong("Przedmiot:")),
column(4, strong("Interaktywne wizualizacje w analizie biznesowej"))
),
fluidRow(
column(2, strong("Źródło danych:")),
column(4, strong("Eurostat"))
))
)
))