Intro Thoughts

Status Quo

library(tidyverse)
library(gganatogram)
## Loading required package: ggpolypath
gganatogram::mmFemale_list |> 
  bind_rows() |>
  remove_missing() |>
  ggplot() + 
  aes(x, -y, group = group, fill = id) + 
  geom_polygon(show.legend = F)

to_sf_routine <- function(data){
  
  data |>
  mutate(y = -y) |>
  sf::st_as_sf(coords = c("x", "y"), agr = "constant") |>
  group_by(group, id) |>
  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() 
  
}

mm_female_sf <- gganatogram::mmFemale_list |> 
  bind_rows() |>
  # filter(x != 0, y != 0, y < -2) |>
  remove_missing() |>
  to_sf_routine() |> 
  rename(organ = id)
## Warning: Removed 432 rows containing missing values or values outside the scale
## range.
## `summarise()` has grouped output by 'group'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.
mm_female_sf |> 
  ggplot()  + 
  geom_sf(aes(geometry = geometry)) + 
  coord_sf()

# compare
ggseg::aseg$data$geometry
## Geometry set for 29 features 
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -0.5 ymin: 0 xmax: 7.061358 ymax: 3.203063
## CRS:           NA
## First 5 geometries:
## MULTIPOLYGON (((2.07673 2.70275, 2.07683 2.7038...
## MULTIPOLYGON (((0.50396 2.66412, 0.50211 2.6665...
## MULTIPOLYGON (((1.03233 1.13797, 1.03203 1.1391...
## MULTIPOLYGON (((1.64163 1.63765, 1.65383 1.6278...
## MULTIPOLYGON (((1.64163 1.63765, 1.63383 1.6350...
geom_organ <- ggregions::write_geom_region_locale(mm_female_sf)
stamp_organ <- ggregions::write_stamp_region_locale(mm_female_sf)

mm_female_sf$organ |> sample(20)
##  [1] "UBERON_0000947"            "peripheral_nervous_system"
##  [3] "UBERON_0000947"            "spleen"                   
##  [5] "peripheral_nervous_system" "peripheral_nervous_system"
##  [7] "lymph_node"                "UBERON_0000947"           
##  [9] "reproductive_system"       "skeletal_muscle"          
## [11] "peripheral_nervous_system" "UBERON_0000947"           
## [13] "UBERON_0000947"            "lymph_node"               
## [15] "peripheral_nervous_system" "peripheral_nervous_system"
## [17] "UBERON_0000947"            "peripheral_nervous_system"
## [19] "peripheral_nervous_system" "reproductive_system"
ggplot() + 
  stamp_organ() + 
  stamp_organ(keep = "aorta", fill = "darkred") +
  stamp_organ(keep = "brain", fill = "darkseagreen") + 
  stamp_organ(keep = "blood_vessel", fill = "orange")
## Coordinate system already present.
## ℹ Adding new coordinate system, which will replace the existing one.
## Coordinate system already present.
## ℹ Adding new coordinate system, which will replace the existing one.
## Coordinate system already present.
## ℹ Adding new coordinate system, which will replace the existing one.

Experiment

Closing remarks, Other Relevant Work, Caveats