Coronavirus Dashboard - Romania
This Dahsboard provides an overview of the 2019 Novel Coronavirus (2019-nCoV) epidemic at a region-level just for Romania. It is build with R using the Rmarkdown framework.
Data
The data is refreshed on a daily bases and is filled manually from mai.gov.ro and ms.ro.
Packages
Disclaimer
All predictions are formulated based on personal views, are not backed by science and used for educational purposes only! This model helps developing an intuintion about the situation, it does not predict future cases accuratly due to the simplicity of the model.
Contribution
Rami Krispin Dashboard inspired me to create a region-level analysis for Romania.
---
title: "COVID-19 Romania"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
social: menu
source_code: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
library(plotly)
library(tidyverse)
library(janitor)
library(flexdashboard)
library(googlesheets4)
library(lubridate)
library(leaflet)
library(scales)
library(leafpop)
library(drc)
library(dplyr)
#------------------ Parameters ------------------
# Set colors
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
covid_ro <- read_sheet("https://docs.google.com/spreadsheets/d/1gFv8VLaQcGUKDZFzrq2ELUOcnjWBWV25xrh-1P9ZlS0/edit#gid=0",
col_types = "icc??ccicccc")
covid_ro <- covid_ro %>%
clean_names() %>%
mutate_at(vars(county, city, gender, type, source), factor) %>%
mutate(county = fct_infreq(county),
source = fct_infreq(source),
confirmed_date = as.Date(confirmed_date, "%d/%m/%y"))
covid_ro2 <- read_sheet("https://docs.google.com/spreadsheets/d/1e0HS2mwXhG9qKnWlh0ryOOdZU4SNSsD2gGTTyoDYAlw/edit?usp=sharing",
col_types = "iciiiiii")
covid_ro2 <- covid_ro2 %>%
clean_names() %>%
mutate(date = as.Date(date, "%d/%m/%Y"))
covid_ro4 <- read_sheet("https://docs.google.com/spreadsheets/d/1233fvxSvdyrib7xAp8mfANudVSSjHPYIhH-3qSh03Vc/edit?usp=sharing",
col_types = "icciccc")
covid_ro4 <- covid_ro4 %>%
clean_names() %>%
mutate(date_confirmed = as.Date(date_confirmed, "%d/%m/%Y"),
death_date = as.Date(death_date, "%d/%m/%Y"))
covid_ro3 <- read_sheet("https://docs.google.com/spreadsheets/d/1bi0c8rmorrmdP_VjC7UW2wjsrqklok5DJrcKsOqAOdc/edit?usp=sharing")
covid_ro3 <- covid_ro3 %>%
clean_names() %>%
mutate_at(vars(county), factor)
covid_ro3 <- covid_ro3 %>%
left_join(covid_ro4 %>%
group_by(county) %>%
count() %>%
as.data.frame() %>%
rename(decesed = n), by = c("county")) %>%
replace_na(list(decesed = 0))
# Confirmed
confirmed <- as.numeric(covid_ro2 %>%
filter(date == max(date)) %>%
dplyr::select(confirmed))
# Recovered
recovered <- as.numeric(covid_ro2 %>%
filter(date == max(date)) %>%
dplyr::select(recovered))
# Quarantine
quarantined <- as.numeric(covid_ro2 %>%
filter(date ==max(date)) %>%
dplyr::select(qurantined))
# Isolation
isolation <- as.numeric(covid_ro2 %>%
filter(date == max(date)) %>%
dplyr::select(home_isolation))
# Deaths
#deaths <- as.numeric(covid_ro2 %>%
# filter(date == max(date)) %>%
# dplyr::select(death_cases))
deaths <- as.numeric(covid_ro3 %>%
dplyr::select(decesed) %>%
sum())
# Active
active <- confirmed - recovered - deaths
# Last update
updated <- format((now("UTC") + dhours(2)), "%d-%b %H:%m")
```
Summary
=======================================================================
Row
-----------------------------------------------------------------------
### confirmed {.value-box}
```{r}
valueBox(value = paste(format(confirmed,
big.mark = ","), "", sep = " "),
caption = "Total Confirmed Cases",
icon = "fas fa-user-md",
color = confirmed_color)
```
### active {.value-box}
```{r}
valueBox(value = paste(format(active, big.mark = ","), " (",round(active * 100 / confirmed,1), "%)", sep = ""),
caption = "Active Cases", icon = "fas fa-procedures",
color = active_color)
```
### recovered {.value-box}
```{r}
valueBox(value = paste(format(recovered, big.mark = ","), " (",round(recovered * 100 / confirmed, 1), "%)", sep = ""),
caption = "Recovered Cases", icon = "fas fa-heartbeat",
color = recovered_color)
```
### Death Cases
```{r}
valueBox(value = paste(format(deaths, big.mark = ","), " (",round(deaths * 100 / confirmed, 1), "%)", sep = ""),
caption = "Death Cases",
color = "red")
```
### quarantined {.value-box}
```{r}
valueBox(value = paste(format(quarantined,
big.mark = ","), "", sep = " "),
caption = "Quarantined",
icon = "fas fa-diagnoses",
color = "orange")
```
### isolation {.value-box}
```{r}
valueBox(value = paste(format(isolation,
big.mark = ","), "", sep = " "),
caption = "Isolation",
icon = "fas fa-door-closed",
color = "#ffd11a")
```
### Last update {.value-box}
```{r}
valueBox(value = paste(format(updated,
big.mark = ","), "", sep = " "),
caption = "Last update",
icon = "far fa-clock",
color = "#b3b3cc")
```
Column {data-width=400}
-----------------------------------------------------------------------
### **Cases by County (Confirmed and Deaths)**
```{r}
p1 <- plot_ly(data = covid_ro3, x = ~county) %>%
add_trace(type = "bar", y = ~confirmed, visible = T, color = I("purple"), name = "Confirmed") %>%
add_trace(type = "bar", y = ~decesed, visible = F, color = I("red"), name = "Deaths") %>%
layout(
updatemenus = list(
list(yanchor = "auto",
buttons = list(
list(method = "restyle",
args = list("visible", list(T,F)),
label = "Confirmed"),
list(method = "restyle",
args = list("visible", list(F, T)),
label = "Deaths")), type = "buttons")
),
xaxis = list(title=""),
yaxis = list(title = "")
#annotations = list(list(text = "Type: ", x = -0.1, y = 1.1, xref = "paper", yref = "paper", showarrow = FALSE))
)
ggplotly(p1)
```
## **Cases by County (Confirmed and Deaths)** {.mobile}
```{r}
p1 <- plot_ly(data = covid_ro3, x = ~county) %>%
add_trace(type = "bar", y = ~confirmed, visible = T, color = I("purple"), name = "Confirmed") %>%
add_trace(type = "bar", y = ~decesed, visible = F, color = I("red"), name = "Deaths") %>%
layout(
updatemenus = list(
list(yanchor = "auto",
buttons = list(
list(method = "restyle",
args = list("visible", list(T,F)),
label = "Confirmed"),
list(method = "restyle",
args = list("visible", list(F, T)),
label = "Deaths")), type = "buttons")
),
xaxis = list(title=""),
yaxis = list(title = "")
#annotations = list(list(text = "Type: ", x = -0.1, y = 1.1, xref = "paper", yref = "paper", showarrow = FALSE))
)
ggplotly(p1)
```
Row {.tabset .tabset-fade}
-------------------------------------
### **Daily Cases**
```{r}
p2 <- covid_ro2 %>%
mutate(daily = c(confirmed[1], diff(confirmed))) %>% # Daily cases from total
ggplot(aes(x = date, y = daily)) +
geom_line( color = "#800080") +
geom_line( color = "#800080", stat = "identity") +
geom_point(size = 1, color = "#800080") +
labs(x = "Date",
y = "Daily Cases") +
theme_bw() +
theme(panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()) +
scale_x_date(date_breaks = "4 day",
labels = date_format("%d-%b"),
guide = guide_axis(n.dodge = 2)) +
scale_y_continuous(expand = c(0,0),
breaks = c(0, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 550))
ggplotly(p2)
```
### **Daily Cumulative Cases (Active, Recovered and Deaths)**
```{r}
p3 <- covid_ro2 %>%
mutate(active = confirmed - recovered - death_cases) %>%
ggplot() +
#geom_line(aes(x = date, y = confirmed,color = "Confirmed")) +
#geom_point(aes(x = date, y = confirmed), size = 1, color = "#800080") +
geom_line(aes(x = date, y = recovered, color = "Recovered")) +
geom_point(aes(x = date, y = recovered), color = "forestgreen", size = 1)+
geom_line(aes(x = date, y = active, color = "Active")) +
geom_point(aes(x = date, y = active), color = "#1f77b4", size = 1) +
geom_line(aes(x = date, y = death_cases,color = "Death")) +
geom_point(aes(x = date, y = death_cases), size = 1, color = "red") +
labs(x = "Date",
y = "Daily Cumulative Cases") +
theme_bw() +
theme(panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()) +
scale_x_date(date_breaks = "4 day",
labels = date_format("%d-%b")) +
scale_y_continuous(label = comma_format(big.mark = ".", decimal.mark = ","),
breaks = seq(0, 8000, by = 400)) +
scale_color_manual(name = "Cases",
values = c("Confirmed" = "#800080",
"Recovered" = "forestgreen",
"Active" = "#1f77b4",
"Death" = "red"))
ggplotly(p3)
```
Trend
=======================================================================
Column {data-width=400}
-----------------------------------------------------------------------
### **Prediction of Future Cases - 5 days (Experimental)**
```{r}
#### DF
confirmed_predictions <- data.frame(x = 1: (nrow(covid_ro2) + 5),
date = seq.Date(min(covid_ro2$date), by = "days", length.out = length(covid_ro2$confirmed) + 5))
confirmed <- rep(NA, nrow(covid_ro2) + 5)
confirmed[1:length(covid_ro2$confirmed)] <- covid_ro2$confirmed
confirmed_predictions <- cbind(confirmed_predictions, confirmed)
# Model
model <- drm(confirmed ~ x, fct = L.3(), data = confirmed_predictions[1:length(covid_ro2$confirmed), ])
# Bind datafranes
confirmed_predictions <- cbind(confirmed_predictions, predict(model, confirmed_predictions, interval = "prediction") %>% as.data.frame())
# Graph
p4 <- confirmed_predictions %>%
mutate_at(vars(Prediction, Lower, Upper), funs(round(., 0))) %>%
ggplot() +
geom_line(aes(x = date, y = Prediction, color = "Predictions")) + # Predictions
geom_point(aes(x = date, y = Prediction), color = "#09D9C9") +
geom_line(aes(x = date,y = Lower, color = "95% Confidence Interval"), linetype = "dotted")+ # Confidence intervals
geom_line(aes(x = date,y = Upper, color = "95% Confidence Interval"), linetype = "dotted") + # Confidence intervals
geom_line(aes(x = date, y = confirmed, color = "Actuals")) + # Actuals
geom_point(aes(x = date, y = confirmed), color = "purple") +
labs(x = "Date",
y = "Daily Cumulative Predictions") +
theme_bw() +
theme(panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()) +
scale_x_date(date_breaks = "4 day",
labels = date_format("%d-%b")) +
scale_y_continuous(label = comma_format(big.mark = ".", decimal.mark = ","),
breaks = seq(0, max(confirmed_predictions$Upper), by = 500)) +
scale_color_manual(name = "Legend",
values = c("Predictions" = "#09D9C9",
"Actuals" = "purple",
"95% Confidence Interval" = "#8E8E8E"))
ggplotly(p4)
```
Row {.tabset .tabset-fade}
-------------------------------------
### **Death Cases - Difference between Death Day and Confirmed Day**
```{r}
p5 <- covid_ro4 %>%
mutate(days_difference = as.numeric(death_date - date_confirmed),
days_difference = replace(days_difference, days_difference == 0, 0.5),
Confirmed = case_when(days_difference < 0 ~ "Post-mortem",
days_difference > 0.5 ~ "Ante-mortem",
days_difference == 0.5 ~ "Death Day")) %>%
drop_na(days_difference, Confirmed) %>%
ggplot() +
geom_bar(aes(x = id, y = days_difference, fill = Confirmed), stat = "identity") +
#geom_hline(yintercept = 0, color = "black", size = 1) +
theme_bw() +
theme(panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()) +
scale_y_continuous(breaks = seq(-30, 30, by = 2),
expand = c(0.03, 0.03)) +
scale_x_continuous(expand = c(0.01,0.01),
breaks = seq(1, max(covid_ro4$id), by = 20)) +
labs(x = "Case",
y = "Day difference")
ggplotly(p5)
```
### **Number of deaths by gender and age**
```{r}
p6 <- covid_ro4 %>%
filter(age != "NA",
gender != "NA") %>%
mutate(age_group = case_when(age >= 20 & age <= 29 ~ '20-29',
age >= 30 & age <= 39 ~ '30-39',
age >= 40 & age <= 49 ~ '40-49',
age >= 50 & age <= 59 ~ '50-59',
age >= 60 & age <= 69 ~ '60-69',
age >= 70 & age <= 79 ~ '70-79',
age >= 80 & age <= 89 ~ '80-89',
age >= 90 & age <= 99 ~ '90-99')) %>%
count(gender, age_group) %>%
mutate(age_group = as.character(age_group)) %>%
do(bind_rows(., data.frame(age_group = "Total", count(covid_ro4 %>% filter(age != "NA",gender != "NA"),
gender)))) %>%
ggplot() +
geom_bar(aes(x = age_group, y = n, fill = gender),
stat = "identity",
position = "dodge",
color = "white") +
geom_text(aes(y = n, x = age_group,label = n, group = gender), color = "black",
position = position_dodge(width = 1),
vjust = -0.7, size = 3) +
scale_fill_manual(name = "Gender",
values = alpha(c("#FF7F0E", "#1F77B4"))) +
scale_y_continuous(expand = expansion(mult = c(0, 0.02)),
breaks = seq(0, 400, by = 50)) +
theme_bw() +
theme(axis.ticks.x = element_blank(),
#axis.text.x = element_text(angle = 20, hjust = 1),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank()) +
labs(x = "Age",
y = "Number of deaths")
ggplotly(p6)
```
Map
=======================================================================
```{r}
df_map <- covid_ro3 %>%
rename(death = decesed) %>%
group_by(county, lat, long) %>%
pivot_longer(cols = c(confirmed, death),
names_to = "type",
values_to = "cases") %>%
mutate(log_cases = 2 * log(cases)) %>%
arrange(type, county) %>%
ungroup()
df_map_split <- df_map %>% split(df_map$type)
pal <- colorFactor(c("purple","red"), domain = c("confirmed", "death"))
map_object <- leaflet() %>%
addProviderTiles(providers$CartoDB.Voyager) %>%
setView(lng =24.873046874999996, lat = 46.17983040759436, zoom = 7.6)
names(df_map_split) %>%
walk(function(df) {
map_object <<- map_object %>%
addCircleMarkers(data =df_map_split[[df]],
lng = ~long, lat = ~lat,
color = ~pal(type),
fillOpacity = 0.8,
radius = ~sqrt(cases) * 0.7,
popup = popupTable(df_map_split[[df]],
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("type", "cases", "county")),
group = df,
labelOptions = labelOptions(noHide = F,
direction = "auto"))
})
p6 <- map_object %>%
addLayersControl(
overlayGroups = names(df_map_split),
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c("death"))
p6
```
Data
=======================================================================
Row {.tabset .tabset-fade}
-------------------------------------
### **Cases by Day**
```{r}
covid_ro2 %>%
rename(Id = id,
Date = date,
Confirmed = confirmed,
Recovered = recovered,
Quarantine = qurantined,
Isolation = home_isolation,
Deaths = death_cases,
Tests = tests) %>%
DT::datatable(rownames = FALSE,
options = list(pageLength = nrow(covid_ro2), dom = "tip"))
```
### **Cases by County**
```{r}
covid_ro3 %>%
dplyr::select( county, confirmed, decesed) %>%
mutate(death_rate = decesed / confirmed) %>%
rename(County = county,
Confirmed = confirmed,
Deaths = decesed) %>%
DT::datatable(rownames = FALSE,
colnames = c("County", "Confirmed", "Deaths", "Death Rate"),
options = list(pageLength = nrow(covid_ro3), dom = "tip")) %>%
DT:: formatPercentage("death_rate", 2)
```
About
=======================================================================
**Coronavirus Dashboard - Romania**
This Dahsboard provides an overview of the 2019 Novel Coronavirus (2019-nCoV) epidemic at a region-level just for Romania. It is build with R using the Rmarkdown framework.
**Data**
The data is refreshed on a daily bases and is filled manually from [mai.gov.ro](https://www.mai.gov.ro/) and [ms.ro](http://www.ms.ro/).
**Packages**
* Dashboard interface - [flexdashboard](https://rmarkdown.rstudio.com/flexdashboard/)
* Visualization - [plotly](https://plot.ly/r/), [ggplot2](https://ggplot2.tidyverse.org/)
* Read Data - [googlesheets4](https://googlesheets4.tidyverse.org/)
* Data manipulation - [dplyr](https://dplyr.tidyverse.org/), [tidyr](https://tidyr.tidyverse.org/), [lubridate](https://lubridate.tidyverse.org/)
* Tables - [DT](https://rstudio.github.io/DT/)
* Maps - [Leaflet](https://rstudio.github.io/leaflet/)
* Prediction - [Dose-Response Analysis](https://journals.plos.org/plosone/article?id=10.1371/journal.pone.0146021)
**Disclaimer**
All predictions are formulated based on personal views, are not backed by science and used for educational purposes only!
This model helps developing an intuintion about the situation, it does not predict future cases accuratly due to the simplicity of the model.
**Contribution**
Rami Krispin [Dashboard](https://ramikrispin.github.io/coronavirus_dashboard/) inspired me to create a region-level analysis for Romania.