#| label: Revised econ_tilegrid()
econ_tilegrid <- function(
data = df,
data_source = "Data source",
plot_title = "Plot Title",
state_column = "state_column_name",
numeric_column = n,
plot_panel_color = "#ffffff",
palette = c("#FCC8B4", "#FAAA90", "#F58469", "#EF1B26"), # Ascending Order
breaks = c(1, 2, 6, 11), # Ascending Order
zero_color = NULL,
na_color = NULL
) {
## 01 Ensure Palette Length and Breaks Are Same Length ----
pal <- palette
pal_length <- length(pal)
breaks_length <- length(breaks)
if (pal_length != breaks_length) {
stop("The palette and break lengths must be the same.")
}
if (pal_length > 5) {
stop("The maximum number of bins and colors is 5.")
}
## 02 Build Economist's 8 x 11 Rectangular Tile Grid ----
grid_df <-
tibble::tribble(
~State, ~x, ~y,
"AL", 7, 7,
"AK", 1, 1,
"AZ", 2, 6,
"AR", 5, 6,
"CA", 1, 5,
"CO", 3, 5,
"CT", 10, 4,
"DC", 9, 6,
"DE", 10, 5,
"FL", 9, 8,
"GA", 8, 7,
"HI", 1, 8,
"ID", 2, 3,
"IL", 6, 3,
"IN", 6, 4,
"IA", 5, 4,
"KS", 4, 6,
"KY", 6, 5,
"LA", 5, 7,
"ME", 11, 1,
"MD", 9, 5,
"MA", 10, 3,
"MI", 7, 3,
"MN", 5, 3,
"MS", 6, 7,
"MO", 5, 5,
"MT", 3, 3,
"NE", 4, 5,
"NV", 2, 4,
"NH", 11, 2,
"NJ", 9, 4,
"NM", 3, 6,
"NY", 9, 3,
"NC", 7, 6,
"ND", 4, 3,
"OH", 7, 4,
"OK", 4, 7,
"OR", 1, 4,
"PA", 8, 4,
"RI", 11, 4,
"SC", 8, 6,
"SD", 4, 4,
"TN", 6, 6,
"TX", 4, 8,
"UT", 2, 5,
"VT", 10, 2,
"VA", 8, 5,
"WA", 1, 3,
"WV", 7, 5,
"WI", 6, 2,
"WY", 3, 4
) |>
dplyr::mutate(
y = dplyr::case_when(
y == 1 ~ 12,
y == 2 ~ 11,
y == 3 ~ 10,
y == 4 ~ 9,
y == 5 ~ 8,
y == 6 ~ 7,
y == 7 ~ 6,
y == 8 ~ 5,
y == 9 ~ 4,
y == 10 ~ 3,
y == 11 ~ 2,
y == 12 ~ 1
)
)
## 03 Build Tile Grid Choropleth ----
## 03.01 If NA ----
if(is.null(zero_color) & !is.null(na_color)) {
choropleth <-
grid_df |>
dplyr::left_join(
data,
by = c("State" = {{ state_column }})
) |>
dplyr::mutate(
fill_color = dplyr::case_when(
is.na({{ numeric_column }}) ~ na_color,
dplyr::between({{ numeric_column }}, 0, breaks[1]) ~ pal[1], # This needs to be rewritten flexible for up to 5 (non-0, non-NA) bins
dplyr::between({{ numeric_column }}, breaks[1], breaks[2]) ~ pal[2],
dplyr::between({{ numeric_column }}, breaks[2], breaks[3]) ~ pal[3],
dplyr::between({{ numeric_column }}, breaks[3], breaks[4]) ~ pal[4]
)
) |>
dplyr::mutate(
text_color = dplyr::if_else(
fill_color == pal[4],
"#ffffff",
"#000000"
)
) |>
ggplot2::ggplot(
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
ggplot2::aes(
fill = fill_color
),
color = "#000",
linewidth = 0.2
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void() +
ggplot2::coord_equal() +
ggplot2::geom_text(
ggplot2::aes(
label = State,
color = text_color
),
family = "Gotham",
size = 3.4
) +
ggplot2::scale_color_identity() +
ggplot2::labs(
caption = str_glue("Source: {data_source}")
) +
ggplot2::theme(
plot.caption = element_text(
hjust = 0.06,
family = "Gotham",
color = "#5c5c5c"
),
plot.caption.position = "plot",
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
} else if(!is.null(zero_color) & is.null(na_color)) {
## 03.02 If 0 ----
choropleth <-
grid_df |>
dplyr::left_join(
data,
by = c("State" = {{ state_column }})
) |>
dplyr::mutate(
fill_color = dplyr::case_when(
{{ numeric_column }} == 0 ~ zero_color,
dplyr::between({{ numeric_column }}, 0.01, breaks[1]) ~ pal[1], # This needs to be rewritten flexible for up to 5 (non-0, non-NA) bins
dplyr::between({{ numeric_column }}, breaks[1], breaks[2]) ~ pal[2],
dplyr::between({{ numeric_column }}, breaks[2], breaks[3]) ~ pal[3],
dplyr::between({{ numeric_column }}, breaks[3], breaks[4]) ~ pal[4]
)
) |>
dplyr::mutate(
text_color = dplyr::if_else(
fill_color == pal[4],
"#ffffff",
"#000000"
)
) |>
ggplot2::ggplot(
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
ggplot2::aes(
fill = fill_color
),
color = "#000",
linewidth = 0.2
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void() +
ggplot2::coord_equal() +
ggplot2::geom_text(
ggplot2::aes(
label = State,
color = text_color
),
family = "Gotham",
size = 3.4
) +
ggplot2::scale_color_identity() +
ggplot2::labs(
caption = str_glue("Source: {data_source}")
) +
ggplot2::theme(
plot.caption = element_text(
hjust = 0.06,
family = "Gotham",
color = "#5c5c5c"
),
plot.caption.position = "plot",
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
} else if(is.null(na_color) & is.null(zero_color)){
## 03.03 If Neither NA nor 0
choropleth <-
grid_df |>
dplyr::left_join(
data,
by = c("State" = {{ state_column }})
) |>
dplyr::mutate(
fill_color = dplyr::case_when(
dplyr::between({{ numeric_column }}, 0, breaks[1]) ~ pal[1], # This needs to be rewritten flexible for up to 5 (non-0, non-NA) bins
dplyr::between({{ numeric_column }}, breaks[1], breaks[2]) ~ pal[2],
dplyr::between({{ numeric_column }}, breaks[2], breaks[3]) ~ pal[3],
dplyr::between({{ numeric_column }}, breaks[3], breaks[4]) ~ pal[4]
)
) |>
dplyr::mutate(
text_color = dplyr::if_else(
fill_color == pal[4],
"#ffffff",
"#000000"
)
) |>
ggplot2::ggplot(
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
ggplot2::aes(
fill = fill_color
),
color = "#000",
linewidth = 0.2
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void() +
ggplot2::coord_equal() +
ggplot2::geom_text(
ggplot2::aes(
label = State,
color = text_color
),
family = "Gotham",
size = 3.4
) +
ggplot2::scale_color_identity() +
ggplot2::labs(
caption = str_glue("Source: {data_source}")
) +
ggplot2::theme(
plot.caption = element_text(
hjust = 0.06,
family = "Gotham",
color = "#5c5c5c"
),
plot.caption.position = "plot",
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
}
## 04 Build guide_legend() Scales ----
scale_df <-
tibble::tibble(
x = seq(10, 40, 10),
y = rep(0.1, 4),
fill_color = pal
)
top_legend <-
ggplot2::ggplot(
scale_df,
aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
color = "#000000",
ggplot2::aes(
fill = fill_color
),
linewidth = 0.4
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void(
base_family = "Gotham"
) +
ggplot2::scale_x_continuous(
breaks = seq(
15,
45,
10
),
labels = breaks |>
as.character()
) +
ggplot2::theme(
axis.text.x.bottom = element_text(
vjust = 0.5,
size = 10
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
## 05 Determine if Zero or NA Color Guide Needed Assemble Final Plot
if(is.null(zero_color) & !is.null(na_color)) {
zero_na_df <-
tibble::tibble(
x = 1,
y = 0.1,
fill_color = na_color
)
zero_na_legend <-
ggplot2::ggplot(
zero_na_df,
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
color = "#000000",
ggplot2::aes(
fill = fill_color
),
linewidth = 0.4
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void(
base_family = "Gotham"
) +
ggplot2::scale_x_continuous(
breaks = 1,
labels = "NA"
) +
ggplot2::theme(
axis.text.x.bottom = element_text(
vjust = 0.5,
size = 10
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
) +
ggplot2::coord_fixed(ratio = 1)
} else if(!is.null(zero_color) & is.null(na_color)) {
zero_na_df <-
tibble::tibble(
x = 1,
y = 0.1,
fill_color = zero_color
)
zero_na_legend <-
ggplot2::ggplot(
zero_na_df,
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
color = "#000000",
ggplot2::aes(
fill = fill_color
),
linewidth = 0.4
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void(
base_family = "Gotham"
) +
ggplot2::scale_x_continuous(
breaks = 1,
labels = "0"
) +
ggplot2::theme(
axis.text.x.bottom = element_text(
vjust = 0.5,
size = 10
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
) +
ggplot2::coord_fixed(ratio = 1)
}
zero_na_df <-
tibble::tibble(
x = 1,
y = 0.1,
fill_color = na_color
)
zero_na_legend <-
ggplot2::ggplot(
zero_na_df,
ggplot2::aes(
x = x,
y = y
)
) +
ggplot2::geom_tile(
color = "#000000",
ggplot2::aes(
fill = fill_color
),
linewidth = 0.4
) +
ggplot2::scale_fill_identity() +
ggplot2::theme_void(
base_family = "Gotham"
) +
ggplot2::scale_x_continuous(
breaks = 1,
labels = "NA"
) +
ggplot2::theme(
axis.text.x.bottom = element_text(
vjust = 0.5,
size = 10
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
) +
ggplot2::coord_fixed(ratio = 1)
## 05 Assemble Plot
## 05.01 No Zero Color or NA Color
if (is.null(zero_color) & is.null(na_color)) {
(
(
patchwork::plot_spacer() +
ggplot2::theme(
plot.margin = unit(c(0, 0, 0, 30), "pt")
) +
top_legend +
patchwork::plot_spacer()
) +
patchwork::plot_layout(widths = c(2, 5, 2), nrow = 1)
) /
choropleth +
patchwork::plot_layout(
heights = c(0.05, 1)
) +
patchwork::plot_annotation(
title = plot_title
) &
ggplot2::theme(
plot.title = ggtext::element_textbox_simple(
size = 11,
family = "Gotham",
hjust = 0.25,
margin = margin(0, 0, 5, 0, unit = "pt")
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
} else {
## 05.02 Add Zero or NA Color Legend
(
(
patchwork::plot_spacer() +
zero_na_legend +
ggplot2::theme(
plot.margin = unit(c(0, 0, 0, 30), "pt")
) +
top_legend +
patchwork::plot_spacer()
) +
patchwork::plot_layout(widths = c(0.3, 1, 5, 1.4), nrow = 1)
) /
choropleth +
patchwork::plot_layout(
heights = c(0.05, 1)
) +
patchwork::plot_annotation(
title = plot_title
) &
ggplot2::theme(
plot.title = ggtext::element_textbox_simple(
size = 11,
family = "Gotham",
hjust = 0.25,
margin = margin(0, 0, 5, 0, unit = "pt")
),
plot.background = element_rect(
color = plot_panel_color,
fill = plot_panel_color
),
panel.background = element_rect(
fill = plot_panel_color,
color = plot_panel_color
)
)
}
}
