Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add IG square state versions #34

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

add IG square state versions #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
41 changes: 35 additions & 6 deletions _targets.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,16 @@ list(
text_size = 6.5)
),

# Restyling legend for Instagram story dimensions
# Restyling legend for Instagram square dimensions
tar_target(
restyle_legend_ig_square,
restyle_legend(plot_nat, text_color, font_legend,
barwidth = 12,
barheight = 0.8,
text_size = 8)
),

# Restyling legend for Instagram story dimensions square
tar_target(
restyle_legend_ig_story,
restyle_legend(plot_nat, text_color, font_legend,
Expand Down Expand Up @@ -200,7 +209,7 @@ list(
# For example, this can be filtered for WSC in CA or OR to post on their Instagram story
tar_target(
state_abbr_of_interest,
c("NJ", "DE", "MD", "PA")
c("DE", "MD")
),

# Filter oconus list to just states of interest
Expand All @@ -210,7 +219,7 @@ list(
state_abbr_oconus[state_abbr_oconus %in% state_abbr_of_interest]
),

# List of state level plots of flow timeseries
# List of state level plots of flow timeseries - ig story version
tar_target(
plot_cart_state_ig_story_list,
plot_state_cartogram_long(state_data = flow_state, filter_states = state_abbr_filter,
Expand All @@ -219,12 +228,12 @@ list(
font_legend, text_color,
date_end, date_start,
axis_title_size = 26, axis_text_size = 18,
axis_title_bottom_size = 22, axis_title_top_size = 24)
axis_title_bottom_size = 22, axis_title_top_size = 24, plot_title_size = 55)
),

# Plot state level facet in long format (9:16) for Instagram story
tar_target(
plot_cart_state_ig_story,
plot_cart_state_ig_story_png,
plot_state_long(state_plot_list = plot_cart_state_ig_story_list,
filter_states = state_abbr_filter,
width = 9, height = 16 , dpi = 300,
Expand All @@ -238,5 +247,25 @@ list(
pattern = map(plot_cart_state_ig_story_list, state_abbr_filter),
format = 'file',
iteration = 'list'
),

# Plot state level facet in long format (1:1) for Instagram
tar_target(
plot_cart_state_ig_square_png,
plot_state_square(state_plot_list = plot_cart_state_ig_story_list,
filter_states = state_abbr_filter,
axis_title_size = 14, axis_text_size = 6,
axis_title_bottom_size = 10, axis_title_top_size = 12, plot_title_size = 14,
width = 1080, height = 1080 , dpi = 300,
create_out_folder = "out/state_cartograms",
background_color = "#F4F4F4",
text_color = text_color,
date_start = date_start,
source_label = source_label,
flow_label = flow_label,
restyle_legend = restyle_legend_ig_square),
pattern = map(plot_cart_state_ig_story_list, state_abbr_filter),
format = 'file',
iteration = 'list'
)
)
147 changes: 144 additions & 3 deletions src/plot_cartogram.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -545,10 +545,11 @@ cartogram_ig <- function(file_svg, plot_nat, plot_cart, date_start, width, heigh
#' @param axis_text_size manual adjustmet of axis text sizing in theming
#' @param axis_title_bottom_size manual adjustment of axis title bottom sizing in theming
#' @param axis_title_top_size manual adjustment of axis title top sizing in theming
#' @param plot_title_size, manaual adjustment of plot title size
#' @return list of individual state level cartograms
plot_state_cartogram_long <- function(state_data, filter_states, fips, pal, usa_grid, color_bknd, sigma_val, xoffset_val,
yoffset_val, font_legend, text_color, date_end, date_start,
axis_title_size, axis_text_size, axis_title_bottom_size, axis_title_top_size){
axis_title_size, axis_text_size, axis_title_bottom_size, axis_title_top_size, plot_title_size){

states_cart_list <- state_data %>%
left_join(fips) %>%
Expand Down Expand Up @@ -603,7 +604,7 @@ plot_state_cartogram_long <- function(state_data, filter_states, fips, pal, usa_
margin = margin(t = -7)),
plot.margin = margin(50, 50, 50, 50, "pt"),
legend.position = 'none',
plot.title = element_text(hjust = 0.5, size = 55, margin = margin(10, 0, 5, 0),
plot.title = element_text(hjust = 0.5, size = plot_title_size, margin = margin(10, 0, 5, 0),
family = font_legend, color = text_color),
text = element_text(family = font_legend)
) +
Expand Down Expand Up @@ -735,9 +736,149 @@ plot_state_long <- function(state_plot_list, filter_states, width, height,

out_folder <- dir.create(file.path(outfolder_month_year_path), showWarnings = FALSE)

filename <- paste0(outfolder_month_year_path, "/", state_names, "_", plot_month, "_", plot_year, ".png")
filename <- paste0(outfolder_month_year_path, "/", state_names, "_", plot_month, "_", plot_year, "_Story", ".png")

# Save and convert file
ggsave(filename, width = width, height = height, dpi = dpi)
return(filename)
}


#' @description Plot states of interest as cartogram in square format
#' @param state_plot_list list of individual state cartograms
#' @param state_names names of individual states to purr::map by
#' @param create_out_folder sub folder path for state level pngs
#' @param date_start first day of focal month
#' @param date_emd last day of focal month
#' @param width Desired width of output plot
#' @param height Desired height of output plot
#' @param background_color Plot background color
#' @param text_color Color of text in plot
#' @param flow_label Flow percentile label placed above legend
#' @param source_label Source label placed in bottom right of plot
#' @param restyle_legend Restylizing legend for state level plots
#' @param font_legend font styling
#' @param axis_title_size manual adjustment of axis title size in theming
#' @param axis_text_size manual adjustment of axis text sizing in theming
#' @param axis_title_bottom_size manual adjustment of axis title bottom sizing in theming
#' @param axis_title_top_size manual adjustment of axis title top sizing in theming
#' @param plot_title_size, manual adjustment of plot title size
plot_state_square <- function(state_plot_list, filter_states,
axis_title_size, axis_text_size, axis_title_bottom_size, axis_title_top_size, plot_title_size,
width, height, dpi, create_out_folder,
background_color, text_color, date_start, source_label, flow_label, restyle_legend ){

# pull out indiviudal state names and state cartograms to `purr::map` by
state_names <- pluck(filter_states, 1)
state_plot_list <- pluck(state_plot_list, 1)

# The background canvas for your viz
canvas <- grid::rectGrob(
x = 0, y = 0,
width = width, height = height,
gp = grid::gpar(fill = background_color, alpha = 1, col = background_color
)
)

plot_margin = 0.025

# pull out month and year
plot_month <- lubridate::month(date_start, label = TRUE, abbr = FALSE)
plot_year <- lubridate::year(date_start)

# streamflow label
title_flow <- magick::image_read('in/streamflow.png') |> magick::image_scale('800x')

# usgs logo
usgs_logo <- magick::image_read('in/usgs_logo.png') %>%
magick::image_colorize(100, text_color)

# compose final plot
state_plts_square <- ggdraw(ylim = c(0,1),
xlim = c(0,1)) +
# Background
draw_grob(canvas,
x = 0, y = 1,
height = 0.37, width = 0.37,
hjust = 0, vjust = 1) +
# Add main plot for each individual state
draw_plot(state_plot_list +
labs(x = "Day of month") + theme(legend.position = 'none',
text = element_text(family = font_legend, color = text_color)) +
theme(axis.text.y =
element_text(size = axis_text_size,
vjust = c(1, 0),
hjust = 1),
axis.title.x.bottom = element_text(size = axis_title_bottom_size,
vjust = -1,
margin = margin(t = 5)),
axis.title.x.top = element_text(size = axis_title_top_size,
vjust = 0,
margin = margin(b = -5)),
axis.text.x.bottom = element_text(size = axis_text_size,
vjust = 1,
# nudge labels up closer to bottom
margin = margin(t = -5)),
plot.margin = margin(50, 50, 50, 50, "pt"),
legend.position = 'none',
plot.title = element_text(size = plot_title_size, margin = margin(0, 0, -8, 0))
),
x = (1-plot_margin)*-0.03,
y = 0.01,
height = 1.05,
width = (1-plot_margin)*1.05) +
# Draw title
draw_label(sprintf('%s %s', plot_month, plot_year),
x = plot_margin*1.7, y = 1-plot_margin*1.2,
size = 20,
hjust = 0,
vjust = 1,
fontfamily = font_legend,
color = text_color,
lineheight = 1) +
# Stylized streamflow title
draw_image(title_flow,
x = plot_margin*1.8,
y = 1-plot_margin*-1.5,
height = 0.36,
width = 0.94,
hjust = 0,
vjust = 1) +
# Add legend
draw_plot(restyle_legend,
x = (1-plot_margin)*0.51,
y = 0.07,
height = 0.12 ,
width = 0.02-plot_margin) +
# percentile info
draw_label(flow_label,
x = (1-plot_margin)*0.205,
y = 0.22,
hjust = 0,
vjust = 1,
fontfamily = font_legend,
color = text_color,
size = 6) +
# add data source
draw_label(source_label,
x = 1-plot_margin*2, y = plot_margin,
fontface = "italic",
size = 5,
hjust = 1, vjust = 0,
fontfamily = font_legend,
color = text_color,
lineheight = 1.1) +
# add logo
draw_image(usgs_logo, x = plot_margin*2, y = plot_margin*1, width = 0.125, hjust = 0, vjust = 0, halign = 0, valign = 0)

outfolder_month_year_path <- paste0(create_out_folder,"_", plot_month, "_", plot_year)

out_folder <- dir.create(file.path(outfolder_month_year_path), showWarnings = FALSE)

filename <- paste0(outfolder_month_year_path, "/", state_names, "_", plot_month, "_", plot_year, "_Square", ".png")

# Save and convert file
ggsave(filename, width = width, height = height, dpi = dpi, units = c("px"))
return(filename)

}