Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
225 lines (184 sloc) 9.96 KB
library(ggplot2)
library(ggthemes)
library(grid)
source(paste(getwd(), "utilities", "get_drc_dataset.R", sep="/"))
# Declare colour scheme ---------------------------------------------------
default_colour_scheme <- c(white = rgb(238, 238, 238, maxColorValue = 255),
light_primary = rgb(236, 231, 216, maxColorValue = 255),
dark_primary = rgb(127, 112, 114, maxColorValue = 255),
accent_red = rgb(240, 97, 114, maxColorValue = 255),
accent_blue = rgb(69, 82, 98, maxColorValue = 255))
# Cache DRC data set ------------------------------------------------------
drc_cache <- c(data_set = NULL, last_updated = NULL)
update_cache <- function(start_date = "2018-05-10", source_file) {
print(paste("Updating cache with source file", source_file))
drc_cache[["data_set"]] <- get_drc_data(start_date = start_date, source_file = source_file)
drc_cache[["last_updated"]] <- Sys.time()
return(drc_cache[["data_set"]])
}
print_cache_analysis <- function(cache_expiry, cache_age) {
base_message <- paste("Cache expiry: ", cache_expiry, "s | Cache age: ", round(cache_age, digits = 0), " |>", sep = "")
if (cache_age > cache_expiry) {
print(paste(base_message, "CACHE EXPIRED"))
} else {
print(paste(base_message, "CACHE VALID"))
}
}
is_cache_valid <- function(cache_expiry, quiet = FALSE) {
if(is.null(drc_cache[[last_updated]])){
cache_age <- difftime(as.Date("1970-01-01"), Sys.time(), units = "secs")
} else {
cache_age <- difftime(drc_cache[[last_updated]], Sys.time(), units = "secs")
}
cache_age %<>% as.numeric() %>% abs()
if (!quiet) {
print_cache_analysis(cache_expiry, cache_age)
}
if (cache_age < cache_expiry) {
return(TRUE)
} else {
return(FALSE)
}
}
get_drc_dataset <- function(start_date = "2018-05-10", cache_expiry = 600, source_file){
if(is.null(drc_cache[["last_updated"]])){
cache_valid <- FALSE
} else {
cache_valid <- is_cache_valid(cache_expiry)
}
if(cache_valid){
return(drc_cache[[data_set]])
} else {
update_cache(source_file=source_file) %>% return()
}
}
# PLOT 1: CASE STATUS BY HEALTH ZONE --------------------------------------
plot_case_status_by_health_zone <- function(drc_data,
colour_scheme = default_colour_scheme,
destination_path = paste(getwd(), "visualisations", "drc", sep = "/"),
start_date = "2018-05-10",
major_breaks = "7 days",
minor_breaks = "7 days",
file_prefix = "OVERVIEW",
device = "png",
width = 8,
height = 6) {
p <- ggplot(drc_data[drc_data$case_status != "new",], aes(x = event_date, y = value)) +
facet_grid(health_zone ~ case_type) +
geom_line(aes(group = case_type, colour = case_type, alpha = case_type)) +
geom_point(aes(colour = case_type, alpha = case_type)) +
xlim(c(as.Date(start_date), Sys.Date())) +
scale_x_date(date_labels = "%m/%d", date_breaks = major_breaks, date_minor_breaks = minor_breaks) +
scale_colour_manual(values = c("suspect" = colour_scheme[["accent_blue"]],
"probable" = colour_scheme[["accent_blue"]],
"confirmed" = colour_scheme[["accent_blue"]],
"deceased" = colour_scheme[["accent_red"]]),
guide = FALSE) +
scale_alpha_manual(values = c("suspect" = 0.2,
"probable" = 0.4,
"confirmed" = 0.6,
"deceased" = 0.8),
guide = FALSE) +
ylab("Cases") +
xlab("Date") +
ggtitle(paste("Daily EBOV status", "DRC", max(drc_data$event_date), sep = " - ")) +
labs(subtitle = "Chris von Csefalvay (@chrisvcsefalvay)/CBRD (cbrd.co)") +
theme(panel.spacing.y = unit(0.6, "lines"),
panel.spacing.x = unit(1, "lines"),
plot.title = element_text(colour = colour_scheme[["accent_blue"]]),
plot.subtitle = element_text(colour = colour_scheme[["accent_blue"]]),
axis.line = element_line(colour = colour_scheme[["dark_primary"]]),
panel.background = element_rect(fill = colour_scheme[["white"]]),
panel.grid.major = element_line(colour = colour_scheme[["light_primary"]]),
panel.grid.minor = element_line(colour = colour_scheme[["light_primary"]]),
strip.background = element_rect(fill = colour_scheme[["accent_blue"]]),
strip.text = element_text(colour = colour_scheme[["light_primary"]]))
Sys.time() %>%
format("%d%H%M%S%b%Y") %>%
toupper() %>%
paste("DRC-EBOV-", file_prefix, "-", ., ".", device, sep="") %>%
ggsave(plot = p, device=device, path=destination_path, width = width, height = height)
}
# PLOT 2: EPI CURVE -------------------------------------------------------
plot_epi_curve <- function(drc_data,
colour_scheme = default_colour_scheme,
destination_path = paste(getwd(), "visualisations", "drc", sep = "/"),
start_date = "2018-05-10",
major_breaks = "7 days",
minor_breaks = "7 days",
file_prefix = "EPICURVE",
device = "png",
width = 8,
height = 6){
q <- ggplot(drc_data, aes(x = event_date, y = value)) +
facet_grid(health_zone ~ .) +
geom_col(aes(group = case_status, colour = case_status, fill = case_status)) +
scale_fill_manual(values = c("new" = colour_scheme[["accent_red"]],
"case" = colour_scheme[["dark_primary"]],
"death" = colour_scheme[["accent_blue"]]),
name = "Case status",
breaks = c("new", "case", "death"),
labels = c("new", "alive", "deceased")) +
scale_colour_manual(values = c("new" = alpha(colour_scheme[["accent_red"]], 0.8),
"case" = alpha(colour_scheme[["dark_primary"]], 0.7),
"death" = alpha(colour_scheme[["accent_blue"]], 0.95)),
guide = FALSE) +
xlim(c(as.Date(start_date), Sys.Date())) +
scale_x_date(date_labels = "%m/%d", date_breaks = major_breaks, date_minor_breaks = minor_breaks) +
ylab("Cases") +
xlab("Date") +
ggtitle(paste("Daily EBOV epicurve", "DRC", max(drc_data$event_date), sep = " - ")) +
labs(subtitle = "Chris von Csefalvay (@chrisvcsefalvay)/CBRD (cbrd.co)") +
theme(panel.spacing.y = unit(0.6, "lines"),
panel.spacing.x = unit(1, "lines"),
plot.title = element_text(colour = colour_scheme[["accent_blue"]]),
plot.subtitle = element_text(colour = colour_scheme[["accent_blue"]]),
axis.line = element_line(colour = colour_scheme[["dark_primary"]]),
panel.background = element_rect(fill = colour_scheme[["white"]]),
panel.grid.major = element_line(colour = colour_scheme[["light_primary"]]),
panel.grid.minor = element_line(colour = colour_scheme[["light_primary"]]),
strip.background = element_rect(fill = colour_scheme[["accent_blue"]]),
strip.text = element_text(colour = colour_scheme[["light_primary"]])) + theme(plot.caption = element_text(vjust = 1),
legend.position = "bottom", legend.direction = "horizontal")
Sys.time() %>%
format("%d%H%M%S%b%Y") %>%
toupper() %>%
paste("DRC-EBOV-", file_prefix, "-", ., ".", device, sep="") %>%
ggsave(plot = q, device=device, path=destination_path, width = width, height = height)
}
# CREATE DAILY PLOTS ------------------------------------------------------
create_daily_plots <- function(colour_scheme = default_colour_scheme,
destination_path = paste(getwd(), "visualisations", "drc", sep = "/"),
start_date = "2018-05-10",
overview_major_breaks = "7 days",
overview_minor_breaks = "7 days",
epicurve_major_breaks = "7 days",
epicurve_minor_breaks = "1 day",
overview_prefix = "OVERVIEW",
epicurve_prefix = "EPICURVE",
device = "png",
width = 8,
height = 6,
source_file = "https://raw.githubusercontent.com/cmrivers/ebola_drc/master/drc/data.csv"){
get_drc_dataset(start_date = start_date, source_file = source_file) %T>%
plot_case_status_by_health_zone(.,
colour_scheme = colour_scheme,
destination_path = destination_path,
start_date = start_date,
major_breaks = overview_major_breaks,
minor_breaks = overview_minor_breaks,
file_prefix = overview_prefix,
device = device,
width = width,
height = height) %>%
plot_epi_curve(.,
colour_scheme = colour_scheme,
destination_path = destination_path,
start_date = start_date,
major_breaks = epicurve_major_breaks,
minor_breaks = epicurve_minor_breaks,
file_prefix = epicurve_prefix,
device = device,
width = width,
height = height)
}