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.
