In R4IDSR/epichecks: Report templates and helper functions for WHO surveillance data
## set the current year
current_year <- 2020
## set the current month
current_month <- "January"
## set the first week of interest
current_week_start <- 1
## set the last week of interest
current_week_stop <- 5
## set the day that defines the beginning of your epiweek.
aweek::set_week_start("Monday")
#### The parts below are automated (do not change these)
## pad the current weeks so it is always two values long
current_week_start <- stringr::str_pad({current_week_start}, 2, pad = 0)
current_week_stop <- stringr::str_pad({current_week_stop}, 2, pad = 0)
## set starting week for the month
start_week <- aweek::as.aweek(stringr::str_glue("{current_year}-W{current_week_start}"))
## set the ending week
end_week <- aweek::as.aweek(stringr::str_glue("{current_year}-W{current_week_stop}"))
## pull together all weeks of interest as epiweeks factor
current_weeks <- aweek::factor_aweek(
c(start_week,
end_week)
)
## pull together all weeks of interest as numbers
current_weeks_nums <- factor(stringr::str_pad(current_week_start:current_week_stop,
2, pad = 0))
## file path where IDSR processed data is
input_path <- here::here("Data Files")
## get paths of all the files in weeks of interest folders with .xlsx file format
file_paths <- Sys.glob(str_glue("{input_path}/{current_year}/{levels(current_weeks_nums)}/!Imported/*.xlsx"))
## import each excel file individually saved in a list
## do not bind them together imediately
processed_data <- import_list(file_paths, rbind = FALSE, na = "NULL")
## apply cleaning steps to each country dataset in list
processed_data <- purrr::map(processed_data, epichecks::clean_idsr)
## pull country name from first row of country variable
cleaned_names <- purrr::map_chr(purrr::map(processed_data, "country"), 1L)
## overwrite names in processed_data to be simplified country names
names(processed_data) <- cleaned_names
## run aggregator function to pull together a merged dataset
processed_data_agg <- aggregator(processed_data, output_path = NULL)
## make sure that epiweek is an aweek class
processed_data_agg <- processed_data_agg %>%
mutate(epiweek = as.aweek(epiweek))
## filter for weeks of interest
processed_data_agg <- filter(processed_data_agg,
epiweek >= start_week,
epiweek <= end_week)
## make sure all the levels of epiweek are represented in a factor
processed_data_agg <- processed_data_agg %>%
mutate(epiweek = factor_aweek(epiweek))
## merge IDSR data and shapefile based on country
## only keep country and WHO_SUBREG from the shapefile
processed_data_agg <- left_join(processed_data_agg,
select(afro_shp, country, WHO_SUBREG),
by = "country") %>%
select(-geometry) # drop shapefile geomtry from IDSR data
## get full list of countries in AFRO by region
region_countries <- afro_shp %>%
filter(WHO_REG == "AFRO") %>% # select only rows with AFRO
as_tibble() %>% # change class to tibble
select(country, WHO_SUBREG, -geometry) # only keep country and reg, drop geometry
## make sure variables are factors with appropriate levels
processed_data_agg <- processed_data_agg %>%
mutate(country = factor(country,
levels = region_countries$country),
WHO_SUBREG = factor(WHO_SUBREG,
levels = unique(region_countries$WHO_SUBREG))
)
## file path where outbreak data is
input_path_outbreak <- here::here("Data Files", "Outbreak weekly notification_compilation.xlsx")
## import the first sheet from the excel file
outbreak_data <- import(input_path_outbreak, na = c("Select", "Start date"))
## fix the "Start date" variable name
## was dropped as set as an NA value above
names(outbreak_data)[3] <- "Start date"
## define clean variable names using clean_labels from the epitrix package
cleaned_colnames <- epitrix::clean_labels(colnames(outbreak_data))
## overwrite variable names with defined clean names
colnames(outbreak_data) <- cleaned_colnames
## create a more useful epiweek variable from the start_date var
outbreak_data <- outbreak_data %>%
mutate(epiweek = as.aweek(start_date, floor_day = TRUE))
## filter for weeks of interest
outbreak_data <- outbreak_data %>%
filter(epiweek %in% levels(current_weeks))
## turn epiweek in to a factor including all weeks of interest
outbreak_data <- outbreak_data %>%
mutate(epiweek = factor(epiweek, levels = levels(current_weeks)))
## recode countries names based on dictionary
outbreak_data$country <- matchmaker::match_vec(outbreak_data$country,
dictionary = country_dict,
from = "Alias",
to = "AdministrativeLevelName")
I- Introduction notes
The International Health Regulations (IHR), adopted in 2005, state that each
country shall strengthen and maintain the capacity to detect, assess, and respond
to all events that may constitute public health emergencies of international
concern (PHEICs) and report them to the World Health Organization (WHO).
In the African Region, the IHR priorities are being achieved through the
implementation of the Integrated Disease Surveillance (IDSR) adopted by Member
States in 1998.
The IDSR strategy aims to develop and implement comprehensive surveillance and
response systems with the aim of building capacities for early detection and
timely responses to major public health events. As per their IHR obligations and
IDSR commitments, Member States submit to the WHO regional Office for Africa,
on a weekly basis, reports on diseases and conditions under surveillance.
These reports are collated at the WHO regional office to provide an overview on
the status of diseases and conditions under surveillance in the region and to
analyze events that may traverse international boundaries. The current bulletin
synthetizes the completeness and timeliness of reporting as well as the results
of alert threshold analyses for diseases and conditions under surveillance in
the WHO African region. The analyses included in this bulletin are strictly based
on data reported by Member States as a result of the implementation of the IDSR,
which are limited to suspect cases and deaths. This bulletin also provides an
overview of outbreaks and other public health emergencies ongoing in the African
region as per the end of the month of publication. This bulletin focuses in
epidemiological analysis and does not provide any information on responses to
ongoing events in the WHO African region.
II- Highlights
## create timeliness variable --------------------------------------------------
## set reporting deadline as the wednesday after week of interest (i.e. in week after)
## function returns monday of current_week, add 9 days to that gives following Wed
processed_data_agg <- processed_data_agg %>%
mutate(report_deadline = week2date(epiweek) + 9)
## fix the date submitted var
## change to date (the original input is day/month/year)
processed_data_agg <- processed_data_agg %>%
mutate(DataSubmissionDate = as.Date(DataSubmissionDate, origin = "1899-12-30"))
## Create a TRUE/FALSE variable for whether the report was submitted on time
processed_data_agg <- processed_data_agg %>%
mutate(on_time = DataSubmissionDate <= report_deadline)
## overall timeliness ----------------------------------------------------------
## get the theoretical number of reports
## AFRO countries * number of weeks
theoretical_reports <- 47 * expected_reports
## get counts of ontime and total reports by country and epiweek
timely_report_wk <- processed_data_agg %>%
group_by(country, epiweek) %>%
summarise(not_late = sum(on_time),
reports = n())
## get count of non-zero late rows and divide by theoretical reports
num_timely_reports <- timely_report_wk %>%
summarise(week_timely = sum(not_late != 0)) %>%
summarise(sum(week_timely)) %>%
pull()
prop_timely_reports <- str_glue(
round(num_timely_reports / theoretical_reports * 100, digits = 0),
"%")
## weekly timeliness ----------------------------------------------------------
## get the number of countries submitted on time by week
## and proportion of 47 AFRO countries
wkly_num_timely_reports <- timely_report_wk %>%
group_by(epiweek) %>%
summarise(week_timely = sum(not_late != 0),
prop_timely = round(week_timely / 47 * 100,
digits = 0)
)
## paste bits together
wkly_timeliness <- str_glue(
"{wkly_num_timely_reports$prop_timely}% during {week_subs}"
)
## New events notified ---------------------------------------------------------
## get new events and countries in month
new_events <- phe_data %>%
filter(week_notified_to_who %in% levels(current_weeks))
## get number of new events
count_new_events <- nrow(new_events)
## pull together a sentence listing events if there were any
## if not simply return an empty character
if (count_new_events == 0) {
events_list <- ""
}
if (count_new_events != 0) {
events_list <- c("These included",
str_glue(", {new_events$event} in {new_events$country}"),
"."
)
}
## Closed events --------------------------------------------------------------
## get closed events and countries in month
closed_events <- phe_data %>%
filter(week_event_closed %in% levels(current_weeks))
## get number of closed events
count_closed_events <- nrow(closed_events)
## pull together a sentence listing events if there were any
## if not simply return an empty character
if (count_closed_events == 0) {
closed_events_list <- ""
}
if (count_closed_events != 0) {
closed_events_list <- c("These included",
str_glue(" {closed_events$event} in {closed_events$country} (notified on {closed_events$date_notified_to_who})"),
"."
)
}
## Ongoing events -------------------------------------------------------------
## get ongoing events and countries in month
ongoing_events <- phe_data %>%
filter(status == "Ongoing")
## get number of ongoing events
count_ongoing_events <- nrow(ongoing_events)
## get number of ongoing event types
count_ongoing_events_types <- length(unique(ongoing_events$event))
## get number of countries with ongoing events
count_ongoing_events_countries <- length(unique(ongoing_events$country))
## leading causes of events
## get counts to plot later
top_ongoing_events_base <- ongoing_events %>%
tab_linelist(event) %>%
arrange(desc(n)) # sort based on decreasing counts
## pull the top 5 events
top_ongoing_events <- top_ongoing_events_base %>%
mutate(proportion = round(proportion, digits = 0)) %>%
top_n(5)
## pull together a sentence listing events if there were any
## if not simply return an empty character
if (count_ongoing_events == 0) {
top_events_list <- ""
}
if (count_ongoing_events != 0) {
top_events_list <- c("The leading causes of events were",
str_glue(" {top_ongoing_events$value} ({top_ongoing_events$n} events {top_ongoing_events$proportion}%)"),
"."
)
}
## get shorter version of events list for highlights
highlights_events_list <- str_glue(" {top_ongoing_events$value} ({top_ongoing_events$n} events {top_ongoing_events$proportion}%)")
## top countries with events happening
top_ongoing_events_countries <- ongoing_events %>%
tab_linelist(country) %>%
arrange(desc(n)) %>% # sort based on decreasing counts
mutate(proportion = round(proportion, digits = 0)) %>%
top_n(5)
## pull together a sentence listing events if there were any
## if not simply return an empty character
if (count_ongoing_events == 0) {
top_countries_list <- ""
}
if (count_ongoing_events != 0) {
top_countries_list <- c("The top five countries in terms of number of ongoing public health events were",
str_glue(" {top_ongoing_events_countries$value} ({top_ongoing_events_countries$n} events {top_ongoing_events_countries$proportion}%)"),
str_glue(" Indeed, {sum(top_ongoing_events_countries$proportion)}% of public health events are occuring in the top 5 countries.")
)
}
## get shorter version of events list for highlights
highlights_country_list <- str_glue(" {top_ongoing_events_countries$value}")
## reporting delay -------------------------------------------------------------
median_report_delay <- summary(ongoing_events$reporting_delay, na.rm = TRUE)
r num_cntry of 47(r prop_cntry) submitted at least one IDSR report to the
WHO regional office for Africa (AFRO) during
r str_glue("{current_month} {current_year}")
r str_glue("{start_week} to {end_week}") versus
r num_cntry_full (r prop_cntry_full ) that submitted all r expected_reports
expected reports. - The weekly reporting completeness was
r wkly_completeness.
- During
r str_glue("{current_month} {current_year}") among the
r theoretical_reports (47xr expected_reports), r num_timely_reports were
submitted on time giving an overall timeliness of r prop_timely_reports.
- The weekly timeliness was as follows, for respective weeks:
r wkly_timeliness
- A total of
r nrow(threshold_counts) alert thresholds were triggered during
r str_glue("{current_month} {current_year}") for r treshold_disease_counts
diseases or conditions under surveillance in r threshold_country_counts countries,
with requests for verification sent to Member States by the WHO AFRO.
- The top 5 diseases with alert thresholds triggered are:
r top_triggers_list
r count_ongoing_events outbreaks and other health emergencies are ongoing in
the region in r count_ongoing_events_countries. - The top 5 ongoing events are:
r highlights_events_list
r highlights_country_list are the top 5 countries in terms of number of ongoing
events reported.
III- Disease Surveillance in the African region
III-1. Completeness and timeliness in reporting to the WHO African region
Completeness
- During
r str_glue("{current_month} {current_year}") (
r str_glue("{start_week} to {end_week}")) r num_cntry of 47(r prop_cntry)
submitted at least one of the r expected_reports expected IDSR reports to
WHO AFRO.
r num_cntry_full (r prop_cntry_full ) countries submitted all
r expected_reports during the month- The weekly reporting completeness was as follows, for respective weeks:
r wkly_completeness
- Among the
r total_reports weekly reports received during the month,
r non_missings(r non_missings_prop) were complete (without any missing value)
r complete_countries countries of 47 (r complete_countries_prop) submitted
at least one report with missing values. The WHO AFRO provided necessary feedback
to MS on missing values for further verification.
Figure 1. Spatial distribution of countries by number of reports submitted
during r str_glue("{current_month} {current_year}")
## Prepare data for plotting ---------------------------------------------------
## fix counts of completeness
intermed_complete <- cntry_report_wk_miss %>%
summarise_at(vars(contains("n")), ~sum(. != 0))
intermed_complete_prop <- round(intermed_complete / 47 * 100, digits = 0)
combo_reports <- wkly_num_timely_reports %>%
## add completeness as variables (change to numeric from df)
mutate(weekly_complete = as.numeric(intermed_complete),
prop_complete = as.numeric(intermed_complete_prop)) %>%
## stack data to be used for plotting
pivot_longer(-epiweek, names_to = "variable", values_to = "value") %>%
## drop extra variables (rows in this case)
filter(variable %in% c("prop_timely", "prop_complete"))
## Plot bar chart --------------------------------------------------------------
ggplot(combo_reports,
aes(x = epiweek, y = value, group = variable, fill = variable)) +
## plot as bar, use the numbers as-is, put bars next to each other
geom_bar(stat = "identity", position = "dodge") +
## choose colours and labels for variables
scale_fill_manual(values = c("#8b0000", "#AEB6E5"),
labels = c("Complete", "On-time"),
name = "") +
## make the y axes meet at origin and go to 100
scale_y_continuous(expand = c(0, 0), limits = c(0, 100)) +
## change axis labels
labs(x = "Calendar week",
y = "Country reports (%)") +
## use basic black/white plot
theme_classic(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 3. Distribution of completeness and timeliness for country reports
by week, during r str_glue("{current_month} {current_year}"), by sub-region
## Prepare data for plotting ---------------------------------------------------
## categorise reporting statuses
## create a character var based on number of reports submitted, complete and ontime
cats_fix <- country_region_counts %>%
mutate(categories = case_when(
reports == 0 ~ "Not submitted",
reports != 0 &
complete == 0 &
timely == 0 ~ "Incomplete & Late",
reports != 0 &
complete != 0 &
timely == 0 ~ "Complete & Late",
reports != 0 &
complete == 0 &
timely != 0 ~ "Incomplete & ontime",
reports != 0 &
complete != 0 &
timely != 0 ~ "Complete & ontime"),
## changes to a factor variable and make sure levels are in correct order
categories = factor(categories,
levels = c("Complete & ontime",
"Incomplete & ontime",
"Complete & Late",
"Incomplete & Late",
"Not submitted"))
) %>%
ungroup() %>% ## remove grouping
select(-WHO_SUBREG) ## drop the WHO_SUBREG variable
## join to dataframe of afro countries created who_subregions code chunk
tile_counts <- left_join(region_countries,
cats_fix,
by = "country") %>%
## put empty counts in the first epiweek of interest
mutate(epiweek = fct_explicit_na(epiweek,
levels(current_weeks)[1])) %>%
## fill in missing counts (set to zero)
complete(country, epiweek, fill = list(reports = 0,
complete = 0,
timely = 0,
categories = "Not submitted")) %>%
## fill downards the WHO subregion variable
fill(WHO_SUBREG)
## Plot tile chart -------------------------------------------------------------
ggplot(tile_counts, aes(x = epiweek, y = country, fill = categories)) +
## set the border of tiles to be white and thin
geom_tile(colour = "white", size = 0.25) +
## attempt to facet by WHO region (messy, ignore)
# facet_grid(WHO_SUBREG~., scales = "free_y", space = "free") +
## make axes meet at origin and arange countries alphabetically
scale_y_discrete(expand = c(0,0), limits = rev(unique(tile_counts$country))) +
## colour tiles appropriately (traffic light system)
scale_fill_manual(values = c("#006027", "#abdda4", "#e6f598", "#f46d43", "#d53e4f")) +
## make tiles boxes
coord_fixed(ratio = 1) +
## change axis labels
labs(x = "Calendar week") +
theme_minimal(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),
legend.title = element_blank())
Figure 5: Bivariate map showing number of country reports by completeness
(non-missings) and timeliness.
## fix the infinities
threshold_counts <- threshold_counts %>%
mutate(CFR = na_if(CFR, Inf))
## loop over each of epiweeks of interest, output a title and table for each
for (i in 1:length(levels(current_weeks))) {
## pull togther a title (wrap in stars for bold)
print(str_glue("**Table {i}: Diseases and conditions that triggered alert thresholds
during week {levels(current_weeks)[i]}**"))
## filter for correct epiweek then choose columns of interest
print(
threshold_counts %>%
filter(epiweek == levels(current_weeks)[{{i}}]) %>%
select(
Disease = disease,
Country = country,
Cases = cases,
Deaths = deaths,
CFR,
"Verification status") %>%
kable()
)
cat('\n') ## seperate the tables (otherwise merged by word)
}
A total of [x] alerts thresholds were confirmed as outbreaks as result of
investigations ([x])%, [x] were discarded following verification and
investigation ([x]%) and [x] are still under verification ([x]).
Figure 6: Spatial distribution of diseases and conditions that triggered alert
thresholds by country in the African region
## plot with counts data
ggplot(top_ongoing_events_base) +
## plot a bar and reorder events based on the counts (use counts as they are)
geom_bar(aes(x = reorder(value, n), y = n), stat = "identity", fill = "#79ABE2") +
## flip x and y axes
coord_flip() +
## make the y axes meet at origin
scale_y_continuous(expand = c(0,0)) +
## change axis labels
labs(y = "Number of reports (n)", x = "Events") +
## use basic black/white plot
theme_classic(base_size = 18)
r top_countries_list
The Median delay between the onset of the first/index case and the reporting to
WHO for all the ongoing events, with dates available, was r median_report_delay["Median"],
ranging from r median_report_delay["Min."] to r median_report_delay["Max."].
Table r expected_reports + 1: Grading of currently ongoing public health
events in the African region.
<!-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/// grading \\
This section creates a table of counts and porportions for grading of ongoing
events.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -->
```r
ongoing_events %>%
## get table with counts and props
tab_linelist(grade) %>%
## select columns and rename appropriately (New = old)
select("Grade" = value,
"Counts" = n,
"%" = proportion) %>%
## make in to nice table and set number of digits
kable(digits = 1)
```
**Figure 8**: Spatial distribution of ongoing public health events in the African
region as of `r format(aweek::week2date(end_week) + 7, "%d/%m/%Y")`
<!-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/// grading_map \\\
This section creates a map with cases and deaths dots, and a choropleth based on
the highest grading for each country.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -->
## Prepare data for plotting ---------------------------------------------------
## using only on-going events
top_grade <- ongoing_events %>%
## group by country
group_by(country) %>%
## create an integer out of factor variable for choosing highest
mutate(numeric_grade = as.integer(grade)) %>%
## choose the highest graded report for each country
top_n(1, numeric_grade) %>%
## for those with multiple highest grade, choose that with highest total cases
## if there is still a tie then pick one at random
mutate(highest_cases = rank(-total_cases, ties.method = "random")) %>%
## choose rows selected above
filter(highest_cases == 1) %>%
## select variables need for plotting
select(country, total_cases, deaths, grade)
## join counts to map
afro_shp <- left_join(afro_shp, top_grade, by = "country")
## fill in missing grading and non AFRO MS
afro_shp <- afro_shp %>%
mutate(grade = if_else(is.na(grade) &
WHO_REG == "AFRO",
"No reported events",
as.character(grade)),
grade = factor(grade, levels = c("Ungraded",
"No reported events",
"Grade 1",
"Grade 2",
"Grade 3",
"Protracted 1",
"Protracted 2",
"Protracted 3")))
## create categorical variables for dots
afro_shp$total_cases <- cut(afro_shp$total_cases,
breaks = c(0, 100, 1000, 5000, 10000, Inf),
labels = c(1,
2,
3,
4,
5))
afro_shp$deaths <- cut(afro_shp$deaths,
breaks = c(0, 100, 1000, 5000, 10000, Inf),
labels = c(1,
2,
3,
4,
5))
## Plot map --------------------------------------------------------------------
## plot overall map for region
overall_plot <- ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = afro_shp,
aes(fill = grade),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_manual(drop = FALSE,
values = c("Grey60",
"#cfdcb3", ## light green
"#f6f09e", ## light yellow
"#f0c180", ## light orange
"#eca39b", ## light red
"#f3e600", ## dark yellow
"#e59701", ## dark orange
"#e73f11"), ## dark red
na.value = "grey90",
labels = c(levels(afro_shp$grade),
"Non-AFRO"),
name = "Highest grade") +
## plot dots for total cases - size based on number
geom_point(data = afro_shp,
aes(size = as.integer(total_cases),
geometry = geometry,
colour = "Total cases"),
stat = "sf_coordinates") +
## plot dots for deaths - size based on number
geom_point(data = afro_shp,
aes(size = as.integer(deaths),
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(2,10),
name = "Number",
labels = c("1-100",
"101-1000",
"1001-5000",
"5001-10000",
"10001+") ) +
## set the colours of dots
scale_colour_manual(values = c("#00366C", "#79ABE2"),
name = "Measure") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 18)
## plot each of the islands seperately
island_plot <- purrr::map(islands,
function(x) {
ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = filter(afro_shp, country == x),
aes(fill = grade),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_manual(drop = FALSE,
values = c("Grey60",
"#cfdcb3", ## light green
"#f6f09e", ## light yellow
"#f0c180", ## light orange
"#eca39b", ## light red
"#f3e600", ## dark yellow
"#e59701", ## dark orange
"#e73f11"), ## dark red
na.value = "grey90",
labels = c(levels(afro_shp$grade),
"Non-AFRO"),
name = "Highest grade") +
## plot dots for total cases - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = as.integer(total_cases),
geometry = geometry,
colour = "Total cases"),
stat = "sf_coordinates") +
## plot dots for deaths - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = as.integer(deaths),
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(2,10),
name = "Number",
labels = c("1-100",
"101-1000",
"1001-5000",
"5001-10000",
"10001+") ) +
## set the colours of dots
scale_colour_manual(values = c("#00366C", "#79ABE2"),
name = "Measure") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
# annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 12) +
theme(legend.position = "none",
panel.border = element_rect(colour = "black", fill = NA),
plot.margin = margin(10,
10,
10,
10)) +
ggtitle(x)
}
)
## using {patchwork} - set the plot layout area
## The overall map goes from top left at 1,1 to bottom right at 10,10
## the islands are plotted below that
## (think of this as upside-down cartesian coordinates)
layout <- c(
area(t = 1, l = 1, b = 10, r = 10),
area(t = 11, l = 1, b = 12, r = 10))
overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-2. Cholera outbreaks in the region
## Prepare data for plotting ---------------------------------------------------
cholera_weekly <- cholera_outbreak_data %>%
group_by(epiweek) %>%
summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
CFR = round(deaths / cases_total * 100, digits = 1)) %>%
complete(epiweek, fill = list(cases_total = 0,
deaths = 0,
CFR = 0)) %>%
mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Plot bar charts -------------------------------------------------------------
ggplot(cholera_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) +
geom_bar(stat = "identity") +
scale_fill_discrete_sequential(palette = "Reds",
drop = FALSE,
name = "CFR (%)") +
## make the y axes meet at origin
scale_y_continuous(expand = c(0, 0)) +
## change axis labels
labs(x = "Calendar week",
y = "Cases (n)") +
## use basic black/white plot
theme_classic(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 10: Distribution of cases by country and week for
r length(unique(cholera_outbreak_data$country)) countries experiencing a
cholera outbreak in the African region
## Prepare data for plotting ---------------------------------------------------
cholera_country <- cholera_outbreak_data %>%
group_by(country) %>%
summarise(cholera_cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
cholera_deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
cholera_CFR = round(cholera_deaths / cholera_cases_total * 100, digits = 1))
## join counts to map
afro_shp <- left_join(afro_shp, cholera_country, by = "country")
## create a categorical variable using the age_categories function
## (we aren't using ages - but it functions the same way!)
afro_shp <- afro_shp %>%
mutate(cholera_CFR = cut(cholera_CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Change NAs for AFRO countries to be "No outbreak"
## (leave non-AFRO as NA)
afro_shp <- afro_shp %>%
mutate(cholera_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(cholera_CFR),
"No outbreak", as.character(cholera_CFR)))
## change back to a factor variable
afro_shp <- afro_shp %>%
mutate(cholera_CFR_cat = factor(cholera_CFR_cat,
levels = c("No outbreak",
levels(cholera_CFR))))
## Plot map --------------------------------------------------------------------
## plot overall map for region
overall_plot <- ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = afro_shp,
aes(fill = cholera_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$cholera_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = afro_shp,
aes(size = cholera_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = afro_shp,
aes(size = cholera_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 18)
## plot each of the islands seperately
island_plot <- purrr::map(islands,
function(x) {
ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = filter(afro_shp, country == x),
aes(fill = cholera_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$cholera_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = cholera_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = cholera_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
# annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 12) +
theme(legend.position = "none",
panel.border = element_rect(colour = "black", fill = NA),
plot.margin = margin(10,
10,
10,
10)) +
ggtitle(x)
}
)
## using {patchwork} - set the plot layout area
## The overall map goes from top left at 1,1 to bottom right at 10,10
## the islands are plotted below that
## (think of this as upside-down cartesian coordinates)
layout <- c(
area(t = 1, l = 1, b = 10, r = 10),
area(t = 11, l = 1, b = 12, r = 10))
overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-3. Measles outbreaks in the region
## Prepare data for plotting ---------------------------------------------------
measles_weekly <- measles_outbreak_data %>%
group_by(epiweek) %>%
summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
CFR = round(deaths / cases_total * 100, digits = 1)) %>%
complete(epiweek, fill = list(cases_total = 0,
deaths = 0,
CFR = 0)) %>%
mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Plot bar charts -------------------------------------------------------------
ggplot(measles_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) +
geom_bar(stat = "identity") +
scale_fill_discrete_sequential(palette = "Reds",
drop = FALSE,
name = "CFR (%)") +
## make the y axes meet at origin
scale_y_continuous(expand = c(0, 0)) +
## change axis labels
labs(x = "Calendar week",
y = "Cases (n)") +
## use basic black/white plot
theme_classic(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 13: Distribution of cases by country and week for
r length(unique(measles_outbreak_data$country)) countries experiencing a
measles outbreak in the African region
## Prepare data for plotting ---------------------------------------------------
measles_country <- measles_outbreak_data %>%
group_by(country) %>%
summarise(measles_cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
measles_deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
measles_CFR = round(measles_deaths / measles_cases_total * 100, digits = 1))
## join counts to map
afro_shp <- left_join(afro_shp, measles_country, by = "country")
## create a categorical variable using the age_categories function
## (we aren't using ages - but it functions the same way!)
afro_shp <- afro_shp %>%
mutate(measles_CFR = cut(measles_CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Change NAs for AFRO countries to be "No outbreak"
## (leave non-AFRO as NA)
afro_shp <- afro_shp %>%
mutate(measles_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(measles_CFR),
"No outbreak", as.character(measles_CFR)))
## change back to a factor variable
afro_shp <- afro_shp %>%
mutate(measles_CFR_cat = factor(measles_CFR_cat,
levels = c("No outbreak",
levels(measles_CFR))))
## Plot map --------------------------------------------------------------------
## plot overall map for region
overall_plot <- ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = afro_shp,
aes(fill = measles_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$measles_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = afro_shp,
aes(size = measles_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = afro_shp,
aes(size = measles_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 18)
## plot each of the islands seperately
island_plot <- purrr::map(islands,
function(x) {
ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = filter(afro_shp, country == x),
aes(fill = measles_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$measles_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = measles_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = measles_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
# annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 12) +
theme(legend.position = "none",
panel.border = element_rect(colour = "black", fill = NA),
plot.margin = margin(10,
10,
10,
10)) +
ggtitle(x)
}
)
## using {patchwork} - set the plot layout area
## The overall map goes from top left at 1,1 to bottom right at 10,10
## the islands are plotted below that
## (think of this as upside-down cartesian coordinates)
layout <- c(
area(t = 1, l = 1, b = 10, r = 10),
area(t = 11, l = 1, b = 12, r = 10))
overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-4. Poliomyelitis outbreaks in the region
## Prepare data for plotting ---------------------------------------------------
polio_weekly <- polio_outbreak_data %>%
group_by(epiweek) %>%
summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
CFR = round(deaths / cases_total * 100, digits = 1)) %>%
complete(epiweek, fill = list(cases_total = 0,
deaths = 0,
CFR = 0)) %>%
mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Plot bar charts -------------------------------------------------------------
ggplot(polio_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) +
geom_bar(stat = "identity") +
scale_fill_discrete_sequential(palette = "Reds",
drop = FALSE,
name = "CFR (%)") +
## make the y axes meet at origin
scale_y_continuous(expand = c(0, 0)) +
## change axis labels
labs(x = "Calendar week",
y = "Cases (n)") +
## use basic black/white plot
theme_classic(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 16: Distribution of cases by country and week for
r length(unique(polio_outbreak_data$country)) countries experiencing a
polio outbreak in the African region
## Prepare data for plotting ---------------------------------------------------
polio_country <- polio_outbreak_data %>%
group_by(country) %>%
summarise(polio_cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
polio_deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
polio_CFR = round(polio_deaths / polio_cases_total * 100, digits = 1))
## join counts to map
afro_shp <- left_join(afro_shp, polio_country, by = "country")
## create a categorical variable using the age_categories function
## (we aren't using ages - but it functions the same way!)
afro_shp <- afro_shp %>%
mutate(polio_CFR = cut(polio_CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Change NAs for AFRO countries to be "No outbreak"
## (leave non-AFRO as NA)
afro_shp <- afro_shp %>%
mutate(polio_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(polio_CFR),
"No outbreak", as.character(polio_CFR)))
## change back to a factor variable
afro_shp <- afro_shp %>%
mutate(polio_CFR_cat = factor(polio_CFR_cat,
levels = c("No outbreak",
levels(polio_CFR))))
## Plot map --------------------------------------------------------------------
## plot overall map for region
overall_plot <- ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = afro_shp,
aes(fill = polio_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$polio_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = afro_shp,
aes(size = polio_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = afro_shp,
aes(size = polio_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 18)
## plot each of the islands seperately
island_plot <- purrr::map(islands,
function(x) {
ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = filter(afro_shp, country == x),
aes(fill = polio_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$polio_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = polio_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = polio_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
# annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 12) +
theme(legend.position = "none",
panel.border = element_rect(colour = "black", fill = NA),
plot.margin = margin(10,
10,
10,
10)) +
ggtitle(x)
}
)
## using {patchwork} - set the plot layout area
## The overall map goes from top left at 1,1 to bottom right at 10,10
## the islands are plotted below that
## (think of this as upside-down cartesian coordinates)
layout <- c(
area(t = 1, l = 1, b = 10, r = 10),
area(t = 11, l = 1, b = 12, r = 10))
overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-5. Yellow fever outbreaks in the region
## Prepare data for plotting ---------------------------------------------------
yellowfever_weekly <- yellowfever_outbreak_data %>%
group_by(epiweek) %>%
summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
CFR = round(deaths / cases_total * 100, digits = 1)) %>%
complete(epiweek, fill = list(cases_total = 0,
deaths = 0,
CFR = 0)) %>%
mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Plot bar charts -------------------------------------------------------------
ggplot(yellowfever_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) +
geom_bar(stat = "identity") +
scale_fill_discrete_sequential(palette = "Reds",
drop = FALSE,
name = "CFR (%)") +
## make the y axes meet at origin
scale_y_continuous(expand = c(0, 0)) +
## change axis labels
labs(x = "Calendar week",
y = "Cases (n)") +
## use basic black/white plot
theme_classic(base_size = 18) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 19: Distribution of cases by country and week for
r length(unique(yellowfever_outbreak_data$country)) countries experiencing a
yellow fever outbreak in the African region
## Prepare data for plotting ---------------------------------------------------
yellowfever_country <- yellowfever_outbreak_data %>%
group_by(country) %>%
summarise(yellowfever_cases_total = sum(new_suspected_cases, na.rm = TRUE) +
sum(new_probable_cases, na.rm = TRUE) +
sum(new_confirmed_cases, na.rm = TRUE),
yellowfever_deaths = sum(new_deaths_suspected, na.rm = TRUE) +
sum(new_deaths_confirmed_cases, na.rm = TRUE),
yellowfever_CFR = round(yellowfever_deaths / yellowfever_cases_total * 100, digits = 1))
## join counts to map
afro_shp <- left_join(afro_shp, yellowfever_country, by = "country")
## create a categorical variable using the age_categories function
## (we aren't using ages - but it functions the same way!)
afro_shp <- afro_shp %>%
mutate(yellowfever_CFR = cut(yellowfever_CFR, breaks = c(0, 0.1, 1:5, 100),
include.lowest = TRUE,
labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0",
"3.1-4.0", "4.1-5", "5+")))
## Change NAs for AFRO countries to be "No outbreak"
## (leave non-AFRO as NA)
afro_shp <- afro_shp %>%
mutate(yellowfever_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(yellowfever_CFR),
"No outbreak", as.character(yellowfever_CFR)))
## change back to a factor variable
afro_shp <- afro_shp %>%
mutate(yellowfever_CFR_cat = factor(yellowfever_CFR_cat,
levels = c("No outbreak",
levels(yellowfever_CFR))))
## Plot map --------------------------------------------------------------------
## plot overall map for region
overall_plot <- ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = afro_shp,
aes(fill = yellowfever_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$yellowfever_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = afro_shp,
aes(size = yellowfever_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = afro_shp,
aes(size = yellowfever_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 18)
## plot each of the islands seperately
island_plot <- purrr::map(islands,
function(x) {
ggplot() +
## plot shapefile and fill by proportion reporting
## make the borders thin and grey
geom_sf(data = filter(afro_shp, country == x),
aes(fill = yellowfever_CFR_cat),
size = 0.1,
col = "grey80") +
## set the colours for choropleth
## set missings to grey and label them Non-AFRO
scale_fill_discrete_sequential(drop = FALSE,
palette = "Reds",
na.value = "Grey60",
labels = c(levels(afro_shp$yellowfever_CFR_cat),
"Non-AFRO"),
name = "CFR(%)") +
## plot dots for total cases - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = yellowfever_cases_total,
geometry = geometry,
colour = "Cases"),
stat = "sf_coordinates") +
## plot dots for total reports - size based on number
geom_point(data = filter(afro_shp, country == x),
aes(size = yellowfever_deaths,
geometry = geometry,
colour = "Deaths"),
stat = "sf_coordinates") +
## set the range in size of points
scale_size_continuous(range = c(3,10),
name = "Number of reports") +
## set the colours of dots
scale_colour_manual(values = c("#F7C252", "#8b0000"),
name = "") +
## adjust the size of dots for legend (colours only)
guides(colour = guide_legend(override.aes = list(size = 4))) +
## add a scale bar
# annotation_scale(location = "br") +
## get rid of axes and extras
theme_void(base_size = 12) +
theme(legend.position = "none",
panel.border = element_rect(colour = "black", fill = NA),
plot.margin = margin(10,
10,
10,
10)) +
ggtitle(x)
}
)
## using {patchwork} - set the plot layout area
## The overall map goes from top left at 1,1 to bottom right at 10,10
## the islands are plotted below that
## (think of this as upside-down cartesian coordinates)
layout <- c(
area(t = 1, l = 1, b = 10, r = 10),
area(t = 11, l = 1, b = 12, r = 10))
overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
V- Interpretation of the epidemiological situation and recommendations to Member States
R4IDSR/epichecks documentation built on Sept. 18, 2021, 2:03 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## set the current year current_year <- 2020 ## set the current month current_month <- "January" ## set the first week of interest current_week_start <- 1 ## set the last week of interest current_week_stop <- 5 ## set the day that defines the beginning of your epiweek. aweek::set_week_start("Monday") #### The parts below are automated (do not change these) ## pad the current weeks so it is always two values long current_week_start <- stringr::str_pad({current_week_start}, 2, pad = 0) current_week_stop <- stringr::str_pad({current_week_stop}, 2, pad = 0) ## set starting week for the month start_week <- aweek::as.aweek(stringr::str_glue("{current_year}-W{current_week_start}")) ## set the ending week end_week <- aweek::as.aweek(stringr::str_glue("{current_year}-W{current_week_stop}")) ## pull together all weeks of interest as epiweeks factor current_weeks <- aweek::factor_aweek( c(start_week, end_week) ) ## pull together all weeks of interest as numbers current_weeks_nums <- factor(stringr::str_pad(current_week_start:current_week_stop, 2, pad = 0))
## file path where IDSR processed data is input_path <- here::here("Data Files") ## get paths of all the files in weeks of interest folders with .xlsx file format file_paths <- Sys.glob(str_glue("{input_path}/{current_year}/{levels(current_weeks_nums)}/!Imported/*.xlsx")) ## import each excel file individually saved in a list ## do not bind them together imediately processed_data <- import_list(file_paths, rbind = FALSE, na = "NULL") ## apply cleaning steps to each country dataset in list processed_data <- purrr::map(processed_data, epichecks::clean_idsr) ## pull country name from first row of country variable cleaned_names <- purrr::map_chr(purrr::map(processed_data, "country"), 1L) ## overwrite names in processed_data to be simplified country names names(processed_data) <- cleaned_names
## run aggregator function to pull together a merged dataset processed_data_agg <- aggregator(processed_data, output_path = NULL) ## make sure that epiweek is an aweek class processed_data_agg <- processed_data_agg %>% mutate(epiweek = as.aweek(epiweek)) ## filter for weeks of interest processed_data_agg <- filter(processed_data_agg, epiweek >= start_week, epiweek <= end_week) ## make sure all the levels of epiweek are represented in a factor processed_data_agg <- processed_data_agg %>% mutate(epiweek = factor_aweek(epiweek))
## merge IDSR data and shapefile based on country ## only keep country and WHO_SUBREG from the shapefile processed_data_agg <- left_join(processed_data_agg, select(afro_shp, country, WHO_SUBREG), by = "country") %>% select(-geometry) # drop shapefile geomtry from IDSR data ## get full list of countries in AFRO by region region_countries <- afro_shp %>% filter(WHO_REG == "AFRO") %>% # select only rows with AFRO as_tibble() %>% # change class to tibble select(country, WHO_SUBREG, -geometry) # only keep country and reg, drop geometry ## make sure variables are factors with appropriate levels processed_data_agg <- processed_data_agg %>% mutate(country = factor(country, levels = region_countries$country), WHO_SUBREG = factor(WHO_SUBREG, levels = unique(region_countries$WHO_SUBREG)) )
## file path where outbreak data is input_path_outbreak <- here::here("Data Files", "Outbreak weekly notification_compilation.xlsx") ## import the first sheet from the excel file outbreak_data <- import(input_path_outbreak, na = c("Select", "Start date")) ## fix the "Start date" variable name ## was dropped as set as an NA value above names(outbreak_data)[3] <- "Start date" ## define clean variable names using clean_labels from the epitrix package cleaned_colnames <- epitrix::clean_labels(colnames(outbreak_data)) ## overwrite variable names with defined clean names colnames(outbreak_data) <- cleaned_colnames ## create a more useful epiweek variable from the start_date var outbreak_data <- outbreak_data %>% mutate(epiweek = as.aweek(start_date, floor_day = TRUE)) ## filter for weeks of interest outbreak_data <- outbreak_data %>% filter(epiweek %in% levels(current_weeks)) ## turn epiweek in to a factor including all weeks of interest outbreak_data <- outbreak_data %>% mutate(epiweek = factor(epiweek, levels = levels(current_weeks))) ## recode countries names based on dictionary outbreak_data$country <- matchmaker::match_vec(outbreak_data$country, dictionary = country_dict, from = "Alias", to = "AdministrativeLevelName")
I- Introduction notes
The International Health Regulations (IHR), adopted in 2005, state that each
country shall strengthen and maintain the capacity to detect, assess, and respond
to all events that may constitute public health emergencies of international
concern (PHEICs) and report them to the World Health Organization (WHO).
In the African Region, the IHR priorities are being achieved through the
implementation of the Integrated Disease Surveillance (IDSR) adopted by Member
States in 1998.
The IDSR strategy aims to develop and implement comprehensive surveillance and
response systems with the aim of building capacities for early detection and
timely responses to major public health events. As per their IHR obligations and
IDSR commitments, Member States submit to the WHO regional Office for Africa,
on a weekly basis, reports on diseases and conditions under surveillance.
These reports are collated at the WHO regional office to provide an overview on
the status of diseases and conditions under surveillance in the region and to
analyze events that may traverse international boundaries. The current bulletin
synthetizes the completeness and timeliness of reporting as well as the results
of alert threshold analyses for diseases and conditions under surveillance in
the WHO African region. The analyses included in this bulletin are strictly based
on data reported by Member States as a result of the implementation of the IDSR,
which are limited to suspect cases and deaths. This bulletin also provides an
overview of outbreaks and other public health emergencies ongoing in the African
region as per the end of the month of publication. This bulletin focuses in
epidemiological analysis and does not provide any information on responses to
ongoing events in the WHO African region.
II- Highlights
## create timeliness variable -------------------------------------------------- ## set reporting deadline as the wednesday after week of interest (i.e. in week after) ## function returns monday of current_week, add 9 days to that gives following Wed processed_data_agg <- processed_data_agg %>% mutate(report_deadline = week2date(epiweek) + 9) ## fix the date submitted var ## change to date (the original input is day/month/year) processed_data_agg <- processed_data_agg %>% mutate(DataSubmissionDate = as.Date(DataSubmissionDate, origin = "1899-12-30")) ## Create a TRUE/FALSE variable for whether the report was submitted on time processed_data_agg <- processed_data_agg %>% mutate(on_time = DataSubmissionDate <= report_deadline) ## overall timeliness ---------------------------------------------------------- ## get the theoretical number of reports ## AFRO countries * number of weeks theoretical_reports <- 47 * expected_reports ## get counts of ontime and total reports by country and epiweek timely_report_wk <- processed_data_agg %>% group_by(country, epiweek) %>% summarise(not_late = sum(on_time), reports = n()) ## get count of non-zero late rows and divide by theoretical reports num_timely_reports <- timely_report_wk %>% summarise(week_timely = sum(not_late != 0)) %>% summarise(sum(week_timely)) %>% pull() prop_timely_reports <- str_glue( round(num_timely_reports / theoretical_reports * 100, digits = 0), "%") ## weekly timeliness ---------------------------------------------------------- ## get the number of countries submitted on time by week ## and proportion of 47 AFRO countries wkly_num_timely_reports <- timely_report_wk %>% group_by(epiweek) %>% summarise(week_timely = sum(not_late != 0), prop_timely = round(week_timely / 47 * 100, digits = 0) ) ## paste bits together wkly_timeliness <- str_glue( "{wkly_num_timely_reports$prop_timely}% during {week_subs}" )
## New events notified --------------------------------------------------------- ## get new events and countries in month new_events <- phe_data %>% filter(week_notified_to_who %in% levels(current_weeks)) ## get number of new events count_new_events <- nrow(new_events) ## pull together a sentence listing events if there were any ## if not simply return an empty character if (count_new_events == 0) { events_list <- "" } if (count_new_events != 0) { events_list <- c("These included", str_glue(", {new_events$event} in {new_events$country}"), "." ) } ## Closed events -------------------------------------------------------------- ## get closed events and countries in month closed_events <- phe_data %>% filter(week_event_closed %in% levels(current_weeks)) ## get number of closed events count_closed_events <- nrow(closed_events) ## pull together a sentence listing events if there were any ## if not simply return an empty character if (count_closed_events == 0) { closed_events_list <- "" } if (count_closed_events != 0) { closed_events_list <- c("These included", str_glue(" {closed_events$event} in {closed_events$country} (notified on {closed_events$date_notified_to_who})"), "." ) } ## Ongoing events ------------------------------------------------------------- ## get ongoing events and countries in month ongoing_events <- phe_data %>% filter(status == "Ongoing") ## get number of ongoing events count_ongoing_events <- nrow(ongoing_events) ## get number of ongoing event types count_ongoing_events_types <- length(unique(ongoing_events$event)) ## get number of countries with ongoing events count_ongoing_events_countries <- length(unique(ongoing_events$country)) ## leading causes of events ## get counts to plot later top_ongoing_events_base <- ongoing_events %>% tab_linelist(event) %>% arrange(desc(n)) # sort based on decreasing counts ## pull the top 5 events top_ongoing_events <- top_ongoing_events_base %>% mutate(proportion = round(proportion, digits = 0)) %>% top_n(5) ## pull together a sentence listing events if there were any ## if not simply return an empty character if (count_ongoing_events == 0) { top_events_list <- "" } if (count_ongoing_events != 0) { top_events_list <- c("The leading causes of events were", str_glue(" {top_ongoing_events$value} ({top_ongoing_events$n} events {top_ongoing_events$proportion}%)"), "." ) } ## get shorter version of events list for highlights highlights_events_list <- str_glue(" {top_ongoing_events$value} ({top_ongoing_events$n} events {top_ongoing_events$proportion}%)") ## top countries with events happening top_ongoing_events_countries <- ongoing_events %>% tab_linelist(country) %>% arrange(desc(n)) %>% # sort based on decreasing counts mutate(proportion = round(proportion, digits = 0)) %>% top_n(5) ## pull together a sentence listing events if there were any ## if not simply return an empty character if (count_ongoing_events == 0) { top_countries_list <- "" } if (count_ongoing_events != 0) { top_countries_list <- c("The top five countries in terms of number of ongoing public health events were", str_glue(" {top_ongoing_events_countries$value} ({top_ongoing_events_countries$n} events {top_ongoing_events_countries$proportion}%)"), str_glue(" Indeed, {sum(top_ongoing_events_countries$proportion)}% of public health events are occuring in the top 5 countries.") ) } ## get shorter version of events list for highlights highlights_country_list <- str_glue(" {top_ongoing_events_countries$value}") ## reporting delay ------------------------------------------------------------- median_report_delay <- summary(ongoing_events$reporting_delay, na.rm = TRUE)
r num_cntryof 47(r prop_cntry) submitted at least one IDSR report to the WHO regional office for Africa (AFRO) duringr str_glue("{current_month} {current_year}")r str_glue("{start_week} to {end_week}")versusr num_cntry_full(r prop_cntry_full) that submitted allr expected_reportsexpected reports.- The weekly reporting completeness was
r wkly_completeness. - During
r str_glue("{current_month} {current_year}")among ther theoretical_reports(47xr expected_reports),r num_timely_reportswere submitted on time giving an overall timeliness ofr prop_timely_reports. - The weekly timeliness was as follows, for respective weeks:
r wkly_timeliness - A total of
r nrow(threshold_counts)alert thresholds were triggered duringr str_glue("{current_month} {current_year}")forr treshold_disease_countsdiseases or conditions under surveillance inr threshold_country_countscountries, with requests for verification sent to Member States by the WHO AFRO. - The top 5 diseases with alert thresholds triggered are:
r top_triggers_list r count_ongoing_eventsoutbreaks and other health emergencies are ongoing in the region inr count_ongoing_events_countries.- The top 5 ongoing events are:
r highlights_events_list r highlights_country_listare the top 5 countries in terms of number of ongoing events reported.
III- Disease Surveillance in the African region
III-1. Completeness and timeliness in reporting to the WHO African region
Completeness
- During
r str_glue("{current_month} {current_year}")(r str_glue("{start_week} to {end_week}"))r num_cntryof 47(r prop_cntry) submitted at least one of ther expected_reportsexpected IDSR reports to WHO AFRO. r num_cntry_full(r prop_cntry_full) countries submitted allr expected_reportsduring the month- The weekly reporting completeness was as follows, for respective weeks:
r wkly_completeness - Among the
r total_reportsweekly reports received during the month,r non_missings(r non_missings_prop) were complete (without any missing value) r complete_countriescountries of 47 (r complete_countries_prop) submitted at least one report with missing values. The WHO AFRO provided necessary feedback to MS on missing values for further verification.
Figure 1. Spatial distribution of countries by number of reports submitted
during r str_glue("{current_month} {current_year}")
## Prepare data for plotting --------------------------------------------------- ## fix counts of completeness intermed_complete <- cntry_report_wk_miss %>% summarise_at(vars(contains("n")), ~sum(. != 0)) intermed_complete_prop <- round(intermed_complete / 47 * 100, digits = 0) combo_reports <- wkly_num_timely_reports %>% ## add completeness as variables (change to numeric from df) mutate(weekly_complete = as.numeric(intermed_complete), prop_complete = as.numeric(intermed_complete_prop)) %>% ## stack data to be used for plotting pivot_longer(-epiweek, names_to = "variable", values_to = "value") %>% ## drop extra variables (rows in this case) filter(variable %in% c("prop_timely", "prop_complete")) ## Plot bar chart -------------------------------------------------------------- ggplot(combo_reports, aes(x = epiweek, y = value, group = variable, fill = variable)) + ## plot as bar, use the numbers as-is, put bars next to each other geom_bar(stat = "identity", position = "dodge") + ## choose colours and labels for variables scale_fill_manual(values = c("#8b0000", "#AEB6E5"), labels = c("Complete", "On-time"), name = "") + ## make the y axes meet at origin and go to 100 scale_y_continuous(expand = c(0, 0), limits = c(0, 100)) + ## change axis labels labs(x = "Calendar week", y = "Country reports (%)") + ## use basic black/white plot theme_classic(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 3. Distribution of completeness and timeliness for country reports
by week, during r str_glue("{current_month} {current_year}"), by sub-region
## Prepare data for plotting --------------------------------------------------- ## categorise reporting statuses ## create a character var based on number of reports submitted, complete and ontime cats_fix <- country_region_counts %>% mutate(categories = case_when( reports == 0 ~ "Not submitted", reports != 0 & complete == 0 & timely == 0 ~ "Incomplete & Late", reports != 0 & complete != 0 & timely == 0 ~ "Complete & Late", reports != 0 & complete == 0 & timely != 0 ~ "Incomplete & ontime", reports != 0 & complete != 0 & timely != 0 ~ "Complete & ontime"), ## changes to a factor variable and make sure levels are in correct order categories = factor(categories, levels = c("Complete & ontime", "Incomplete & ontime", "Complete & Late", "Incomplete & Late", "Not submitted")) ) %>% ungroup() %>% ## remove grouping select(-WHO_SUBREG) ## drop the WHO_SUBREG variable ## join to dataframe of afro countries created who_subregions code chunk tile_counts <- left_join(region_countries, cats_fix, by = "country") %>% ## put empty counts in the first epiweek of interest mutate(epiweek = fct_explicit_na(epiweek, levels(current_weeks)[1])) %>% ## fill in missing counts (set to zero) complete(country, epiweek, fill = list(reports = 0, complete = 0, timely = 0, categories = "Not submitted")) %>% ## fill downards the WHO subregion variable fill(WHO_SUBREG) ## Plot tile chart ------------------------------------------------------------- ggplot(tile_counts, aes(x = epiweek, y = country, fill = categories)) + ## set the border of tiles to be white and thin geom_tile(colour = "white", size = 0.25) + ## attempt to facet by WHO region (messy, ignore) # facet_grid(WHO_SUBREG~., scales = "free_y", space = "free") + ## make axes meet at origin and arange countries alphabetically scale_y_discrete(expand = c(0,0), limits = rev(unique(tile_counts$country))) + ## colour tiles appropriately (traffic light system) scale_fill_manual(values = c("#006027", "#abdda4", "#e6f598", "#f46d43", "#d53e4f")) + ## make tiles boxes coord_fixed(ratio = 1) + ## change axis labels labs(x = "Calendar week") + theme_minimal(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1), legend.title = element_blank())
Figure 5: Bivariate map showing number of country reports by completeness (non-missings) and timeliness.
## fix the infinities threshold_counts <- threshold_counts %>% mutate(CFR = na_if(CFR, Inf)) ## loop over each of epiweeks of interest, output a title and table for each for (i in 1:length(levels(current_weeks))) { ## pull togther a title (wrap in stars for bold) print(str_glue("**Table {i}: Diseases and conditions that triggered alert thresholds during week {levels(current_weeks)[i]}**")) ## filter for correct epiweek then choose columns of interest print( threshold_counts %>% filter(epiweek == levels(current_weeks)[{{i}}]) %>% select( Disease = disease, Country = country, Cases = cases, Deaths = deaths, CFR, "Verification status") %>% kable() ) cat('\n') ## seperate the tables (otherwise merged by word) }
A total of [x] alerts thresholds were confirmed as outbreaks as result of investigations ([x])%, [x] were discarded following verification and investigation ([x]%) and [x] are still under verification ([x]).
Figure 6: Spatial distribution of diseases and conditions that triggered alert thresholds by country in the African region
## plot with counts data ggplot(top_ongoing_events_base) + ## plot a bar and reorder events based on the counts (use counts as they are) geom_bar(aes(x = reorder(value, n), y = n), stat = "identity", fill = "#79ABE2") + ## flip x and y axes coord_flip() + ## make the y axes meet at origin scale_y_continuous(expand = c(0,0)) + ## change axis labels labs(y = "Number of reports (n)", x = "Events") + ## use basic black/white plot theme_classic(base_size = 18)
r top_countries_list
The Median delay between the onset of the first/index case and the reporting to
WHO for all the ongoing events, with dates available, was r median_report_delay["Median"],
ranging from r median_report_delay["Min."] to r median_report_delay["Max."].
Table r expected_reports + 1: Grading of currently ongoing public health
events in the African region.
<!-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/// grading \\
This section creates a table of counts and porportions for grading of ongoing
events.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -->
```r
ongoing_events %>%
## get table with counts and props
tab_linelist(grade) %>%
## select columns and rename appropriately (New = old)
select("Grade" = value,
"Counts" = n,
"%" = proportion) %>%
## make in to nice table and set number of digits
kable(digits = 1)
```
**Figure 8**: Spatial distribution of ongoing public health events in the African
region as of `r format(aweek::week2date(end_week) + 7, "%d/%m/%Y")`
<!-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/// grading_map \\\
This section creates a map with cases and deaths dots, and a choropleth based on the highest grading for each country. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -->
## Prepare data for plotting --------------------------------------------------- ## using only on-going events top_grade <- ongoing_events %>% ## group by country group_by(country) %>% ## create an integer out of factor variable for choosing highest mutate(numeric_grade = as.integer(grade)) %>% ## choose the highest graded report for each country top_n(1, numeric_grade) %>% ## for those with multiple highest grade, choose that with highest total cases ## if there is still a tie then pick one at random mutate(highest_cases = rank(-total_cases, ties.method = "random")) %>% ## choose rows selected above filter(highest_cases == 1) %>% ## select variables need for plotting select(country, total_cases, deaths, grade) ## join counts to map afro_shp <- left_join(afro_shp, top_grade, by = "country") ## fill in missing grading and non AFRO MS afro_shp <- afro_shp %>% mutate(grade = if_else(is.na(grade) & WHO_REG == "AFRO", "No reported events", as.character(grade)), grade = factor(grade, levels = c("Ungraded", "No reported events", "Grade 1", "Grade 2", "Grade 3", "Protracted 1", "Protracted 2", "Protracted 3"))) ## create categorical variables for dots afro_shp$total_cases <- cut(afro_shp$total_cases, breaks = c(0, 100, 1000, 5000, 10000, Inf), labels = c(1, 2, 3, 4, 5)) afro_shp$deaths <- cut(afro_shp$deaths, breaks = c(0, 100, 1000, 5000, 10000, Inf), labels = c(1, 2, 3, 4, 5)) ## Plot map -------------------------------------------------------------------- ## plot overall map for region overall_plot <- ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = afro_shp, aes(fill = grade), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_manual(drop = FALSE, values = c("Grey60", "#cfdcb3", ## light green "#f6f09e", ## light yellow "#f0c180", ## light orange "#eca39b", ## light red "#f3e600", ## dark yellow "#e59701", ## dark orange "#e73f11"), ## dark red na.value = "grey90", labels = c(levels(afro_shp$grade), "Non-AFRO"), name = "Highest grade") + ## plot dots for total cases - size based on number geom_point(data = afro_shp, aes(size = as.integer(total_cases), geometry = geometry, colour = "Total cases"), stat = "sf_coordinates") + ## plot dots for deaths - size based on number geom_point(data = afro_shp, aes(size = as.integer(deaths), geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(2,10), name = "Number", labels = c("1-100", "101-1000", "1001-5000", "5001-10000", "10001+") ) + ## set the colours of dots scale_colour_manual(values = c("#00366C", "#79ABE2"), name = "Measure") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 18) ## plot each of the islands seperately island_plot <- purrr::map(islands, function(x) { ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = filter(afro_shp, country == x), aes(fill = grade), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_manual(drop = FALSE, values = c("Grey60", "#cfdcb3", ## light green "#f6f09e", ## light yellow "#f0c180", ## light orange "#eca39b", ## light red "#f3e600", ## dark yellow "#e59701", ## dark orange "#e73f11"), ## dark red na.value = "grey90", labels = c(levels(afro_shp$grade), "Non-AFRO"), name = "Highest grade") + ## plot dots for total cases - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = as.integer(total_cases), geometry = geometry, colour = "Total cases"), stat = "sf_coordinates") + ## plot dots for deaths - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = as.integer(deaths), geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(2,10), name = "Number", labels = c("1-100", "101-1000", "1001-5000", "5001-10000", "10001+") ) + ## set the colours of dots scale_colour_manual(values = c("#00366C", "#79ABE2"), name = "Measure") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar # annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 12) + theme(legend.position = "none", panel.border = element_rect(colour = "black", fill = NA), plot.margin = margin(10, 10, 10, 10)) + ggtitle(x) } ) ## using {patchwork} - set the plot layout area ## The overall map goes from top left at 1,1 to bottom right at 10,10 ## the islands are plotted below that ## (think of this as upside-down cartesian coordinates) layout <- c( area(t = 1, l = 1, b = 10, r = 10), area(t = 11, l = 1, b = 12, r = 10)) overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-2. Cholera outbreaks in the region
## Prepare data for plotting --------------------------------------------------- cholera_weekly <- cholera_outbreak_data %>% group_by(epiweek) %>% summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), CFR = round(deaths / cases_total * 100, digits = 1)) %>% complete(epiweek, fill = list(cases_total = 0, deaths = 0, CFR = 0)) %>% mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Plot bar charts ------------------------------------------------------------- ggplot(cholera_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) + geom_bar(stat = "identity") + scale_fill_discrete_sequential(palette = "Reds", drop = FALSE, name = "CFR (%)") + ## make the y axes meet at origin scale_y_continuous(expand = c(0, 0)) + ## change axis labels labs(x = "Calendar week", y = "Cases (n)") + ## use basic black/white plot theme_classic(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 10: Distribution of cases by country and week for
r length(unique(cholera_outbreak_data$country)) countries experiencing a
cholera outbreak in the African region
## Prepare data for plotting --------------------------------------------------- cholera_country <- cholera_outbreak_data %>% group_by(country) %>% summarise(cholera_cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), cholera_deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), cholera_CFR = round(cholera_deaths / cholera_cases_total * 100, digits = 1)) ## join counts to map afro_shp <- left_join(afro_shp, cholera_country, by = "country") ## create a categorical variable using the age_categories function ## (we aren't using ages - but it functions the same way!) afro_shp <- afro_shp %>% mutate(cholera_CFR = cut(cholera_CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Change NAs for AFRO countries to be "No outbreak" ## (leave non-AFRO as NA) afro_shp <- afro_shp %>% mutate(cholera_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(cholera_CFR), "No outbreak", as.character(cholera_CFR))) ## change back to a factor variable afro_shp <- afro_shp %>% mutate(cholera_CFR_cat = factor(cholera_CFR_cat, levels = c("No outbreak", levels(cholera_CFR)))) ## Plot map -------------------------------------------------------------------- ## plot overall map for region overall_plot <- ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = afro_shp, aes(fill = cholera_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$cholera_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = afro_shp, aes(size = cholera_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = afro_shp, aes(size = cholera_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 18) ## plot each of the islands seperately island_plot <- purrr::map(islands, function(x) { ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = filter(afro_shp, country == x), aes(fill = cholera_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$cholera_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = cholera_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = cholera_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar # annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 12) + theme(legend.position = "none", panel.border = element_rect(colour = "black", fill = NA), plot.margin = margin(10, 10, 10, 10)) + ggtitle(x) } ) ## using {patchwork} - set the plot layout area ## The overall map goes from top left at 1,1 to bottom right at 10,10 ## the islands are plotted below that ## (think of this as upside-down cartesian coordinates) layout <- c( area(t = 1, l = 1, b = 10, r = 10), area(t = 11, l = 1, b = 12, r = 10)) overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-3. Measles outbreaks in the region
## Prepare data for plotting --------------------------------------------------- measles_weekly <- measles_outbreak_data %>% group_by(epiweek) %>% summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), CFR = round(deaths / cases_total * 100, digits = 1)) %>% complete(epiweek, fill = list(cases_total = 0, deaths = 0, CFR = 0)) %>% mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Plot bar charts ------------------------------------------------------------- ggplot(measles_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) + geom_bar(stat = "identity") + scale_fill_discrete_sequential(palette = "Reds", drop = FALSE, name = "CFR (%)") + ## make the y axes meet at origin scale_y_continuous(expand = c(0, 0)) + ## change axis labels labs(x = "Calendar week", y = "Cases (n)") + ## use basic black/white plot theme_classic(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 13: Distribution of cases by country and week for
r length(unique(measles_outbreak_data$country)) countries experiencing a
measles outbreak in the African region
## Prepare data for plotting --------------------------------------------------- measles_country <- measles_outbreak_data %>% group_by(country) %>% summarise(measles_cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), measles_deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), measles_CFR = round(measles_deaths / measles_cases_total * 100, digits = 1)) ## join counts to map afro_shp <- left_join(afro_shp, measles_country, by = "country") ## create a categorical variable using the age_categories function ## (we aren't using ages - but it functions the same way!) afro_shp <- afro_shp %>% mutate(measles_CFR = cut(measles_CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Change NAs for AFRO countries to be "No outbreak" ## (leave non-AFRO as NA) afro_shp <- afro_shp %>% mutate(measles_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(measles_CFR), "No outbreak", as.character(measles_CFR))) ## change back to a factor variable afro_shp <- afro_shp %>% mutate(measles_CFR_cat = factor(measles_CFR_cat, levels = c("No outbreak", levels(measles_CFR)))) ## Plot map -------------------------------------------------------------------- ## plot overall map for region overall_plot <- ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = afro_shp, aes(fill = measles_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$measles_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = afro_shp, aes(size = measles_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = afro_shp, aes(size = measles_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 18) ## plot each of the islands seperately island_plot <- purrr::map(islands, function(x) { ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = filter(afro_shp, country == x), aes(fill = measles_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$measles_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = measles_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = measles_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar # annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 12) + theme(legend.position = "none", panel.border = element_rect(colour = "black", fill = NA), plot.margin = margin(10, 10, 10, 10)) + ggtitle(x) } ) ## using {patchwork} - set the plot layout area ## The overall map goes from top left at 1,1 to bottom right at 10,10 ## the islands are plotted below that ## (think of this as upside-down cartesian coordinates) layout <- c( area(t = 1, l = 1, b = 10, r = 10), area(t = 11, l = 1, b = 12, r = 10)) overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-4. Poliomyelitis outbreaks in the region
## Prepare data for plotting --------------------------------------------------- polio_weekly <- polio_outbreak_data %>% group_by(epiweek) %>% summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), CFR = round(deaths / cases_total * 100, digits = 1)) %>% complete(epiweek, fill = list(cases_total = 0, deaths = 0, CFR = 0)) %>% mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Plot bar charts ------------------------------------------------------------- ggplot(polio_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) + geom_bar(stat = "identity") + scale_fill_discrete_sequential(palette = "Reds", drop = FALSE, name = "CFR (%)") + ## make the y axes meet at origin scale_y_continuous(expand = c(0, 0)) + ## change axis labels labs(x = "Calendar week", y = "Cases (n)") + ## use basic black/white plot theme_classic(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 16: Distribution of cases by country and week for
r length(unique(polio_outbreak_data$country)) countries experiencing a
polio outbreak in the African region
## Prepare data for plotting --------------------------------------------------- polio_country <- polio_outbreak_data %>% group_by(country) %>% summarise(polio_cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), polio_deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), polio_CFR = round(polio_deaths / polio_cases_total * 100, digits = 1)) ## join counts to map afro_shp <- left_join(afro_shp, polio_country, by = "country") ## create a categorical variable using the age_categories function ## (we aren't using ages - but it functions the same way!) afro_shp <- afro_shp %>% mutate(polio_CFR = cut(polio_CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Change NAs for AFRO countries to be "No outbreak" ## (leave non-AFRO as NA) afro_shp <- afro_shp %>% mutate(polio_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(polio_CFR), "No outbreak", as.character(polio_CFR))) ## change back to a factor variable afro_shp <- afro_shp %>% mutate(polio_CFR_cat = factor(polio_CFR_cat, levels = c("No outbreak", levels(polio_CFR)))) ## Plot map -------------------------------------------------------------------- ## plot overall map for region overall_plot <- ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = afro_shp, aes(fill = polio_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$polio_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = afro_shp, aes(size = polio_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = afro_shp, aes(size = polio_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 18) ## plot each of the islands seperately island_plot <- purrr::map(islands, function(x) { ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = filter(afro_shp, country == x), aes(fill = polio_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$polio_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = polio_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = polio_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar # annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 12) + theme(legend.position = "none", panel.border = element_rect(colour = "black", fill = NA), plot.margin = margin(10, 10, 10, 10)) + ggtitle(x) } ) ## using {patchwork} - set the plot layout area ## The overall map goes from top left at 1,1 to bottom right at 10,10 ## the islands are plotted below that ## (think of this as upside-down cartesian coordinates) layout <- c( area(t = 1, l = 1, b = 10, r = 10), area(t = 11, l = 1, b = 12, r = 10)) overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
IV-5. Yellow fever outbreaks in the region
## Prepare data for plotting --------------------------------------------------- yellowfever_weekly <- yellowfever_outbreak_data %>% group_by(epiweek) %>% summarise(cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), CFR = round(deaths / cases_total * 100, digits = 1)) %>% complete(epiweek, fill = list(cases_total = 0, deaths = 0, CFR = 0)) %>% mutate(cfr_cat = cut(CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Plot bar charts ------------------------------------------------------------- ggplot(yellowfever_weekly, aes(x = epiweek, y = cases_total, fill = cfr_cat)) + geom_bar(stat = "identity") + scale_fill_discrete_sequential(palette = "Reds", drop = FALSE, name = "CFR (%)") + ## make the y axes meet at origin scale_y_continuous(expand = c(0, 0)) + ## change axis labels labs(x = "Calendar week", y = "Cases (n)") + ## use basic black/white plot theme_classic(base_size = 18) + theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
Figure 19: Distribution of cases by country and week for
r length(unique(yellowfever_outbreak_data$country)) countries experiencing a
yellow fever outbreak in the African region
## Prepare data for plotting --------------------------------------------------- yellowfever_country <- yellowfever_outbreak_data %>% group_by(country) %>% summarise(yellowfever_cases_total = sum(new_suspected_cases, na.rm = TRUE) + sum(new_probable_cases, na.rm = TRUE) + sum(new_confirmed_cases, na.rm = TRUE), yellowfever_deaths = sum(new_deaths_suspected, na.rm = TRUE) + sum(new_deaths_confirmed_cases, na.rm = TRUE), yellowfever_CFR = round(yellowfever_deaths / yellowfever_cases_total * 100, digits = 1)) ## join counts to map afro_shp <- left_join(afro_shp, yellowfever_country, by = "country") ## create a categorical variable using the age_categories function ## (we aren't using ages - but it functions the same way!) afro_shp <- afro_shp %>% mutate(yellowfever_CFR = cut(yellowfever_CFR, breaks = c(0, 0.1, 1:5, 100), include.lowest = TRUE, labels = c("<0.1", "0.1-1.0", "1.1-2.0", "2.1-3.0", "3.1-4.0", "4.1-5", "5+"))) ## Change NAs for AFRO countries to be "No outbreak" ## (leave non-AFRO as NA) afro_shp <- afro_shp %>% mutate(yellowfever_CFR_cat = if_else(WHO_REG == "AFRO" & is.na(yellowfever_CFR), "No outbreak", as.character(yellowfever_CFR))) ## change back to a factor variable afro_shp <- afro_shp %>% mutate(yellowfever_CFR_cat = factor(yellowfever_CFR_cat, levels = c("No outbreak", levels(yellowfever_CFR)))) ## Plot map -------------------------------------------------------------------- ## plot overall map for region overall_plot <- ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = afro_shp, aes(fill = yellowfever_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$yellowfever_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = afro_shp, aes(size = yellowfever_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = afro_shp, aes(size = yellowfever_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 18) ## plot each of the islands seperately island_plot <- purrr::map(islands, function(x) { ggplot() + ## plot shapefile and fill by proportion reporting ## make the borders thin and grey geom_sf(data = filter(afro_shp, country == x), aes(fill = yellowfever_CFR_cat), size = 0.1, col = "grey80") + ## set the colours for choropleth ## set missings to grey and label them Non-AFRO scale_fill_discrete_sequential(drop = FALSE, palette = "Reds", na.value = "Grey60", labels = c(levels(afro_shp$yellowfever_CFR_cat), "Non-AFRO"), name = "CFR(%)") + ## plot dots for total cases - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = yellowfever_cases_total, geometry = geometry, colour = "Cases"), stat = "sf_coordinates") + ## plot dots for total reports - size based on number geom_point(data = filter(afro_shp, country == x), aes(size = yellowfever_deaths, geometry = geometry, colour = "Deaths"), stat = "sf_coordinates") + ## set the range in size of points scale_size_continuous(range = c(3,10), name = "Number of reports") + ## set the colours of dots scale_colour_manual(values = c("#F7C252", "#8b0000"), name = "") + ## adjust the size of dots for legend (colours only) guides(colour = guide_legend(override.aes = list(size = 4))) + ## add a scale bar # annotation_scale(location = "br") + ## get rid of axes and extras theme_void(base_size = 12) + theme(legend.position = "none", panel.border = element_rect(colour = "black", fill = NA), plot.margin = margin(10, 10, 10, 10)) + ggtitle(x) } ) ## using {patchwork} - set the plot layout area ## The overall map goes from top left at 1,1 to bottom right at 10,10 ## the islands are plotted below that ## (think of this as upside-down cartesian coordinates) layout <- c( area(t = 1, l = 1, b = 10, r = 10), area(t = 11, l = 1, b = 12, r = 10)) overall_plot / wrap_plots(island_plot, nrow = 1) + plot_layout(design = layout)
V- Interpretation of the epidemiological situation and recommendations to Member States
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.