Add EDA plots for outbreak scale to sandbox project

.Rprofile

@@ -1,7 +1,12 @@
-for (env_file in list.files(all.files = TRUE, pattern = "^\\.env.*")) {
-  try(readRenviron(env_file), silent = TRUE)
-}
-
+local({
+  for (env_file in list.files(all.files = TRUE, pattern = "^\\.env.*")) {
+    try(readRenviron(env_file), silent = TRUE)
+  }
+  user_rprof <- Sys.getenv("R_PROFILE_USER", normalizePath("~/.Rprofile", mustWork = FALSE))
+  if(interactive() && file.exists(user_rprof)) {
+    source(user_rprof)
+  }
+})
 
 # Put the project library *outside* the project
 #Sys.setenv(RENV_PATHS_LIBRARY_ROOT = file.path(normalizePath("~/.renv-project-libraries", mustWork = FALSE)))
@@ -10,7 +15,7 @@ if(Sys.getenv("USE_CAPSULE") %in% c("1", "TRUE", "true")) {
   if (interactive() && file.exists("renv.lock")) {
     message("renv library not loaded (found env var USE_CAPSULE=", Sys.getenv("USE_CAPSULE"), "). Use `capsule` functions (see https://github.com/MilesMcBain/capsule)")
     if(require(capsule, quietly = TRUE)) {
-    capsule::whinge()
+      capsule::whinge()
     } else {
       message('Install {capsule} with install.packages("capsule", repos = c(mm = "https://milesmcbain.r-universe.dev", getOption("repos")))')
     }
@@ -19,12 +24,13 @@ if(Sys.getenv("USE_CAPSULE") %in% c("1", "TRUE", "true")) {
   source("renv/activate.R")
 }
 
-
 # Use the local user's .Rprofile when interactive.
 # Good for keeping local preferences, but not always reproducible.
-user_rprof <- Sys.getenv("R_PROFILE_USER", normalizePath("~/.Rprofile", mustWork = FALSE))
-if(interactive() && file.exists(user_rprof)) {
-  source(user_rprof)
+
+if (nzchar( Sys.getenv("TAR_PROJECT"))) {
+  message(paste0("targets project is '", Sys.getenv("TAR_PROJECT"), "'"))
+} else {
+  message("targets project is default")
 }
 
 options(
@@ -72,3 +78,4 @@ if(requireNamespace("conflicted", quietly = TRUE)) {
 
 # Suppress summarize messages
 options(dplyr.summarise.inform = FALSE)
+

R/make_outbreak_scale_plots.R

@@ -0,0 +1,88 @@
+make_south_africa_outbreak_scale_map <- function(wahis_rvf_outbreaks_raw) {
+
+  south_africa_map <- rnaturalearth::ne_states(country = "South Africa", returnclass = "sf") |> 
+    sf::st_crop(ymin = -35, ymax = -22, xmin = 16, xmax = 33)
+
+  plot_points <- wahis_rvf_outbreaks_raw |> 
+    group_by(epi_event_id) |> 
+    mutate(outbreak_start_date = lubridate::ymd_hms(outbreak_start_date)) |> 
+    mutate(days = outbreak_start_date - min(outbreak_start_date, na.rm = TRUE),
+           origin_loc = days == 0,
+           single_outbreak = if_else(n() == 1, "Single Outbreak", "Outbreak Origin"),
+           label = format(min(outbreak_start_date), "%Y-%m-%d")) |> 
+    arrange(desc(days)) |> 
+    ungroup() |> 
+    select(country, epi_event_id, report_id, longitude, latitude, days, origin_loc, label, single_outbreak, outbreak_start_date) |> 
+    mutate(across(c(longitude, latitude), as.numeric)) |> 
+    filter(!is.na(longitude), !is.na(latitude))
+
+  plot_points_sa <- plot_points |> 
+    dplyr::filter(country == "south africa")
+
+  ggplot()+
+    geom_sf(data = south_africa_map) +
+    geom_point(data = plot_points_sa, aes(x=longitude, y=latitude, color = origin_loc, shape = single_outbreak), size = 4) +
+    scale_shape_manual(values = c(20,1), name = "") +
+    scale_color_manual(values = c("grey40", "red"), guide = guide_none()) +
+   scale_fill_discrete(guide = guide_none()) +
+    ggforce::geom_mark_hull(data = plot_points_sa,
+                           aes(x=longitude, y=latitude, group = label, fill = label), radius = 0.01, expand = 0.01, concavity = 3) +
+    ggrepel::geom_label_repel(data = plot_points_sa |> dplyr::filter(origin_loc) |> distinct(outbreak_start_date, .keep_all = TRUE), 
+                             mapping = aes(x=longitude, y=latitude, label = label), alpha = 0.8) +
+    theme_void()
+  }
+
+make_africa_outbreak_scale_map <- function(wahis_rvf_outbreaks_raw) {
+
+  plot_points <- wahis_rvf_outbreaks_raw |> 
+    group_by(epi_event_id) |> 
+    mutate(outbreak_start_date = lubridate::ymd_hms(outbreak_start_date)) |> 
+    mutate(days = outbreak_start_date - min(outbreak_start_date, na.rm = TRUE),
+           origin_loc = days == 0,
+           single_outbreak = if_else(n() == 1, "Single Outbreak", "Outbreak Origin"),
+           label = format(min(outbreak_start_date), "%Y-%m-%d")) |> 
+    arrange(desc(days)) |> 
+    ungroup() |> 
+    select(country, epi_event_id, report_id, longitude, latitude, days, origin_loc, label, single_outbreak, outbreak_start_date) |> 
+    mutate(across(c(longitude, latitude), as.numeric)) |> 
+    filter(!is.na(longitude), !is.na(latitude))
+
+  africa_map <- rnaturalearth::ne_countries(continent = "Africa", returnclass = "sf")
+
+  ggplot()+
+    geom_sf(data = africa_map) +
+    geom_point(data = plot_points, aes(x=longitude, y=latitude, color = origin_loc, shape = single_outbreak)) +
+    scale_shape_manual(values = c(20,1), name = "") +
+    scale_color_manual(values = c("grey40", "red"), guide = guide_none()) +
+    scale_fill_discrete(guide = guide_none()) +
+    ggforce::geom_mark_hull(data = plot_points,
+                            aes(x=longitude, y=latitude, fill = label), radius = 0.01, expand = 0.01, concavity = 3) +
+     ggrepel::geom_label_repel(data = plot_points |> dplyr::filter(origin_loc) |> distinct(outbreak_start_date, .keep_all = TRUE), 
+                               mapping = aes(x=longitude, y=latitude, label = label), alpha = 0.8) +
+    theme_void()
+
+}
+
+make_south_africa_outbreaks_timeline <- function(wahis_rvf_outbreaks_raw) {
+
+  plot_points <- wahis_rvf_outbreaks_raw |> 
+    group_by(epi_event_id) |> 
+    mutate(outbreak_start_date = lubridate::ymd_hms(outbreak_start_date)) |> 
+    mutate(days = outbreak_start_date - min(outbreak_start_date, na.rm = TRUE),
+           origin_loc = days == 0,
+           single_outbreak = if_else(n() == 1, "Single Outbreak", "Outbreak Origin"),
+           label = format(min(outbreak_start_date), "%Y-%m-%d")) |> 
+    arrange(desc(days)) |> 
+    ungroup() |> 
+    select(country, epi_event_id, report_id, longitude, latitude, days, origin_loc, label, single_outbreak, outbreak_start_date) |> 
+    mutate(across(c(longitude, latitude), as.numeric)) |> 
+    filter(!is.na(longitude), !is.na(latitude))
+
+  plot_points_sa <- plot_points |> 
+    dplyr::filter(country == "south africa")
+
+  ggplot(plot_points_sa) +
+    geom_density(mapping = aes(x = outbreak_start_date)) +
+    geom_point(data = filter(plot_points_sa, origin_loc), mapping = aes(x = outbreak_start_date, y = 0), col = "red")
+
+}

_targets_sandbox.R

@@ -8,6 +8,28 @@ if(Sys.getenv("USE_CAPSULE") %in% c("1", "TRUE", "true"))
 suppressPackageStartupMessages(source("packages.R"))
 for (f in list.files(here::here("R"), full.names = TRUE)) source (f)
 
+imported_targets <- tar_plan(
+  wahis_rvf_outbreaks_raw =  qs::qdeserialize(paws::s3()$get_object(Sys.getenv("AWS_BUCKET_ID"), Key="_targets/wahis_rvf_outbreaks_raw")$Body)
+)
 
+plot_targets <- tar_plan(
+  south_africa_outbreak_scale_map = structure(make_south_africa_outbreak_scale_map(wahis_rvf_outbreaks_raw), fig.width = 10, fig.height = 10),
+  africa_outbreak_scale_map =       structure(make_africa_outbreak_scale_map(wahis_rvf_outbreaks_raw), fig.width = 10, fig.height = 10),
+  south_africa_outbreaks_timeline = structure(make_south_africa_outbreaks_timeline(wahis_rvf_outbreaks_raw), fig.width = 10, fig.height = 10)
+)
+
+plot_file_targets <- tar_plan(
+  tar_combine(allplots, plot_targets, command = vctrs::vec_c(list(!!!.x))),
+  tar_file(png_plots, ggsave(
+    paste0("outputs/", names(allplots), ".png"), allplots[[1]],
+    units = "in", bg = "white",
+    width = attr(allplots[[1]], "fig.width"), height = attr(allplots[[1]], "fig.height")),
+    pattern = map(allplots)),
+  tar_file(svg_plots, ggsave(
+    paste0("outputs/", names(allplots), ".svg"), allplots[[1]],
+    units = "in", bg = "white",
+    width = attr(allplots[[1]], "fig.width"), height = attr(allplots[[1]], "fig.height")),
+    pattern = map(allplots))
+)
 
 all_targets()