Explainer images

_targets.R

@@ -6,9 +6,11 @@ tar_option_set(packages = c('tidyverse', 'lubridate', 'geofacet', 'cowplot','ggf
 
 source("src/prep_data.R")
 source("src/plot_cartogram.R")
+source("src/explainer_prep.R")
 
 # wet to dry color scale
-pal_wetdry <- c("#002D5E", "#0C7182", "#6CB7B0", "#A7D2D8", "#E0D796", "#AF9423", "#A84E0B")
+pal_wetdry <- c("#002D5E", "#0C7182", "#6CB7B0", "#C0C0C0", "#F0DB85", "#AF9423", "#A84E0B")
+  #c("#002D5E", "#0C7182", "#6CB7B0", "#A7D2D8", "#E0D796", "#AF9423", "#A84E0B")
 percentile_breaks = c(0, 0.05, 0.1, 0.25, 0.75, 0.9, 0.95, 1)
 percentile_labels <- c("Driest", "Drier", "Dry", "Normal","Wet","Wetter", "Wettest")
 color_bknd <- "#F4F4F4"
@@ -22,7 +24,8 @@ showtext_opts(dpi = 300, regular.wt = 200, bold.wt = 700)
 showtext_auto(enable = TRUE)
 
 # draw label text
-flow_label <- "Flow percentile at USGS streamgages relative\nto the historic record."
+flow_label <- "Streamflow percentile at USGS streamgages\nrelative to the historic record."
+#"Flow percentile at USGS streamgages relative\nto the historic record."
 source_label <- "Data: USGS Water Data for the Nation"
 
 # to produce the flow cartogram, run tar_make() in the console
@@ -108,7 +111,7 @@ list(
                   width = 16, height = 9, color_bknd, text_color, font_legend,
                   source_label),
     format = "file"
-  ),
+  ), 
   # Remove facet clipping and save as png
   tar_target(
     flow_cartogram_png,
@@ -162,7 +165,7 @@ list(
                 font_legend),
     format = "file"
   ),
-
+  
   # Flow timeseries for states - Instagram
   tar_target(
     flow_cartogram_instagram_svg,
@@ -237,5 +240,37 @@ list(
     pattern = map(plot_cart_state_ig_story_list, state_abbr_filter),
     format = 'file',
     iteration = 'list'
+  ),
+
+  #### explainer images and updated state ####
+
+  # cowplot the national plot png for instagram with explainer text
+  tar_target(
+    explainer_flow_national_ig_png,
+    cowplot_national_explainer(national_plot_png = "out/flow_national_ig.png",
+                               explainer_label = "HOT TIP: Keep proportions in mind!", 
+                               blue_label = "More blue = wetter conditions",
+                               orange_label = "More yellow/orange = drier conditions",
+                               file_png = "out/explainer_flow_national_ig.png", 
+                               width = 1080, height = 1080, font_legend, text_color,
+                               low_col = "#A84E0B", high_col = "#002D5E", 
+                               low_lab = "Low\nStreamflow", 
+                               high_lab = "High\nStreamflow", 
+                               typ_lab = "Typical\nStreamflow",
+                               typ_lab_ypos = 0.5, typ_arr_ypos = 0.495),
+    format = "file"
+  ),
+
+  # create national plot with a lower alpha value to serve as intro question background
+  tar_target(
+    explainer_intro_background,
+    intro_background(national_data = flow_national, percentile_bin, pal = pal_wetdry) 
+  ),
+
+  # cowplot the intro question instagram png
+  tar_target(
+    intro_question_ig_png,
+    intro_image(plot_nat_clean = explainer_intro_background, date_start, 
+                font_legend, width = 1080, height = 1080, file_png = "out/intro_question_ig.png")
   )
 )

src/explainer_prep.R

