Here is the code for the app:
library(readr)
library(readxl)
library(dplyr)
library(plotly)
library(forcats)
library(ggplot2)
library(tidyverse)
library(lubridate)
library(rnaturalearth)
library(rnaturalearthdata)
library(sf)
library(maps)
library(gifski)
library(leaflet)
library(ggmap)
library(htmlwidgets)
library(htmltools)
library(leaflet.extras)
library(purrr)
library(shiny)
library(shinydashboard)
library(RColorBrewer)
library(rsconnect)
# Data sets
# Load Covid data for Switzerland from GitHub repository
data_swiss <- read_csv("https://raw.githubusercontent.com/openZH/covid_19/master/COVID19_Fallzahlen_CH_total_v2.csv")
# Load Canton population data from excell csv file made from Wikipedia data
canton_swiss <- read_xlsx("swiss_cantons.xlsx")
# Load Switzerland spatial data (canton polygons)
switzerland <- ne_states(country = 'switzerland', returnclass = 'sf')
switzerland <- st_as_sf(switzerland)
# Join data frames
data_swiss = left_join(data_swiss, canton_swiss, by = c(abbreviation_canton_and_fl = "Canton_abbr"))
# Modify dataframe by adding more variables
data_swiss <- data_swiss %>% group_by(abbreviation_canton_and_fl) %>%
mutate(new_cases = ncumul_conf - lag(ncumul_conf, default = first(ncumul_conf), order_by = date))
data_swiss <- data_swiss %>% group_by(abbreviation_canton_and_fl) %>%
mutate(new_deaths = ncumul_deceased - lag(ncumul_deceased, default = first(ncumul_deceased), order_by = date))
data_swiss <- data_swiss %>%
mutate(pop_10thous = Pop/10000)
data_swiss <- data_swiss %>%
mutate(new_cases_per_10thous = new_cases/pop_10thous)
data_swiss <- data_swiss %>%
mutate(new_deaths_per_10thous = new_deaths/pop_10thous)
data_swiss <- data_swiss %>%
mutate(new_cases_smoothed = zoo::rollmean(new_cases, k = 7, fill = NA))
data_swiss <- data_swiss %>%
mutate(new_deaths_smoothed = zoo::rollmean(new_deaths, k = 7, fill = NA))
data_swiss <- data_swiss%>%
mutate(ncumul_deceased_per_10thous = ncumul_deceased/pop_10thous)
data_swiss <- data_swiss%>%
mutate(ncumul_conf_per_10thous = ncumul_conf/pop_10thous)
# Merge with geo data
data_swiss_geo <- left_join(switzerland, data_swiss, by = c(postal = "abbreviation_canton_and_fl"))
# Create new data frame with Switzerland totals
data_swiss_noNA <- data_swiss %>%
mutate_if(is.numeric, funs(ifelse(is.na(.), 0, .)))
switzerland_new_cases <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_cases = sum(new_cases, na.rm = TRUE))
switzerland_new_cases_smoothed <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_cases_smoothed = sum(new_cases_smoothed, na.rm = TRUE)) %>%
select(-date)
switzerland_new_deaths <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_deaths = sum(new_deaths, na.rm = TRUE))%>%
select(-date)
switzerland_new_deaths_smoothed <- data_swiss_noNA %>%
group_by(date) %>%
summarize(switzerland_new_deaths_smoothed = sum(new_deaths_smoothed, na.rm = TRUE)) %>%
select(-date)
data_total_swiss <- cbind(switzerland_new_cases, switzerland_new_cases_smoothed, switzerland_new_deaths, switzerland_new_deaths_smoothed)
# Calculate trend
tot14days_last <- data_swiss %>%
group_by(abbreviation_canton_and_fl) %>%
filter(date <= max(date), date >= max(date)-14) %>%
summarize(tot14days_last = sum(new_cases, na.rm = TRUE))
tot14days_previous <- data_swiss %>%
group_by(abbreviation_canton_and_fl) %>%
filter(date <= max(date)-15, date >= max(date)-29) %>%
summarize(tot14days_previous = sum(new_cases, na.rm = TRUE)) %>%
select(-abbreviation_canton_and_fl)
trend <- cbind(tot14days_last, tot14days_previous)
trend <- trend %>%
mutate(change_percemt = round((tot14days_last-tot14days_previous)/tot14days_last*100, 0))
trend_swiss_geo <- left_join(switzerland, trend, by = c(postal = "abbreviation_canton_and_fl"))
trend <- left_join(canton_swiss, trend, by = c(Canton_abbr = "abbreviation_canton_and_fl"))
# App
header <- dashboardHeader(title = "Covid-19 Switzerland")
sidebar <- dashboardSidebar(
sidebarMenu (
menuItem("Timeline", tabName = "Timeline", icon = icon("calendar-alt")),
menuItem("Maps and Stats", tabName = "Maps", icon = icon("chart-bar")),
menuItem("14 days trend", tabName = "Trend", icon = icon("chart-line")),
menuItem("About", tabName = "About", icon = icon("comment-alt")),
menuItem("Source code", icon = icon("code"),
href = "https://github.com/vivvi87/Swiss-Covid-Shiny-Dashboard"),
menuItem("Source data", icon = icon("database"),
href = "https://github.com/openZH/covid_19")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "Timeline",
fluidRow(
valueBoxOutput("box_cases"),
valueBoxOutput("box_deaths"),
valueBoxOutput("box_canton")
),
fluidRow(
tabBox(width = 10, title ="Switzerland Covid-19 timeline",
tabPanel("Cases", plotlyOutput("swiss_timeline")),
tabPanel("Deaths", plotlyOutput("swiss_timeline_d"))
),
box(width = 2,
sliderInput("dates", "Select dates:",
min(data_total_swiss$date), max(data_total_swiss$date),
value = c(as.Date("2020-09-20"), max(data_total_swiss$date))
)
)
),
fluidRow(
tabBox(width = 10, title ="Swiss cantons Covid-19 timeline",
tabPanel("Cases", plotlyOutput("canton_timeline")),
tabPanel("Deaths", plotlyOutput("canton_timeline_d"))
),
box(width = 2,
sliderInput("dates_canton", "Select dates:",
min(data_swiss$date), max(data_swiss$date),
value = c(as.Date("2020-09-20"), max(data_swiss$date))
),
selectInput("canton", "Select canton:",
selected = "Geneva",
choices = c(levels(as.factor(data_swiss$Canton))),
multiple = FALSE
)
)
)
),
tabItem(tabName = "Maps",
fluidRow(
tabBox(title = "Total cases",
tabPanel("Absolute", leafletOutput("map_cases_abs")),
tabPanel("Every 10000 people", leafletOutput("map_cases"))
),
tabBox(title = "Total deaths",
tabPanel("Absolute", leafletOutput("map_deaths_abs")),
tabPanel("Every 10000 people", leafletOutput("map_deaths"))
)
),
fluidRow(
tabBox(title = "Total cases",
tabPanel("Absolute", plotlyOutput("cases_abs")),
tabPanel("Every 10000 people", plotlyOutput("cases"))
),
tabBox(title = "Total deaths",
tabPanel("Absolute", plotlyOutput("deaths_abs")),
tabPanel("Every 10000 people", plotlyOutput("deaths"))
)
)
),
tabItem(tabName = "About",
fluidRow(
box(width = 12,
h2("About"),
"This dashboard has been built using the data found in the GitHub repository ", em("https://github.com/openZH/covid_19"), " which collect Covid-19 data for Switzerland and Lichtenstain.",
"The data is updated at best once a day at varying times, but in order to avoid missing values and errors, the data in Maps and stats are displayed with a 2 days delay, as indicated when hovering on the data.",
"The data analysis as well as the source code of the dashboard can be found at ", em("https://github.com/vivvi87/Swiss-Covid-Shiny-Dashboard"), ". Both source code and data can be directly accessed from the sidebar."
)
)
),
tabItem(tabName = "Trend",
fluidRow(
valueBoxOutput("swiss_trend")
),
fluidRow(
box(title = "Map - 14 days variation %", width = 6,
leafletOutput("variation_map")
),
box(title = "Chart - 14 days variation %", width = 6,
plotlyOutput("variation_chart")
)
),
fluidRow(
DT::dataTableOutput("trend_table")
)
)
)
)
server <- function(input, output) {
output$swiss_timeline <- renderPlotly({
data_total_swiss %>%
filter(date >= input$dates[1] & date <= input$dates[2]) %>%
plot_ly() %>%
add_bars(x = ~date,
y = ~switzerland_new_cases,
color = I("black"),
opacity = 0.5,
text = ~paste(date, "<br>", "New cases: ", round(switzerland_new_cases, 1)),
hoverinfo = "text",
name = "New cases") %>%
add_lines(x = ~date,
y = ~switzerland_new_cases_smoothed,
color = I("orange"),
text = ~paste(date, "<br>", "New cases (7-days average): ", round(switzerland_new_cases_smoothed, 0)),
hoverinfo = "text",
name = "new cases (7-days average)") %>%
layout(yaxis = list(title = "Number of Covid-19 cases",
showgrid = F,
range = c(0, 11500)),
xaxis = list(title = " "),
legend = list(x = 0, y = 1)) %>%
config(displayModeBar = FALSE, displaylogo = FALSE)
})
output$swiss_timeline_d <- renderPlotly({
data_total_swiss %>%
filter(date >= input$dates[1] & date <= input$dates[2]) %&
