ggregions with teethr::dental_arcade_mapping

https://github.com/bbartholdy/teethr

library(tidyverse)
library(teethr)
teeth_ref_data <- dental_arcade_mapping |> 
  as_tibble() |> 
  left_join(tooth_notation |> 
  select(tooth = text, fdi = FDI, standard = standards) 
  )

caries_ratios <- mb11_caries %>% 
  dental_longer(-id) %>%
  dental_join() %>% 
  count_caries(caries = score, no_lesion = "none") %>% # convert location to lesion count
  group_by(tooth) %>% 
  dental_ratio(count = caries_count) %>%
  dental_recode(tooth, "FDI", "text") 
head(teeth_ref_data)  # are there other ids?  like just number of tooth?
## # A tibble: 6 × 4
##   tooth                                                  geometry fdi   standard
##   <chr>                                                 <POLYGON> <chr> <chr>   
## 1 URM2  ((65.18537 293.3849, 65.71057 295.1088, 66.38935 296.496… 17    2       
## 2 URM1  ((74.4591 325.7847, 75.55431 326.5688, 76.88258 327.0586… 16    3       
## 3 URP2  ((76.59484 342.573, 77.43558 343.7596, 78.59217 344.6295… 15    4       
## 4 URP1  ((86.86233 359.6018, 86.86725 360.529, 87.02025 360.8659… 14    5       
## 5 URC1  ((101.1985 370.3966, 101.3456 371.2152, 101.6861 371.999… 13    6       
## 6 URI2  ((123.4955 387.3634, 123.4955 387.3634, 124.5163 387.779… 12    7
library(ggregions)
geom_tooth <- ggregions::write_geom_region_locale(teeth_ref_data)
geom_tooth_text <- write_geom_region_text_locale(teeth_ref_data)
stamp_tooth <- write_stamp_region_locale(teeth_ref_data)
stamp_tooth_text <- write_stamp_region_text_locale(teeth_ref_data)

yields user-friendly API

head(caries_ratios)
## # A tibble: 6 × 4
##   tooth     n count  ratio
##   <chr> <int> <dbl>  <dbl>
## 1 URI1     35     4 0.114 
## 2 URI2     31     4 0.129 
## 3 URC1     35     7 0.2   
## 4 URP1     34     3 0.0882
## 5 URP2     23     5 0.217 
## 6 URM1     32     7 0.219
caries_ratios |> 
  ggplot() + 
  aes(tooth = tooth, 
      fill = ratio) + 
  geom_tooth(alpha = .2) + 
  stamp_tooth_text(size = 2)

ggregions with gganatogram::cell_list

to_sf_routine <- function(data){
  
  data |>
  mutate(y = -y) |>
  sf::st_as_sf(coords = c("x", "y"), agr = "constant") |>
  group_by(id, group) |>
  summarize(do_union = F) |> 
  ungroup() |> 
  group_by(id, group) |>
  summarise() |>
  mutate(geometry = geometry |> sf::st_cast("POLYGON")) |> 
  mutate(geometry = geometry |> sf::st_cast("MULTIPOLYGON")) |> 
  ungroup() 
  
}
cell_sf <- gganatogram::cell_list[[1]] |> 
  bind_rows() |>
  remove_missing() |>
  to_sf_routine() |> 
  rename(organelle = id)
geom_organelle <- ggregions::write_geom_region_locale(cell_sf)
stamp_organelle <- ggregions::write_stamp_region_locale(cell_sf)

