library(tidyverse)
library(sportyR)
sportyR::geom_baseball("mlb", display_range = "full")
From plot
Having done this, use ggregions framework
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")