The Coronavirus Dashboard: the case of Denmark
This Coronavirus dashboard: the case of Denmark provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Denmark. This dashboard is built with R using the R Makrdown framework and was adapted from this dashboard by Rami Krispin.
Code
The code behind this dashboard is available on GitHub.
Data
The data and dashboard are refreshed on a daily basis.
The raw data is pulled from the ECDC read.csv(“https://opendata.ecdc.europa.eu/covid19/casedistribution/csv”, na.strings = "“, fileEncoding =”UTF-8-BOM").
Information
More information about this dashboard (and how to replicate it for your own country) can be found in this article.
Update
The data is as of Tirsdag Juli 07, 2020 and the dashboard has been updated on Tirsdag Juli 07, 2020.
Go back to www.statsandr.com (blog) or www.antoinesoetewey.com (personal website).
---
title: "Coronavirus in Denmark"
author: "Christian Heebøll-Nielsen"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: ["facebook", "twitter", "linkedin"]
source_code: embed
vertical_layout: fill
---
```{r setup, include=FALSE,}
knitr::opts_chunk$set(echo = FALSE)
#------------------ Packages ------------------
#devtools::install_github("RamiKrispin/coronavirus", force = TRUE)
library(flexdashboard)
library(lubridate)
library(ggplot2)
library(MASS)
library(magrittr)
library(dplyr)
library(zoo)
library(easynls)
library(readxl)
library(plotly)
library(growthmodels)
library(R0)
library(readr)
data <- read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", na.strings = "", fileEncoding = "UTF-8-BOM")
data <- data %>%
group_by(countriesAndTerritories) %>%
mutate(date = make_date(year, month, day))
`%>%` <- magrittr::`%>%`
#------------------ Parameters ------------------
# Set colors
# https://www.w3.org/TR/css-color-3/#svg-color
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
df <- data %>%
dplyr::filter(countriesAndTerritories == "Denmark") %>%
dplyr::summarise(total_cases = sum(cases), total_deaths = sum(deaths))
df_daily <- data %>%
dplyr::filter(countriesAndTerritories == "Denmark") %>%
dplyr::arrange(date) %>%
dplyr::mutate(
confirmed_cum = cumsum(cases),
death_cum = cumsum(deaths),
)
df1 <- data %>% dplyr::filter(date == max(date))
```
Summary
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### confirmed {.value-box}
```{r}
valueBox(
value = paste(format(sum(df$total_cases), big.mark = ","), "", sep = " "),
caption = "Total confirmed cases",
icon = "fas fa-user-md",
color = confirmed_color
)
```
### death {.value-box}
```{r}
valueBox(
value = paste(format(sum(df$total_deaths, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$total_deaths, na.rm = TRUE) / sum(df$total_cases), 1),
"%)",
sep = ""
),
caption = "Death cases (death rate)",
icon = "fas fa-heart-broken",
color = death_color
)
```
Row
-----------------------------------------------------------------------
### **Daily cumulative cases by type** (Denmark only)
```{r}
plotly::plot_ly(data = df_daily) %>%
plotly::add_trace(
x = ~date,
y = ~confirmed_cum,
type = "scatter",
mode = "lines+markers",
# name = "Active",
name = "Confirmed", secondary_y = FALSE,
line = list(color = active_color),
marker = list(color = active_color),
yaxis = 'y'
) %>%
plotly::add_trace(
x = ~date,
y = ~death_cum,
type = "scatter",
mode = "lines+markers",
name = "Death", secondary_y = TRUE,
line = list(color = death_color),
marker = list(color = death_color),
yaxis = 'y2'
) %>%
plotly::add_annotations(
x = as.Date("2020-02-27"),
y = 1,
text = paste("First case"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -10,
ay = -90
) %>%
plotly::add_annotations(
x = as.Date("2020-03-14"),
y = 3,
text = paste("First death"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -90,
ay = -50
) %>%
plotly::add_annotations(
x = as.Date("2020-03-18"),
y = 14,
text = paste(
"Lockdown"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -30,
ay = -90
) %>%
plotly::add_annotations(
x = as.Date("2020-04-15"),
y = 14,
text = paste(
"Schools reopen"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -90,
ay = -50
) %>%
plotly::add_annotations(
x = as.Date("2020-04-20"),
y = 14,
text = paste(
"Reopening liberal business"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = 0,
ay = -70
) %>%
plotly::add_annotations(
x = as.Date("2020-05-11"),
y = 14,
text = paste(
"Reopening retail"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = 10,
ay = -50
) %>%
plotly::add_annotations(
x = as.Date("2020-05-18"),
y = 14,
text = paste(
"Older children back to school, churches, libraries, cafes, restaurants "
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = 50,
ay = 50
) %>%
plotly::layout(
title = "",
yaxis = list(title = "Cumulative number of cases"),
yaxis2 = list(overlaying = "y", side = "right", position = 0.95, title = "Cumulative number of deaths"),
xaxis = list(title = "Date"),
legend = list(x = 0.1, y = 0.9),
hovermode = "compare"
)
```
Comparison
=======================================================================
### **Daily new confirmed deaths - moving average**
```{r}
data1 <- data %>%
group_by(countriesAndTerritories) %>%
filter(countryterritoryCode == "DNK" | countryterritoryCode == "SWE" | countryterritoryCode == "NOR") %>%
mutate(date = make_date(year, month, day))
daily_deaths <- data1 %>%
mutate(rollingmean = c(rep(NA, 3), # Adding a rolling mean
zoo::rollmean(x = deaths, k = 7),
rep(NA, 3))) %>%
dplyr::filter(date >= "2020-03-01") %>%
dplyr::mutate(country = countriesAndTerritories) %>%
dplyr::group_by(date, country) %>%
dplyr::summarise(total = sum(rollingmean)) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = country, values_from = total)
#----------------------------------------
# Plotting the data
daily_deaths %>%
plotly::plot_ly() %>%
plotly::add_trace(
x = ~date,
y = ~Denmark,
type = "scatter",
mode = "lines+markers",
name = "Denmark"
) %>%
plotly::add_trace(
x = ~date,
y = ~Sweden,
type = "scatter",
mode = "lines+markers",
name = "Sweden"
) %>%
plotly::add_trace(
x = ~date,
y = ~Norway,
type = "scatter",
mode = "lines+markers",
name = "Norway"
) %>%
plotly::layout(
title = "",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of new confirmed deaths"),
xaxis = list(title = "Date"),
# paper_bgcolor = "black",
# plot_bgcolor = "black",
# font = list(color = 'white'),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
)
)
```
R - values
=======================================================================
Column {data-width=400}
-------------------------------------
### **Denmark**
```{r}
knitr::opts_chunk$set(echo = FALSE)
library(R0)
library(dplyr)
# set the serial interval to a lognormal distribution with a mean of 4.8 and a spread of 2.3
mGT <- generation.time("lognormal", c(4.7, 2.9)) #https://www.researchgate.net/publication/339705453_Serial_interval_of_novel_coronavirus_COVID-19_infections
#url <- "https://api.covid19data.dk/ssi_newly_hospitalized"
#hosp_raw <- jsonlite::fromJSON(url)
#hosp <- hosp_raw
hosp_raw <- read_delim("Newly_admitted_over_time.csv",
";", escape_double = FALSE, trim_ws = TRUE)
#incidence <- hosp_raw$newly_hospitalized[10:length(hosp_raw$newly_hospitalized)]
incidence <- hosp_raw$Total
end <- as.integer(length(incidence) - 3)
begin <- as.integer(1)
r <- est.R0.TD(incidence, GT = mGT, begin = begin, end = end,
date.first.obs = hosp_raw$Dato[1])
epid <- r$epid$t[1:(length(incidence) - 3)]
conf <- r$conf.int
upper <- r$conf.int$upper
lower <- r$conf.int$lower
df_conf <- data.frame(epid, upper, lower, r$R)
a <- list(
text = "Based on Antal nyindlagte per dag",
xref = "paper",
yref = "paper",
yanchor = "bottom",
xanchor = "left",
align = "right",
x = 0,
y = 0,
showarrow = FALSE
)
fig <- plot_ly(df_conf, x = ~epid, y = ~upper, type = 'scatter', mode = 'lines',
line = list(color = 'transparent'),
showlegend = FALSE, name = "confidence interval")
fig <- fig %>% add_trace(y = ~lower, type = 'scatter', mode = 'lines',
fill = 'tonexty', fillcolor = 'rgba(0,100,80,0.2)', line = list(color = 'transparent'),
showlegend = FALSE, name = "confidence interval")
fig <- fig %>% add_trace(x = ~epid, y = ~r$R, type = 'scatter', mode = 'lines',
line = list(color = 'rgb(0,100,80)'),
name = 'R value')
fig <- fig %>% layout(title = "R values - Denmark", annotations = a,
paper_bgcolor = 'rgb(255,255,255)', plot_bgcolor = 'rgb(229,229,229)',
xaxis = list(title = "Date",
gridcolor = 'rgb(255,255,255)',
showgrid = TRUE,
showline = FALSE,
showticklabels = TRUE,
tickcolor = 'rgb(127,127,127)',
ticks = 'outside',
zeroline = FALSE),
yaxis = list(title = "R value",
gridcolor = 'rgb(255,255,255)',
showgrid = TRUE,
showline = FALSE,
showticklabels = TRUE,
tickcolor = 'rgb(127,127,127)',
ticks = 'outside',
range = c(0,4),
zeroline = FALSE))
fig
```
### **Sweden**
```{r}
knitr::opts_chunk$set(echo = FALSE)
url <- "https://www.arcgis.com/sharing/rest/content/items/b5e7488e117749c19881cce45db13f7e/data"
# Download Excel-file to temp file
xls_file <- tempfile()
utils::download.file(url, xls_file, mode = "wb")
# Read Excel-file and extract data from the sheet named "Antal intensivvårdade per dag"
ICU <- read_excel(
xls_file,
sheet = "Antal intensivvårdade per dag",
col_names = c("ICU_date","ICU"),
col_types = c("date","numeric"),
skip = 1)
mGT <- generation.time("lognormal", c(4.7, 2.9)) #https://www.researchgate.net/publication/339705453_Serial_interval_of_novel_coronavirus_COVID-19_infections
incidenceS <- ICU$ICU
endS <- as.integer(length(incidenceS) - 5)
beginS <- as.integer(1)
rs <- est.R0.TD(incidenceS, GT = mGT, begin = beginS, end = endS,
date.first.obs = first(ICU$ICU_date))
epidS <- rs$epid$t[1:(length(incidenceS) - 5)]
confS <- rs$conf.int
upperS <- rs$conf.int$upper
lowerS <- rs$conf.int$lower
df_confS <- data.frame(epidS, upperS, lowerS, rs$R)
a <- list(
text = "Based on Antal intensivvårdade per dag",
xref = "paper",
yref = "paper",
yanchor = "bottom",
xanchor = "left",
align = "right",
x = 0,
y = 0,
showarrow = FALSE
)
fig <- plot_ly(df_confS, x = ~epidS, y = ~upperS, type = 'scatter', mode = 'lines',
line = list(color = 'transparent'),
showlegend = FALSE, name = "confidence interval")
fig <-fig %>% add_trace(y = ~lowerS, type = 'scatter', mode = 'lines',
fill = 'tonexty', fillcolor='rgba(0,100,80,0.2)', line = list(color = 'transparent'),
showlegend = FALSE, name = "confidence interval")
fig <- fig %>% add_trace(x = ~epidS, y = ~rs$R, type = 'scatter', mode = 'lines',
line = list(color='rgb(0,100,80)'),
name = 'R value')
fig <- fig %>% layout(title = "R values - Sweden", annotations = a,
paper_bgcolor='rgb(255,255,255)', plot_bgcolor='rgb(229,229,229)',
xaxis = list(title = "Date",
gridcolor = 'rgb(255,255,255)',
showgrid = TRUE,
showline = FALSE,
showticklabels = TRUE,
tickcolor = 'rgb(127,127,127)',
ticks = 'outside',
zeroline = FALSE),
yaxis = list(title = "R value",
gridcolor = 'rgb(255,255,255)',
showgrid = TRUE,
showline = FALSE,
showticklabels = TRUE,
tickcolor = 'rgb(127,127,127)',
ticks = 'outside',
range = c(0,4),
zeroline = FALSE))
fig
```
New hospitalizations
=======================================================================
Column {data-width=400}
-------------------------------------
### **Denmark - new hospitalizations**
```{r}
library(tidyverse)
#url <- "https://api.covid19data.dk/ssi_newly_hospitalized"
#hosp_raw <- jsonlite::fromJSON(url)
#hosp_raw <- hosp_raw %>%
# as_tibble() %>%
# mutate(date = date %>% lubridate::ymd_hms() %>% as.Date())
## Do data transformations #####################################################
# The last four days are usually not fully up-to-date and are missing
# hospitalizations. So we will cut the last four entries and create a 7-day
# rolling mean
#ads <- hosp_raw %>%
# slice(1:(n()-4)) %>% # remove last four entries
# mutate(rollingmean = c(rep(NA, 3), # Adding a rolling mean
# zoo::rollmean(x = newly_hospitalized, k = 7),
# rep(NA, 3)))
# ads %>%
# ggplot() +
# geom_bar(aes(date, newly_hospitalized), stat = "identity", fill = "Purple") +
# geom_line(aes(date, rollingmean)) +
# theme_minimal()
plotfit(r)
```
### **Sweden - new ICU patients**
```{r}
plotfit(rs)
```
Death projections
=======================================================================
Column {data-width=400}
-------------------------------------
### **Denmark**
```{r}
Denmark <- data %>%
filter(countryterritoryCode == "DNK" & date > "2020-03-13") %>%
arrange(date) %>%
mutate(dayNo = (1:length(date))) %>%
mutate(cumdeaths = cumsum(deaths))
df_Danmark <- data.frame(Denmark$dayNo, Denmark$cumdeaths)
nls_DK <- nlsfit(df_Danmark, model = 10, start = c(500, 10, 0.05))
a <- nls_DK$Parameters["coefficient a", "Denmark.cumdeaths"]
b <- nls_DK$Parameters["coefficient b", "Denmark.cumdeaths"]
c <- nls_DK$Parameters["coefficient c", "Denmark.cumdeaths"]
t <- 1:200
#Plot actual deaths in green, prognosis in red
plot(gompertz(t, a, b, c), col="red", xlim=c(0, 200), ylim=c(0,1000), main="Forecast of deaths, Denmark", xlab="Day", ylab="Deaths")
abline(h=nls_DK$Parameters["coefficient a", "Denmark.cumdeaths"], col="red")
text(10, 800, labels=as.integer(nls_DK$Parameters["coefficient a", "Denmark.cumdeaths"]), cex=2)
par(new=TRUE)
plot(Denmark$dayNo, Denmark$cumdeaths, xlim=c(0, 200), ylim=c(0,1000), col="green", xlab="Day", ylab="Deaths")
legend("topright", legend=c("Forecast", "Deaths"),
col=c("red", "green"), lty=1:2, cex=0.8)
```
### **Sweden**
```{r}
Sweden <- data %>%
filter(countryterritoryCode == "SWE" & date > "2020-03-13") %>%
arrange(date) %>%
mutate(dayNoS = (1:length(date))) %>%
mutate(cumdeaths = cumsum(deaths))
df_Sweden <- data.frame(Sweden$dayNoS, Sweden$cumdeaths)
library(easynls)
nls_SW <- nlsfit(df_Sweden, model = 10, start = c(4000, 10, 0.05))
as <- nls_SW$Parameters["coefficient a", "Sweden.cumdeaths"]
bs <- nls_SW$Parameters["coefficient b", "Sweden.cumdeaths"]
cs <- nls_SW$Parameters["coefficient c", "Sweden.cumdeaths"]
ts <- 1:200
#Plot actual deaths in green, prognosis in red
plot(gompertz(ts, as, bs, cs), col="red", xlim=c(0, 200), ylim=c(0,6000), main="Forecast of deaths, Sweden", xlab="Day", ylab = "Deaths")
abline(h=nls_SW$Parameters["coefficient a", "Sweden.cumdeaths"], col="red")
text(10, 5000, labels=as.integer(nls_SW$Parameters["coefficient a", "Sweden.cumdeaths"]), cex=2)
par(new = TRUE)
plot(Sweden$dayNoS, Sweden$cumdeaths, xlim=c(0, 200), ylim=c(0,6000), col="green", xlab="Day", ylab="Deaths")
legend("topright", legend = c("Forecast", "Deaths"),
col = c("red", "green"), lty = 1:2, cex = 0.8)
```
About
=======================================================================
**The Coronavirus Dashboard: the case of Denmark**
This [Coronavirus dashboard: the case of Denmark](https://www.antoinesoetewey.com/files/coronavirus-dashboard.html) provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Denmark. This dashboard is built with R using the R Makrdown framework and was adapted from this [dashboard](https://ramikrispin.github.io/coronavirus_dashboard/){target="_blank"} by Rami Krispin.
**Code**
The code behind this dashboard is available on [GitHub](https://github.com/AntoineSoetewey/coronavirus_dashboard){target="_blank"}.
**Data**
The data and dashboard are refreshed on a daily basis.
The raw data is pulled from the ECDC read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", na.strings = "", fileEncoding = "UTF-8-BOM").
**Information**
More information about this dashboard (and how to replicate it for your own country) can be found in this [article](https://www.statsandr.com/blog/how-to-create-a-simple-coronavirus-dashboard-specific-to-your-country-in-r/).
**Update**
The data is as of `r format(max(data$date), "%A %B %d, %Y")` and the dashboard has been updated on `r format(Sys.time(), "%A %B %d, %Y")`.
*Go back to [www.statsandr.com](https://www.statsandr.com/) (blog) or [www.antoinesoetewey.com](https://www.antoinesoetewey.com/) (personal website)*.