cell_sf
## Simple feature collection with 1088 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: 5.4 ymin: -483.4 xmax: 606.7 ymax: -8.4
## CRS:           NA
## # A tibble: 1,088 × 3
##    organelle       group                                                geometry
##    <chr>           <chr>                                          <MULTIPOLYGON>
##  1 actin_filaments 6_10  (((43.4 -268.8, 52.5 -250.1, 62.4 -231.9, 74.4 -214.6,…
##  2 actin_filaments 6_11  (((111 -398.1, 113.7 -400.7, 116.4 -403.2, 96.6 -396.2…
##  3 actin_filaments 6_12  (((112.1 -396.9, 112.6 -397.1, 113.2 -397.3, 121 -400.…
##  4 actin_filaments 6_13  (((170.7 -422.4, 175.3 -423.8, 179.9 -425.2, 184.8 -42…
##  5 actin_filaments 6_14  (((197.2 -430.3, 203.4 -432.1, 209.7 -433.9, 206.5 -43…
##  6 actin_filaments 6_15  (((554.9 -230.1, 554.3 -238.9, 553.9 -247.6, 537.5 -17…
##  7 actin_filaments 6_16  (((554.6 -192.2, 556.1 -196.3, 557.6 -200.4, 557.1 -20…
##  8 actin_filaments 6_17  (((557.9 -245.2, 559.4 -261.7, 560.9 -278.7, 559 -269.…
##  9 actin_filaments 6_18  (((523 -91.4, 531 -97, 537.9 -102.8, 543.2 -128.5, 547…
## 10 actin_filaments 6_19  (((512.7 -82.2, 512 -80.5, 511.3 -78.8, 519.4 -82.2, 5…
## # ℹ 1,078 more rows

yields user-friendly API

ggplot() + 
  stamp_organelle(alpha = .2) + 
  stamp_organelle(keep = "actin_filaments", 
                  fill = "orange" |> alpha(.1)) +
  stamp_organelle(keep = "endoplasmic_reticulum", 
                  fill = "darkred")

ggregions and gganatogram::hgFemale_list

length(gganatogram::hgFemale_list)
## [1] 204
# fix so that all data frames can be combined with bind_rows
# the groups are numeric and character so using bind_rows fails
female_sf <- gganatogram::hgFemale_list[c(1:156, 180:195)] |> # return to this!!
  bind_rows() |>
  remove_missing() |>
  to_sf_routine() |> 
  rename(organ = id)
  
stamp_organ <- ggregions::write_stamp_region_locale(female_sf)

ggplot(female_sf) + 
  aes(geometry = geometry) +
  geom_sf(alpha = .2)

male_sf <- gganatogram::hgMale_list[2:155] |>  
  bind_rows() |>
  # filter(x != 0, y != 0, y < -2) |>
  remove_missing() |>
  to_sf_routine() 



ggplot(male_sf) + 
  aes(geometry = geometry) +
  geom_sf(alpha = .2)

yields user-friendly API

ggplot() + 
  stamp_organ(alpha = .2) + 
  stamp_organ(
    keep = c("lung", "stomach", 
             "heart", "brain", "trachea"),
    aes(fill = after_stat(organ))
    )

ggregions and ggseg::aseg$data

library(ggseg)

coronal_ref_data <- ggseg::aseg$data |> 
  filter(side == "coronal") |>     # just look at coronal for the nuttiness.
  group_by(region) |> 
  summarise(geometry = sf::st_combine(geometry)) |> 
  select(region = region, everything())
  
coronal_ref_data |> pull(region)
## [1] "amygdala"          "caudate"           "hippocampus"      
## [4] "lateral ventricle" "pallidum"          "putamen"          
## [7] "thalamus proper"   "ventral DC"        NA
library(ggregions)
geom_region <- write_geom_region_locale(ref_data = coronal_ref_data)
stamp_region <- write_stamp_region_locale(ref_data = coronal_ref_data)
geom_region_text <- write_geom_region_text_locale(ref_data = coronal_ref_data)
stamp_region_text <- write_stamp_region_text_locale(ref_data = coronal_ref_data)

yields user-friendly API

tribble(~activity, ~segment,
        .2,        "hippocampus",
        .5,        "amygdala",
        .7,        "thalamus proper",
        .5,        "caudate") |>
ggplot() + 
  stamp_region() + 
  aes(region = segment,
      fill = activity) + 
  geom_region() + 
  scale_fill_viridis_c(option = "magma")