diff --git a/_targets.R b/_targets.R index a051c2c..b7756c4 100644 --- a/_targets.R +++ b/_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") ) ) \ No newline at end of file diff --git a/src/explainer_prep.R b/src/explainer_prep.R new file mode 100644 index 0000000..86f78d6 --- /dev/null +++ b/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")) + +} \ No newline at end of file diff --git a/src/plot_cartogram.R b/src/plot_cartogram.R index 152adfd..a98ee2e 100644 --- a/src/plot_cartogram.R +++ b/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)),