@@ -0,0 +1,194 @@
+#' @description Cowplot national data image with explainer annotations
+#' @param explainer_label top annotation for how to read the plot
+#' @param file_png file path for final png
+#' @param width width of final png
+#' @param height height of final png
+#' @param font_legend font used for legend text
+#' @param text_color color used for viz text
+#' @param blue_label label for wet condition interpretation tip
+#' @param orange_label label for dry condition interpretation tip
+cowplot_national_explainer <- function(explainer_label, file_png, national_plot_png,
+                                       width, height, font_legend, text_color, blue_label, orange_label,
+                                       low_col, high_col, low_lab, high_lab, typ_lab, typ_lab_ypos, typ_arr_ypos){
+# typ_lab_ypos = 0.5, typ_arr_ypos = 0.495
+  plot_margin <- 0.025
+  # background
+  canvas <- grid::rectGrob(
+    x = 0, y = 0, 
+    width = 16, height = 9,
+    gp = grid::gpar(fill = color_bknd, alpha = 1, col = color_bknd)
+  )
+
+  #arrows
+  (normal_range_arrow <- ggplot() + 
+      theme_void()+
+      # add arrow using `geom_curve()`
+      geom_curve(aes(x = 13, y = 3,
+                     xend = 11, yend = 3),
+                 arrow = grid::arrow(length = unit(0.2, 'lines')), 
+                 curvature = 0, angle = 100, ncp = 10,
+                 color = text_color, linewidth = 0.2))
+
+  (low_range_arrow <- ggplot() + 
+      theme_void()+
+      # add arrow using `geom_curve()`
+      geom_curve(aes(x = 13, y = 3,
+                     xend = 11, yend = 3),
+                 arrow = grid::arrow(length = unit(0.2, 'lines')), 
+                 curvature = 0, angle = 100, ncp = 10,
+                 color = low_col, linewidth = 0.2))
+
+  (high_range_arrow <- ggplot() + 
+      theme_void()+
+      # add arrow using `geom_curve()`
+      geom_curve(aes(x = 13, y = 3,
+                     xend = 11, yend = 3),
+                 arrow = grid::arrow(length = unit(0.2, 'lines')), 
+                 curvature = 0, angle = 100, ncp = 10,
+                 color = high_col, linewidth = 0.2))
+
+  og_plot_png <- magick::image_read(national_plot_png)
+  # compose final plot
+  ggdraw(ylim = c(0,1), 
+         xlim = c(0,1)) +
+    # a white background
+    draw_grob(canvas,
+              x = 0, y = 1,
+              height = 1, width = 1,
+              hjust = 0, vjust = 1) +
+    draw_image(og_plot_png, 
+               x = 0, y = 0, 
+               width = 1, 
+               hjust = 0, vjust = 0, 
+               halign = 0, valign = 0)+
+    draw_label(explainer_label, 
+               x = 0.5, y = 0.96, 
+               size = 5.5, 
+               hjust = 0, vjust = 1,
+               fontfamily = font_legend,
+               color = "#000000")+ 
+    draw_label(blue_label, 
+               x = 0.5, y = 0.91, 
+               size = 5.5, 
+               hjust = 0, vjust = 1,
+               fontfamily = font_legend,
+               color = high_col)+
+    draw_label(orange_label, 
+               x = 0.5, y = 0.88, 
+               size = 5.5, 
+               hjust = 0, vjust = 1,
+               fontfamily = font_legend,
+               color = low_col)+
+    draw_label(low_lab,
+               x = 0.84, y = 0.355, 
+               size = 5.5, 
+               hjust = 0.5, vjust = 1,
+               fontfamily = font_legend,
+               color = low_col) +
+    draw_label(high_lab,
+               x = 0.84, y = 0.76, 
+               size = 5.5, 
+               hjust = 0.5, vjust = 1,
+               fontfamily = font_legend,
+               color = high_col) +
+    draw_label(typ_lab,
+               x = 0.855, y = typ_lab_ypos, 
+               size = 5.5, 
+               hjust = 0.5, vjust = 1,
+               fontfamily = font_legend,
+               color = text_color) +
+    draw_plot(high_range_arrow, # for high streamflow
+              x = 0.755, y = 0.755,
+              height = 0.035, width = 0.05,
+              hjust = 0, vjust = 0.5)+
+    draw_plot(normal_range_arrow, # for typical streamflow
+              x = 0.755, y = typ_arr_ypos,
+              height = 0.035, width = 0.05,
+              hjust = 0, vjust = 0.5)+
+    draw_plot(low_range_arrow, # for low streamflow
+              x = 0.755, y = 0.35,
+              height = 0.035, width = 0.055,
+              hjust = 0, vjust = 0.5)
+
+  # Save and convert file
+  ggsave(file_png, width = width, height = height, dpi = 300, units = c("px"))
+
+}
+
+#' @description Plot national data for intro question background
+#' @param national_data The proportion of sites in each flow condition, daily
+#' @param percentile_bin bins used to define the percentiles
+#' @param pal color palette for each bin level
+intro_background <- function(national_data, percentile_bin, pal){ 
+
+  (plot_nat_clean <- national_data %>% 
+     ggplot(aes(date, prop)) +
+     geom_area(aes(fill = percentile_bin), alpha = 0.5) +
+     scale_fill_manual(values = rev(pal)) +
+     scale_y_continuous(trans = "reverse",
+                        breaks = rev(c(0, 0.25, 0.5, 0.75, 1)), 
+                        labels = c("0%", "25%", "50%", "75%", "100%")) +
+     coord_fixed(ratio = 28, clip = "off")+
+     theme_void()+
+     theme(legend.position = "none"))
+
+}
+
+#' @description Cowplot intro question image
+#' @param plot_nat_clean Plot of national data used for background
+#' @param date_start first day of focal month
+#' @param font_legend font used for legend text
+#' @param width width of final png
+#' @param height height of final png
+#' @param file_png file path for final png
+intro_image <- function(plot_nat_clean, date_start, font_legend, width, height, file_png){
+
+  plot_month <- lubridate::month(date_start, label = TRUE, abbr = FALSE)
+  plot_year <- lubridate::year(date_start)
+
+  plot_margin <- 0.025
+
+  title_flow_dark <- magick::image_read('in/streamflow.png') |> magick::image_scale('800x') %>%
+    magick::image_colorize(100, "#222222") |> magick::image_scale('800x')
+
+  # background
+  canvas <- grid::rectGrob(
+    x = 0, y = 0, 
+    width = 16, height = 9,
+    gp = grid::gpar(fill = color_bknd, alpha = 1, col = color_bknd)
+  )
+
+  ggdraw(ylim = c(0,1), 
+         xlim = c(0,1)) +
+    # a white background
+    draw_grob(canvas,
+              x = 0, y = 1,
+              height = 0.37, width = 0.37,
+              hjust = 0, vjust = 1) +
+    # national-level plot
+    draw_plot(plot_nat_clean,
+              x = -0.055, y = -0.09,
+              height = 1.18, width = 1.18)+
+    # draw title
+    draw_label(sprintf('%s %s', plot_month, plot_year),
+               x = plot_margin*2, y = 1-plot_margin*1.2,
+               size = 16,
+               hjust = 0, vjust = 1,
+               fontfamily = font_legend,
+               color = "#222222",
+               lineheight = 1)  +
+    # stylized streamflow title
+    draw_image(title_flow_dark ,
+               x = plot_margin*2, y = 1-(1.5*plot_margin),
+               height = 0.16, width = 0.74,
+               hjust = 0, vjust = 1) +
+    draw_label(sprintf("How did %s's\nstreamflow\ncompare to the\npast?", plot_month),
+               x = 0.05, y = 0.5,
+               size = 26,
+               hjust = 0, vjust = 0.5,
+               fontfamily = font_legend,
+               color = "#222222")
+
+  ggsave(file_png, width = width, height = height, dpi = 300, units = c("px"))
+
+}

