another experiment

Intro Thoughts

Status Quo

library(tidyverse)
library(sportyR)

sportyR::geom_baseball("mlb", display_range = "full")

From sportyR field plot:

• grab plot layers 
• pull out x,y data from alll layer
• convert to sf (simple features)
• add a name to each ‘region’ (or line) - somewhat ad hoc, and I select baseball example because it feels relatively familiar and there are fewer elements.

Having done this, use ggregions framework:

• declare the dataset to be the region of interest with set_regions()
• Use aes(regions = my_region_id) and geom_region() and friends (e.g. stamp_region, stamp_region_label) to plot data and context.

get_layer_data <- function(layer){

    layer$data
  
}

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() 
  
}



out <- geom_baseball("mlb", display_range = "full")


out@layers |> 
  tibble(layers = _) |> 
  mutate(name = names(layers)) |>
  mutate(data = purrr::map(layers, .f = get_layer_data)) |> 
  unnest(data) |> 
  mutate(id = name, group = name) |>
  to_sf_routine() |> 
  mutate(name = c("infeild", 
                  "batting right",
                  "catcher's box",
                  "left foul line",
                  "right foul line",
                  "dugout",
                  "diamond",
                  "pitcher's mound",
                  "batter's mound",
                  "first base",
                  "second base",
                  "third base",
                  "pitcher's line",
                  "batting left")) |> 
  select(name, geometry) ->
baseball_reference

## `summarise()` has regrouped the output.
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by id and group.
## ℹ Output is grouped by id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(id, group))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.

library(ggregions)
set_regions(baseball_reference)
head(baseball_reference)

## Simple feature collection with 6 features and 1 field
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -251.0229 ymin: -251.0229 xmax: 251.0229 ymax: 12.99997
## CRS:           NA
## # A tibble: 6 × 2
##   name                                                                  geometry
##   <chr>                                                           <MULTIPOLYGON>
## 1 infeild         (((90.94829 -87.94829, 90.87778 -88.18084, 90.80668 -88.41321…
## 2 batting right   (((-3.20835 -3.7083, -5.20835 -3.7083, -5.20835 2.2917, -3.20…
## 3 catcher's box   (((1.79165 2.2917, 1.79165 7.2917, -1.79165 7.2917, -1.79165 …
## 4 left foul line  (((3.7083 -3.7083, 251.0229 -251.0229, 250.7729 -251.0229, 3.…
## 5 right foul line (((-3.7083 -3.7083, -251.0229 -251.0229, -250.7729 -251.0229,…
## 6 dugout          (((31.81981 -31.81981, 33.94113 -29.69848, 67.88225 -63.63961…

tribble(~zone, ~info,
        "right foul line", "good",
        "infeild", "bad",
        "diamond", "ugly",
        "pitcher's mound", "fine") |>
  ggplot() +
  aes(region = zone,
      color = zone) + 
  stamp_region() + 
  geom_region_border() + 
  stamp_region_label(keep = "left foul line")

library(gganatogram)

## Loading required package: ggpolypath

gganatogram(data=other_key[["bos_taurus"]], outline = T, fillOutline='white', organism="bos_taurus", sex='female', fill="colour")  +
        theme_void() +
        ggtitle("bos_taurus") + 
        theme(plot.title = element_text(hjust=0.5)) + 
        coord_fixed()

organs <- other_key[["bos_taurus"]]$organ

out <- last_plot()


out@layers |> 
  tibble(layers = _) |> 
  mutate(name = names(layers)) |>
  mutate(data = purrr::map(layers, .f = get_layer_data)) |> 
  slice(-1) |>
  unnest(data) |> 
  mutate(id = name, group = group) |>
  to_sf_routine() |> 
  mutate(organ = c("hide", "head", "liver",
                  "semicircle", "foot",
                  NA, "foot2", "underbelly",
                  "sliver", "arc","u-shape",
                  "below", "13", 14:64 )) ->
cow_sf

## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by id and group.
## ℹ Output is grouped by id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(id, group))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.

## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by id and group.
## ℹ Output is grouped by id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(id, group))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.

set_regions(cow_sf)

cow_sf |>
  head() |> 
  sf::st_drop_geometry() |>
  ggplot() + 
  aes(region = organ,
      fill = organ) +
  stamp_region() +
  geom_region()

## Coordinate system already present.
## ℹ Adding new coordinate system, which will replace the existing one.

## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_region()`).

Closing remarks, Other Relevant Work, Caveats