valueBox(
value = paste(format(sum(df$confirmed), big.mark = ","), "", sep = " "),
caption = "Total confirmed cases",
icon = "fas fa-user-md",
color = confirmed_color
)valueBox(
value = paste(format(sum(df$death, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$death, na.rm = TRUE) / sum(df$confirmed), 1),
"%)",
sep = ""
),
caption = "Death cases (death rate)",
icon = "fas fa-heart-broken",
color = death_color
)plotly::plot_ly(data = df_daily) %>%
plotly::add_trace(
x = ~date,
# y = ~active_cum,
y = ~confirmed_cum,
type = "scatter",
mode = "lines+markers",
# name = "Active",
name = "Confirmed",
line = list(color = active_color),
marker = list(color = active_color)
) %>%
plotly::add_trace(
x = ~date,
y = ~death_cum,
type = "scatter",
mode = "lines+markers",
name = "Death",
line = list(color = death_color),
marker = list(color = death_color)
) %>%
plotly::add_annotations(
x = as.Date("2020-02-04"),
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-11"),
y = 3,
text = paste("First death"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -90,
ay = -90
) %>%
plotly::add_annotations(
x = as.Date("2020-03-18"),
y = 14,
text = paste(
"New containment",
"",
"measures"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -10,
ay = -90
) %>%
plotly::layout(
title = "",
yaxis = list(title = "Cumulative number of cases"),
xaxis = list(title = "Date"),
legend = list(x = 0.1, y = 0.9),
hovermode = "compare"
)daily_confirmed <- coronavirus %>%
dplyr::filter(type == "confirmed") %>%
dplyr::filter(date >= "2020-02-29") %>%
dplyr::mutate(country = Country.Region) %>%
dplyr::group_by(date, country) %>%
dplyr::summarise(total = sum(cases)) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = country, values_from = total)
#----------------------------------------
# Plotting the data
daily_confirmed %>%
plotly::plot_ly() %>%
plotly::add_trace(
x = ~date,
y = ~Belgium,
type = "scatter",
mode = "lines+markers",
name = "Belgium"
) %>%
plotly::add_trace(
x = ~date,
y = ~France,
type = "scatter",
mode = "lines+markers",
name = "France"
) %>%
plotly::add_trace(
x = ~date,
y = ~Spain,
type = "scatter",
mode = "lines+markers",
name = "Spain"
) %>%
plotly::add_trace(
x = ~date,
y = ~Italy,
type = "scatter",
mode = "lines+markers",
name = "Italy"
) %>%
plotly::layout(
title = "",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of new cases"),
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
)
)df_EU <- coronavirus %>%
# dplyr::filter(date == max(date)) %>%
dplyr::filter(Country.Region == "Belgium" |
Country.Region == "France" |
Country.Region == "Italy" |
Country.Region == "Spain") %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total = sum(cases)) %>%
tidyr::pivot_wider(
names_from = type,
values_from = total
) %>%
# dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>%
dplyr::mutate(unrecovered = confirmed - ifelse(is.na(death), 0, death)) %>%
dplyr::arrange(confirmed) %>%
dplyr::ungroup() %>%
dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
dplyr::mutate(country = trimws(country)) %>%
dplyr::mutate(country = factor(country, levels = country))
plotly::plot_ly(
data = df_EU,
x = ~country,
# y = ~unrecovered,
y = ~ confirmed,
# text = ~ confirmed,
# textposition = 'auto',
type = "bar",
name = "Confirmed",
marker = list(color = active_color)
) %>%
plotly::add_trace(
y = ~death,
# text = ~ death,
# textposition = 'auto',
name = "Death",
marker = list(color = death_color)
) %>%
plotly::layout(
barmode = "stack",
yaxis = list(title = "Total cases"),
xaxis = list(title = ""),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
)
)# map tab added by Art Steinmetz
library(leaflet)## Warning: package 'leaflet' was built under R version 3.6.3library(leafpop)## Warning: package 'leafpop' was built under R version 3.6.3library(purrr)
cv_data_for_plot <- coronavirus %>%
# dplyr::filter(Country.Region == "Belgium") %>%
dplyr::filter(cases > 0) %>%
dplyr::group_by(Country.Region, Province.State, Lat, Long, type) %>%
dplyr::summarise(cases = sum(cases)) %>%
dplyr::mutate(log_cases = 2 * log(cases)) %>%
dplyr::ungroup()
cv_data_for_plot.split <- cv_data_for_plot %>% split(cv_data_for_plot$type)
pal <- colorFactor(c("orange", "red", "green"), domain = c("confirmed", "death", "recovered"))
map_object <- leaflet() %>% addProviderTiles(providers$Stamen.Toner)
names(cv_data_for_plot.split) %>%
purrr::walk(function(df) {
map_object <<- map_object %>%
addCircleMarkers(
data = cv_data_for_plot.split[[df]],
lng = ~Long, lat = ~Lat,
# label=~as.character(cases),
color = ~ pal(type),
stroke = FALSE,
fillOpacity = 0.8,
radius = ~log_cases,
popup = leafpop::popupTable(cv_data_for_plot.split[[df]],
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("type", "cases", "Country.Region", "Province.State")
),
group = df,
# clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
labelOptions = labelOptions(
noHide = F,
direction = "auto"
)
)
})
map_object %>%
addLayersControl(
overlayGroups = names(cv_data_for_plot.split),
options = layersControlOptions(collapsed = FALSE)
)The Coronavirus Dashboard: the case of Belgium
This Coronavirus dashboard: the case of Belgium provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Belgium. 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 input data for this dashboard is the dataset available from the {coronavirus} R package. Make sure to download the development version of the package to have the latest data:
install.packages("devtools")
devtools::install_github("RamiKrispin/coronavirus")The data and dashboard are refreshed on a daily basis.
The raw data is pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus repository.
Contact
For any question or feedback, you can contact me. More information about this dashboard can be found in this article.
Update
The data is as of Monday March 23, 2020 and the dashboard has been updated on Wednesday March 25, 2020.
Go back to www.statsandr.com (blog) or www.antoinesoetewey.com (personal website).