src/plot_cartogram.R

@@ -97,20 +97,21 @@ plot_national_area <- function(national_data, date_start, date_end, pal, color_b
     ggplot(aes(date, prop)) +
     geom_area(aes(fill = percentile_bin)) +
     theme_classic() +
-    labs(x = lubridate::month(date_end - 30, label = TRUE, abbr = FALSE),
-         y="") +
+    labs(x = lubridate::month(date_end - 30, label = TRUE, abbr = FALSE), #
+         y="% of Streamgages") +
+    #labs(x = lubridate::month(date_end - 30, label = TRUE, abbr = FALSE),
+    #     y="") +
     scale_fill_manual(values = rev(pal)) +
-    scale_y_continuous(trans = "reverse",
-                       breaks = rev(c(0.05,0.5, 0.95)), 
-                       labels = c("0%","gages","100%"),
-                       sec.axis = dup_axis(
-                         labels = c("Dry", "", "Wet")
-                       )) +
+    scale_y_continuous(trans = "reverse", #
+                       breaks = rev(c(0, 0.25, 0.5, 0.75, 1)), #
+                       labels = c("0%", "25%", "50%", "75%", "100%") #
+    ) +
     theme_flowfacet(base = 12, color_bknd, text_color) +
-    theme(axis.text.y = 
-            element_text(size = axis_text_size,
-                         vjust = 1, 
-                         hjust = 1),
+    theme(axis.text.y = element_text(size = axis_text_size, #
+                                     vjust = 0.5, #c(1, 0), #
+                                     hjust = 1), #
+          axis.title.y = element_text(size = axis_title_bottom_size, #
+                                      margin = margin(r = 5)),
           axis.title.x.bottom = element_text(size = axis_title_bottom_size,
                                              vjust = -1,
                                              margin = margin(t = 5)),