inst/extdata/Templates/map_functions.R
In jacciz/wisdotcrashdatabase: A package used for internal WisDOT crash database pulls and analysis
# map_data = sf::read_sf("c:/temp_code/data/wi_counties.shp")
# label = get_map_labels(map_data)
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, color = "grey90", fill = "black") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = label,
# # color = "white",
# color = label$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = NAME
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = label$nudge_x,
# nudge_y = label$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# )
# County map labels - this changes the position for some counties
get_map_labels <- function(map_data) {
cent = sf::st_centroid(map_data)
# Code copied from https://github.com/slowkow/ggrepel/issues/89
county_sf <- sf::st_as_sf(cent) |>
mutate(
old_name = NAME,
CENTROID = map(geometry, sf::st_centroid),
COORDS = map(CENTROID, sf::st_coordinates),
COORDS_X = map_dbl(COORDS, 1),
COORDS_Y = map_dbl(COORDS, 2)
) |>
# as_tibble() |>
sf::st_as_sf()
x_range <- abs(Reduce("-", range(county_sf$COORDS_X)))
y_range <- abs(Reduce("-", range(county_sf$COORDS_Y)))
# Adjust a few county's label
# x_range adjusts left-right, y-range is up-down
county_sf <-
county_sf |> mutate(
nudge_x = case_when(
NAME %in% c("Pepin", "Trempealeau") ~ -0.08 * x_range,
NAME %in% c("Marinette", "Ashland") ~ -0.01 * x_range,
NAME %in% c("Crawford", "Oconto") ~ 0.01 * x_range,
NAME %in% c("Milwaukee", "Ozaukee", "Kewaunee", "Door", "Kenosha") ~ 0.080 * x_range,
TRUE ~ 0
),
nudge_y = case_when(
NAME %in% c("Pepin") ~ -0.03 * y_range,
NAME %in% c("Trempealeau") ~ -0.09 * y_range,
NAME %in% c("Marquette") ~ 0.01 * y_range,
NAME %in% c("Juneau") ~ -1 * 0.01 * x_range,
NAME %in% c("Shawano", "Florence", "Menominee", "Iron") ~ 0.01 * y_range,
TRUE ~ 0
),
NAME = replace(NAME, NAME == "Green Lake", "Green \n Lake")
)
adjusted_counties <-
c("Pepin",
"Trempealeau",
"Milwaukee",
"Ozaukee",
"Kewaunee",
"Door",
"Kenosha")
county_sf |>
mutate(text_color = ifelse(old_name %in% adjusted_counties, "grey10", "grey90"))
}
# ggplot_data <- function(map_data, plot_title){
# cent = get_map_labels(map_data) # adds 2 columns to adjust map labels
#
# # white labels on map, ifelse doesn't work??
# cent = cent |> mutate(plot_label = case_when(plot_title == "Speeding" ~ paste0(round(N/1000, 1), "k"),
# plot_title == "Distracted driving" ~ paste0(round(N, -1)),
# plot_title != "Speeding" ~ paste0(round(N, -2))))
#
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, aes(fill = -cit_rate), color = "grey90") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = cent,
# # color = "white",
# color = cent$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = plot_label
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = cent$nudge_x,
# nudge_y = cent$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# ) +
# scale_fill_continuous(name = "Citation rate\nper 1k population") +
# labs(title = paste(plot_title, "violations issued by DSP (2019-2021)"))
# }
#
# ggplot_data_crashes <- function(map_data, plot_title){
# cent = get_map_labels(map_data)
#
# # white labels on map, ifelse doesn't work??
# cent = cent |> mutate(plot_label = case_when(plot_title != "Speeding" ~ paste0(round(N/1000, 1), "k"),
# plot_title == "Distracted driving" ~ paste0(round(N, -1))
# # plot_title != "Speeding" ~ paste0(round(N, -2))))
# ))
#
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, aes(fill = -cit_rate), color = "grey90") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = cent,
# # color = "white",
# color = cent$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = N
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = cent$nudge_x,
# nudge_y = cent$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# ) +
# scale_fill_continuous(name = "Crash rate\nper 1k lane miles") +
# labs(title = paste("Total fatal/serious injury crashes on", plot_title," (2019-2021)"))
# }
dot_county_map <- function(p, df, max_count, size_col = "Total", legend_title, facet_by = "year") {
p +
# base_map() +
geom_point(
data = df,
color = "white",
fill = "#B67467",
pch = 21,
# must be >20 to get outline
aes(geometry = geometry,
size = .data[[size_col]]),
stat = "sf_coordinates"
) +
scale_colour_discrete(guide = "none") + # remove color legend
scale_size_continuous(limits = c(0, max_count), name = legend_title) + # range of values
# scale_size(range = c(0, 20)) +
facet_wrap( ~.data[[facet_by]]) + guides(size=guide_legend(ncol = 1))
}
# p is base map
choropleth_county_map <-
function(p,
df,
max_count,
fill_col = "N",
legend_title,
facet_by = "year") {
p + geom_sf(
data = df,
aes(fill = .data[[fill_col]]),
color = "white",
linewidth = 1
) + scale_fill_continuous(
limits = c(0, max_count),
high = "#034663",
low = "#afdaed",
na.value = "grey90",
name = legend_title
) + facet_wrap( ~ .data[[facet_by]])
}
pie_county_map <- function(p,
df,
max_count,
pie_radius = 200,
pie_col = "total",
# legend_title,
facet_by = "year") {
state_colors_two <- c("WI" = green, "Outside WI" = light_blue)
p +
geom_scatterpie(
data = df,
aes(lat, lon, r = .data[[pie_col]] * pie_radius),
# size of circles MUST MATCH LEGEND
# cols = c("WI", "MN", "IL", "Other"),
cols = c("WI", "Outside WI"),
alpha = .8,
color = NA
) + # outline color
geom_scatterpie_legend(
radius = df[[pie_col]] * pie_radius,
x = 321637,
y = 310637,
n = 4,
labeller = function(x)
format(round(x / pie_radius), big.mark = ",")
) + # labeller must be
scale_fill_manual(
# for pie
name = "",
values = state_colors_two,
labels = c(
sprintf("WI (%s)", ppl_per_state[state == "WI", count]),
# sprintf("MN (%s)", ppl_per_state[ state == "MN", count]),
# sprintf("IL (%s)", ppl_per_state[ state == "IL", count]),
sprintf("Outside WI (%s)", ppl_per_state[state == "Outside WI", count])
)#c("WI", "MN", "IL", "Other")
) +
facet_wrap( ~ .data[[facet_by]])
}
base_map <- function(title, title_font_size = 16){
ggplot() + geom_sf(
data = wi_counties$geometry,
fill = "#F4F5F3",
color = "grey80"
) +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.direction = "vertical",
legend.position = "right"
) + labs(title = glue::glue("<span style='font-size:{title_font_size}pt'>{title}</span>"))
}
make_dot_map <- function(df_count, include_label = TRUE, legend_name) {
# Combine with census
wi_df_count <-
left_join(wi_counties, df_count, by = c("NAME" = "countyname")) |> mutate(N = tidyr::replace_na(N, 0))
wi_df_count_centroids <- sf::st_centroid(wi_df_count)
wi_df_count_centroids = get_map_labels(wi_df_count_centroids) # adds 2 columns to adjust map labels
map =
wi_df_count |>
# dots
ggplot() +
geom_sf(
fill = "grey85",
color = "white",
linewidth = 1
) +
theme_classic() +
geom_point(
data = wi_df_count_centroids,
color = "#B67467",
fill = "#B67467",
pch = 21,
# must be >20 to get outline
aes(geometry = geometry,
size = N),
stat = "sf_coordinates"
) + scale_size(range = c(0, 16)) + # range of circle size
labs(size = legend_name) +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
# legend.direction = "horizontal",
legend.position = "right",
legend.title=element_text(size= map_text_size),
legend.text = element_text(size = map_text_size)
) + guides(size=guide_legend(ncol = 1)) # legend circles on 1 row
if(include_label == TRUE){
map = map + ggrepel::geom_text_repel(
data = wi_df_count_centroids,
color = "grey40",
mapping = aes(
x = COORDS_X,
y = COORDS_Y,
label = paste0(stringr::str_to_upper(stringr::str_sub(NAME, 1, 3)), ": ", N)
# label = paste0(NAME, ": ", N)
),
nudge_x = wi_df_count_centroids$nudge_x,
nudge_y = wi_df_count_centroids$nudge_y + 8000, # remove 8000 ?
size = map_label_size,
min.segment.length = 1,
box.padding = -.5,
point.padding = NA,
segment.color = "grey50"
)
}
map
}
make_chloropleth_map <- function(df_count, fill_value, legend_name) {
# Combine with census
# wi_df_count <-
# left_join(wi_counties, df_count, by = c("NAME" = "countyname")) |> mutate(N = replace_na(N, 0))
# wi_df_count_centroids <- sf::st_centroid(wi_df_count)
wi_point_labels = get_map_labels(df_count) # adds 2 columns to adjust map labels
df_count |>
ggplot() + #geom_sf(fill = "grey80") +
theme_classic() +
geom_sf(aes(fill = !!sym(fill_value)),
color = "white",
linewidth = 1) +
scale_fill_gradient(high = "#c81f49",
low = "#ffe8ee",
na.value = "grey90", name = legend_name) +
# breaks = scales::pretty_breaks(n = 4)) +
# scale_colour_discrete(guide = "none") +
ggrepel::geom_text_repel(
data = wi_point_labels,
color = "grey30",
mapping = aes(
x = COORDS_X,
y = COORDS_Y,
label = paste0(stringr::str_to_upper(stringr::str_sub(NAME, 1, 3)), ": ", scales::comma(!!sym(fill_value), 1))
# label = paste0(NAME, ": ", N)
),
nudge_x = wi_point_labels$nudge_x,
nudge_y = wi_point_labels$nudge_y, # + 8000
size = map_label_size,
min.segment.length = 1,
box.padding = -.5,
point.padding = NA,
segment.color = "grey50"
) +
# labs(color = legend_name, label = "zx", size ="s") +
theme(
legend.key.width= unit(2, 'cm'), # Make legend wider
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
# legend.direction = "horizontal",
legend.position = "bottom",
legend.title=element_text(size= map_text_size),
legend.text = element_text(size = map_text_size)
)
}
# to save a ggplot
# + ggsave(
# width = 6,
# height = 6,
# dpi = 300,
# units = "in",
# filename = paste0("charts/", filename, ".png")
# )
jacciz/wisdotcrashdatabase documentation built on June 3, 2023, 2:26 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# map_data = sf::read_sf("c:/temp_code/data/wi_counties.shp")
# label = get_map_labels(map_data)
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, color = "grey90", fill = "black") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = label,
# # color = "white",
# color = label$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = NAME
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = label$nudge_x,
# nudge_y = label$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# )
# County map labels - this changes the position for some counties
get_map_labels <- function(map_data) {
cent = sf::st_centroid(map_data)
# Code copied from https://github.com/slowkow/ggrepel/issues/89
county_sf <- sf::st_as_sf(cent) |>
mutate(
old_name = NAME,
CENTROID = map(geometry, sf::st_centroid),
COORDS = map(CENTROID, sf::st_coordinates),
COORDS_X = map_dbl(COORDS, 1),
COORDS_Y = map_dbl(COORDS, 2)
) |>
# as_tibble() |>
sf::st_as_sf()
x_range <- abs(Reduce("-", range(county_sf$COORDS_X)))
y_range <- abs(Reduce("-", range(county_sf$COORDS_Y)))
# Adjust a few county's label
# x_range adjusts left-right, y-range is up-down
county_sf <-
county_sf |> mutate(
nudge_x = case_when(
NAME %in% c("Pepin", "Trempealeau") ~ -0.08 * x_range,
NAME %in% c("Marinette", "Ashland") ~ -0.01 * x_range,
NAME %in% c("Crawford", "Oconto") ~ 0.01 * x_range,
NAME %in% c("Milwaukee", "Ozaukee", "Kewaunee", "Door", "Kenosha") ~ 0.080 * x_range,
TRUE ~ 0
),
nudge_y = case_when(
NAME %in% c("Pepin") ~ -0.03 * y_range,
NAME %in% c("Trempealeau") ~ -0.09 * y_range,
NAME %in% c("Marquette") ~ 0.01 * y_range,
NAME %in% c("Juneau") ~ -1 * 0.01 * x_range,
NAME %in% c("Shawano", "Florence", "Menominee", "Iron") ~ 0.01 * y_range,
TRUE ~ 0
),
NAME = replace(NAME, NAME == "Green Lake", "Green \n Lake")
)
adjusted_counties <-
c("Pepin",
"Trempealeau",
"Milwaukee",
"Ozaukee",
"Kewaunee",
"Door",
"Kenosha")
county_sf |>
mutate(text_color = ifelse(old_name %in% adjusted_counties, "grey10", "grey90"))
}
# ggplot_data <- function(map_data, plot_title){
# cent = get_map_labels(map_data) # adds 2 columns to adjust map labels
#
# # white labels on map, ifelse doesn't work??
# cent = cent |> mutate(plot_label = case_when(plot_title == "Speeding" ~ paste0(round(N/1000, 1), "k"),
# plot_title == "Distracted driving" ~ paste0(round(N, -1)),
# plot_title != "Speeding" ~ paste0(round(N, -2))))
#
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, aes(fill = -cit_rate), color = "grey90") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = cent,
# # color = "white",
# color = cent$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = plot_label
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = cent$nudge_x,
# nudge_y = cent$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# ) +
# scale_fill_continuous(name = "Citation rate\nper 1k population") +
# labs(title = paste(plot_title, "violations issued by DSP (2019-2021)"))
# }
#
# ggplot_data_crashes <- function(map_data, plot_title){
# cent = get_map_labels(map_data)
#
# # white labels on map, ifelse doesn't work??
# cent = cent |> mutate(plot_label = case_when(plot_title != "Speeding" ~ paste0(round(N/1000, 1), "k"),
# plot_title == "Distracted driving" ~ paste0(round(N, -1))
# # plot_title != "Speeding" ~ paste0(round(N, -2))))
# ))
#
# ggplot() +
# # geom_sf(data = wi_counties$geometry, fill = "grey80") +
# theme_void() +
# geom_sf(data = map_data, aes(fill = -cit_rate), color = "grey90") +
# theme(legend.position = c(.14, .2),
# legend.key.height = unit(.4, 'cm')
# # plot.margin=unit(c(0,0,0,-.3), "null"),
# # plot.background = element_rect(fill = '#e5e5e5', color = "#e5e5e5"),
# # plot.margin = margin(t = 0, r = -.3, b = 0, l = 0, unit = "cm"),
# ) +
# geom_sf_text(
# data = cent,
# # color = "white",
# color = cent$text_color,
# mapping = aes(
# x = COORDS_X,
# y = COORDS_Y,
# label = N
# # label = paste0(round(N/1000, 1), "k")
# # label = paste0(NAME, "\n", round(inj_dt_))
# ),
# nudge_x = cent$nudge_x,
# nudge_y = cent$nudge_y,
# size = 3,
# min.segment.length = 0,
# box.padding = -.5,
# point.padding = NA,
# segment.color = "grey20"
# ) +
# scale_fill_continuous(name = "Crash rate\nper 1k lane miles") +
# labs(title = paste("Total fatal/serious injury crashes on", plot_title," (2019-2021)"))
# }
dot_county_map <- function(p, df, max_count, size_col = "Total", legend_title, facet_by = "year") {
p +
# base_map() +
geom_point(
data = df,
color = "white",
fill = "#B67467",
pch = 21,
# must be >20 to get outline
aes(geometry = geometry,
size = .data[[size_col]]),
stat = "sf_coordinates"
) +
scale_colour_discrete(guide = "none") + # remove color legend
scale_size_continuous(limits = c(0, max_count), name = legend_title) + # range of values
# scale_size(range = c(0, 20)) +
facet_wrap( ~.data[[facet_by]]) + guides(size=guide_legend(ncol = 1))
}
# p is base map
choropleth_county_map <-
function(p,
df,
max_count,
fill_col = "N",
legend_title,
facet_by = "year") {
p + geom_sf(
data = df,
aes(fill = .data[[fill_col]]),
color = "white",
linewidth = 1
) + scale_fill_continuous(
limits = c(0, max_count),
high = "#034663",
low = "#afdaed",
na.value = "grey90",
name = legend_title
) + facet_wrap( ~ .data[[facet_by]])
}
pie_county_map <- function(p,
df,
max_count,
pie_radius = 200,
pie_col = "total",
# legend_title,
facet_by = "year") {
state_colors_two <- c("WI" = green, "Outside WI" = light_blue)
p +
geom_scatterpie(
data = df,
aes(lat, lon, r = .data[[pie_col]] * pie_radius),
# size of circles MUST MATCH LEGEND
# cols = c("WI", "MN", "IL", "Other"),
cols = c("WI", "Outside WI"),
alpha = .8,
color = NA
) + # outline color
geom_scatterpie_legend(
radius = df[[pie_col]] * pie_radius,
x = 321637,
y = 310637,
n = 4,
labeller = function(x)
format(round(x / pie_radius), big.mark = ",")
) + # labeller must be
scale_fill_manual(
# for pie
name = "",
values = state_colors_two,
labels = c(
sprintf("WI (%s)", ppl_per_state[state == "WI", count]),
# sprintf("MN (%s)", ppl_per_state[ state == "MN", count]),
# sprintf("IL (%s)", ppl_per_state[ state == "IL", count]),
sprintf("Outside WI (%s)", ppl_per_state[state == "Outside WI", count])
)#c("WI", "MN", "IL", "Other")
) +
facet_wrap( ~ .data[[facet_by]])
}
base_map <- function(title, title_font_size = 16){
ggplot() + geom_sf(
data = wi_counties$geometry,
fill = "#F4F5F3",
color = "grey80"
) +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.direction = "vertical",
legend.position = "right"
) + labs(title = glue::glue("<span style='font-size:{title_font_size}pt'>{title}</span>"))
}
make_dot_map <- function(df_count, include_label = TRUE, legend_name) {
# Combine with census
wi_df_count <-
left_join(wi_counties, df_count, by = c("NAME" = "countyname")) |> mutate(N = tidyr::replace_na(N, 0))
wi_df_count_centroids <- sf::st_centroid(wi_df_count)
wi_df_count_centroids = get_map_labels(wi_df_count_centroids) # adds 2 columns to adjust map labels
map =
wi_df_count |>
# dots
ggplot() +
geom_sf(
fill = "grey85",
color = "white",
linewidth = 1
) +
theme_classic() +
geom_point(
data = wi_df_count_centroids,
color = "#B67467",
fill = "#B67467",
pch = 21,
# must be >20 to get outline
aes(geometry = geometry,
size = N),
stat = "sf_coordinates"
) + scale_size(range = c(0, 16)) + # range of circle size
labs(size = legend_name) +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
# legend.direction = "horizontal",
legend.position = "right",
legend.title=element_text(size= map_text_size),
legend.text = element_text(size = map_text_size)
) + guides(size=guide_legend(ncol = 1)) # legend circles on 1 row
if(include_label == TRUE){
map = map + ggrepel::geom_text_repel(
data = wi_df_count_centroids,
color = "grey40",
mapping = aes(
x = COORDS_X,
y = COORDS_Y,
label = paste0(stringr::str_to_upper(stringr::str_sub(NAME, 1, 3)), ": ", N)
# label = paste0(NAME, ": ", N)
),
nudge_x = wi_df_count_centroids$nudge_x,
nudge_y = wi_df_count_centroids$nudge_y + 8000, # remove 8000 ?
size = map_label_size,
min.segment.length = 1,
box.padding = -.5,
point.padding = NA,
segment.color = "grey50"
)
}
map
}
make_chloropleth_map <- function(df_count, fill_value, legend_name) {
# Combine with census
# wi_df_count <-
# left_join(wi_counties, df_count, by = c("NAME" = "countyname")) |> mutate(N = replace_na(N, 0))
# wi_df_count_centroids <- sf::st_centroid(wi_df_count)
wi_point_labels = get_map_labels(df_count) # adds 2 columns to adjust map labels
df_count |>
ggplot() + #geom_sf(fill = "grey80") +
theme_classic() +
geom_sf(aes(fill = !!sym(fill_value)),
color = "white",
linewidth = 1) +
scale_fill_gradient(high = "#c81f49",
low = "#ffe8ee",
na.value = "grey90", name = legend_name) +
# breaks = scales::pretty_breaks(n = 4)) +
# scale_colour_discrete(guide = "none") +
ggrepel::geom_text_repel(
data = wi_point_labels,
color = "grey30",
mapping = aes(
x = COORDS_X,
y = COORDS_Y,
label = paste0(stringr::str_to_upper(stringr::str_sub(NAME, 1, 3)), ": ", scales::comma(!!sym(fill_value), 1))
# label = paste0(NAME, ": ", N)
),
nudge_x = wi_point_labels$nudge_x,
nudge_y = wi_point_labels$nudge_y, # + 8000
size = map_label_size,
min.segment.length = 1,
box.padding = -.5,
point.padding = NA,
segment.color = "grey50"
) +
# labs(color = legend_name, label = "zx", size ="s") +
theme(
legend.key.width= unit(2, 'cm'), # Make legend wider
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
# legend.direction = "horizontal",
legend.position = "bottom",
legend.title=element_text(size= map_text_size),
legend.text = element_text(size = map_text_size)
)
}
# to save a ggplot
# + ggsave(
# width = 6,
# height = 6,
# dpi = 300,
# units = "in",
# filename = paste0("charts/", filename, ".png")
# )
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.