When place names are positional aesthetics
Evangeline Reynolds
2024-06-18
US map
library(tidyverse)
usmapdata::us_map("states") %>%
ggplot() +
aes(geometry = geom) +
geom_sf() -> p; p
p$coordinates$crs## NULLusmapdata::us_map("states")## Simple feature collection with 51 features and 3 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -2590847 ymin: -2608148 xmax: 2523581 ymax: 731407.9
## Projected CRS: NAD27 / US National Atlas Equal Area
## # A tibble: 51 × 4
## fips abbr full geom
## <chr> <chr> <chr> <MULTIPOLYGON [m]>
## 1 02 AK Alaska (((-2396847 -2547721, -2393297 -2546391, -2…
## 2 01 AL Alabama (((1093777 -1378535, 1093269 -1374223, 1092…
## 3 05 AR Arkansas (((483065.2 -927788.2, 506062 -926263.3, 53…
## 4 04 AZ Arizona (((-1388676 -1254584, -1389181 -1251856, -1…
## 5 06 CA California (((-1719946 -1090033, -1709611 -1090026, -1…
## 6 08 CO Colorado (((-789538.7 -678773.8, -789538.2 -678769.5…
## 7 09 CT Connecticut (((2161733 -83737.52, 2177182 -65221.22, 21…
## 8 11 DC District of Columbia (((1955479 -402055.2, 1960234 -393571.9, 19…
## 9 10 DE Delaware (((2042506 -284367.3, 2043078 -280000.3, 20…
## 10 12 FL Florida (((1855611 -2064809, 1860157 -2054372, 1867…
## # ℹ 41 more rowsprep reference data
usmapdata::us_map("states") %>%
rename(state_name = full) %>%
rename(state_abbr = abbr) %>%
rename(geometry = geom) %>%
sf2stat:::sf_df_prep_for_stat(id_col_name = "state_name") ->
usmaprefdata## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## ℹ The deprecated feature was likely used in the sf2stat package.
## Please report the issue to the authors.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.quick prep stat_states demo w/ statexpress
stat_states <- function(...){
statexpress:::stat_panel_sf(usmaprefdata, crs = NULL,
default_aes = aes(label = after_stat(state_name)), ...)}
geom_states <- stat_states
geom_states_text <- function(geom = "text", ...){
stat_states(geom = geom, ...)
}demo UI
state.name %>%
data.frame(state = .) %>%
mutate(is_aeiou = state %>% str_detect("^[AEIOU]")) ->
vowel_start_states_df
vowel_start_states_df %>% head()## state is_aeiou
## 1 Alabama TRUE
## 2 Alaska TRUE
## 3 Arizona TRUE
## 4 Arkansas TRUE
## 5 California FALSE
## 6 Colorado FALSEvowel_start_states_df |>
ggplot() +
aes(state_name = state) +
geom_states() +
aes(fill = is_aeiou)## Joining with `by = join_by(state_name)`
data.frame(state.abb, state.region) %>%
ggplot() +
aes(state_abbr = state.abb) +
stat_states() +
aes(fill = state.region) +
scale_fill_viridis_d() +
stat_states(keep_id = "Iowa", color = "red", linewidth = 1) +
geom_states_text(keep_id = "Iowa", angle = 8)## Joining with `by = join_by(state_abbr)`
## Joining with `by = join_by(state_abbr)`
## Joining with `by = join_by(state_abbr)`
Brain map
prepare reference data
ggseg::aseg %>%
data.frame() %>%
rename(region_id = label) %>%
remove_missing() %>%
sf2stat:::sf_df_prep_for_stat(id_col_name = "region_id") ->
reference_aseg## Warning: Removed 3 rows containing missing values or values outside the scale
## range.prepare demo layer functions
stat_aseg <- function(...){
statexpress:::stat_panel_sf(reference_aseg,
default_aes = aes(label = after_stat(region_id)), crs = NULL, ...)}
geom_aseg <- stat_aseg
geom_aseg_text <- function(geom = "text", ...){
stat_aseg(...)
}Use… Not really clear when you might use framework with external data.
reference_aseg %>%
sf::st_drop_geometry() %>%
ggplot() +
aes(region_id = region_id) +
stat_aseg() +
stat_aseg(geom = "text",
check_overlap = T)## Joining with `by = join_by(region_id)`
## Joining with `by = join_by(region_id)`
reference_aseg %>%
sf::st_drop_geometry() %>%
ggplot() +
aes(region_id = region_id) +
stat_aseg() +
stat_aseg(geom = "text",
check_overlap = T,
size = 2) +
aes(fill = hemi) +
ggstamp::stamp_wash() +
stat_aseg(keep_id = "Right-Amygdala", fill = "darkred")## Warning in annotate(geom = "rect", xmin = xmin, ymin = ymin, xmax = xmax, :
## Ignoring unknown aesthetics: x and y## Joining with `by = join_by(region_id)`
## Joining with `by = join_by(region_id)`
## Joining with `by = join_by(region_id)`
Body map - not really fitting the mold - just trying to figure out the structure of the data.
library(tidyverse)
library(gganatogram)## Loading required package: ggpolypatha <- gganatogram(data=hgFemale_key, outline = T, fillOutline='#a6bddb', organism='human', sex='female', fill="colour")
hgFemale_list[[156]]## X1 X2 id x y group
## 1 NA NA submandibular_gland NA NA 156_2
## 2 85.39803 99.96623 submandibular_gland 56.76116 21.77207 156_2
## 3 84.75740 100.09123 submandibular_gland 56.12053 21.89707 156_2
## 4 84.75740 100.09123 submandibular_gland 56.12053 21.89707 156_2
## 5 84.00740 100.23185 submandibular_gland 55.37053 22.03769 156_2
## 6 83.86678 100.80998 submandibular_gland 55.22991 22.61582 156_2
## 7 83.86678 100.80998 submandibular_gland 55.22991 22.61582 156_2
## 8 83.86678 101.05998 submandibular_gland 55.22991 22.86582 156_2
## 9 84.11678 101.12248 submandibular_gland 55.47991 22.92832 156_2
## 10 84.11678 101.12248 submandibular_gland 55.47991 22.92832 156_2
## 11 85.22615 101.24748 submandibular_gland 56.58928 23.05332 156_2
## 12 85.81990 100.73186 submandibular_gland 57.18303 22.53770 156_2
## 13 85.81990 100.73186 submandibular_gland 57.18303 22.53770 156_2
## 14 86.00740 100.51311 submandibular_gland 57.37053 22.31895 156_2
## 15 86.00740 100.26310 submandibular_gland 57.37053 22.06894 156_2
## 16 86.00740 100.26310 submandibular_gland 57.37053 22.06894 156_2# str(hgFemale_list)
hgFemale_df <- data.frame()
for (i in c(1:length(hgFemale_list))){
hgFemale_df <- bind_rows(hgFemale_df, hgFemale_list[[i]] %>% mutate(group = as.character(group)))
}
a +
coord_equal()
# gganatogram:::get_anatogram()
a +
ggstamp::stamp_wash() +
geom_path(data = hgFemale_list$brain, aes(x = x, y = -y), color = "red", size = .5, linetype = "dashed") +
coord_equal()## Warning in annotate(geom = "rect", xmin = xmin, ymin = ymin, xmax = xmax, :
## Ignoring unknown aesthetics: x and y## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_path()`).
# hgFemale_df %>% sf::st_as_sf(coords = c("x", "y"))
# str(last_plot())
hgFemale_df %>%
left_join(hgFemale_key, by = join_by(id == organ)) %>%
ggplot() +
aes(x = x, y = -y) +
geom_polygon(color = "lightgrey", aes(fill = I(colour))) +
coord_equal() +
aes(group = group) +
# aes(fill = id == "pancreas") +
geom_polygon(data = . %>% filter( id == "pancreas"),
fill = "blue") +
facet_wrap(~type, nrow = 2)