Intro Thoughts

Status Quo

library(tidyverse)
library(ozmaps)

# some data that we want to viz
au_states <- tribble(~state, ~pop,
        "Victoria", 1,
        "Queensland", 2,
        "New South Wales", 3,
        "Western Australia", 4,
        "Northern Territory", 5,
        "Tasmania", 6,
        "South Australia", 7,
        "Australian Capital Territory", 8,
        "Other Territories", 9
        )

sf_oz <- ozmap("states")

sf_oz |> names()
## [1] "NAME"     "geometry"
sf_oz |>
  full_join(au_states, by = join_by(NAME == state )) |> 
  ggplot() + 
  geom_sf() +
  aes(fill = pop)

But awkward, so… Step 1. Compute

australia_state_ref <- sf_oz |>
  select(state_name = NAME)


compute_panel_regions <- function(data = au_states, scales, ref_data = australia_state_ref, keep = NULL, drop = NULL, stamp = F){

ref_data$id <- ref_data[1][[1]]

if(!is.null(keep)){ref_data <- ref_data |> filter(id %in% keep)}
if(!is.null(drop)){ref_data <- ref_data |> filter(!(id %in% drop))}

ref_data <- ref_data |> 
    ggplot2::StatSf$compute_panel(coord = ggplot2::CoordSf) |>
    ggplot2::StatSfCoordinates$compute_group(coord = ggplot2::CoordSf)

if(!stamp){ ref_data |> inner_join(data) } else { ref_data }

}

Test Compute

au_states |> 
  rename(state_name = state) |>
  compute_panel_regions()
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Simple feature collection with 9 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: 105.5507 ymin: -43.63203 xmax: 167.9969 ymax: -9.229287
## Geodetic CRS:  GDA94
## # A tibble: 9 × 10
##   state_name                  geometry id     xmin  xmax  ymin  ymax     x     y
##   <chr>             <MULTIPOLYGON [°]> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 New South… (((150.7016 -35.12286, 1… New …  106.  168. -43.6 -9.23  146. -32.8
## 2 Victoria   (((146.6196 -38.70196, 1… Vict…  106.  168. -43.6 -9.23  145. -36.6
## 3 Queensland (((148.8473 -20.3457, 14… Quee…  106.  168. -43.6 -9.23  143. -19.9
## 4 South Aus… (((137.3481 -34.48242, 1… Sout…  106.  168. -43.6 -9.23  137. -32.0
## 5 Western A… (((126.3868 -14.01168, 1… West…  106.  168. -43.6 -9.23  121. -24.4
## 6 Tasmania   (((147.8397 -40.29844, 1… Tasm…  106.  168. -43.6 -9.23  147. -42.2
## 7 Northern … (((136.3669 -13.84237, 1… Nort…  106.  168. -43.6 -9.23  133. -18.4
## 8 Australia… (((149.2317 -35.222, 149… Aust…  106.  168. -43.6 -9.23  149. -35.5
## 9 Other Ter… (((167.9333 -29.05421, 1… Othe…  106.  168. -43.6 -9.23  151. -35.2
## # ℹ 1 more variable: pop <dbl>
ggplot(au_states) +
  aes(state_name = state) +
  geom_sf(stat = ggproto(NULL, Stat, 
                         compute_panel = compute_panel_regions)) + 
  aes(fill = pop)
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`

Step 2. Define Stat

StatRegion <- ggproto("StatRegion",
                        Stat,
                        compute_panel = compute_panel_regions,
                        default_aes = aes(label = after_stat(id)))

Test Stat

ggplot(au_states) +
  aes(state_name = state) +
  geom_sf(stat = StatRegion) + 
  geom_text(stat = StatRegion) +
  aes(fill = pop)
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`

Step 3. Define user facing function w/ make_constructor… But: coord_sf must be added separately

geom_state <- make_constructor(GeomSf, stat = StatRegion, ref_data = australia_state_ref)
geom_state_text <- make_constructor(GeomText, stat = StatRegion, ref_data = australia_state_ref)

crs_au_states <- sf::st_crs(sf_oz)

ggplot(au_states) +
  aes(state_name = state) + 
  geom_state() + # errors without coord_sf, and needs the right one
  geom_state_text(check_overlap = T, size = 2) + 
  aes(fill = pop) +
  coord_sf(crs = crs_au_states)
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`

Step 3.0.1 make geom_region0 (no coords) and friends w/ make_constructor… and geom_region (w/ coords)… and friends.

geom_region0 <- make_constructor(GeomSf, stat = StatRegion) # no crs
geom_region_text0 <- make_constructor(GeomText, stat = StatRegion) # no crs
stamp_region0 <- make_constructor(GeomSf, stat = StatRegion, stamp = T) # no crs
stamp_region_text0 <- make_constructor(GeomText, stat = StatRegion, stamp = T) # no crs

# all the arguments should be passed
geom_region <- function(..., ref_data){
  c(geom_region0(..., ref_data = ref_data), 
    coord_sf(crs = sf::st_crs(ref_data)))
}

geom_region_text <- function(..., ref_data){
  c(geom_region_text0(..., ref_data = ref_data), 
    coord_sf(crs = sf::st_crs(ref_data)))
}

Step 4. make region-specific user-facing functions!

# all arguments above that should be passed, could be passed, or, 
geom_states <- function(...){geom_region(..., ref_data = australia_state_ref)}
geom_states_text <- function(...){geom_region_text(..., ref_data = australia_state_ref)}

test!

au_states |>
ggplot() +
  aes(state_name = state,
      fill = pop) + 
  geom_states() +
  geom_states(keep = "Western Australia", 
              color = "red",
              fill = NA) +
  geom_states_text() + 
  geom_states(stamp = T,
              keep = "Tasmania", 
              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.
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data

au_states |>
  ggplot() +
  aes(state_name = state) + 
  geom_states(aes(fill = pop))
## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data
## Joining with `by = join_by(state_name)`

epiloge, something nicer for for geom_region -> geom_province, geom_state, etc? specify_geom_region()

geom_region0
## function (mapping = NULL, data = NULL, stat = StatRegion, position = "identity", 
##     ..., legend = NULL, lineend = "butt", linejoin = "round", 
##     linemitre = 10, arrow = NULL, arrow.fill = NULL, na.rm = FALSE, 
##     show.legend = NA, inherit.aes = TRUE) 
## {
##     layer(mapping = mapping, data = data, geom = "sf", stat = stat, 
##         position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
##         params = list2(na.rm = na.rm, legend = legend, lineend = lineend, 
##             linejoin = linejoin, linemitre = linemitre, arrow = arrow, 
##             arrow.fill = arrow.fill, ...))
## }
## <environment: 0x7fbcf2171eb0>
# all the arguments should be passed
geom_region <- function(mapping = NULL, data = NULL, stat = StatRegion, position = "identity", ..., legend = NULL, lineend = "butt", linejoin = "round", 
    linemitre = 10, arrow = NULL, arrow.fill = NULL, na.rm = FALSE, 
    show.legend = NA, inherit.aes = TRUE, ref_data){
  
  c(geom_region0(mapping = mapping, data = data, geom = "sf", stat = stat, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list2(na.rm = na.rm, legend = legend, lineend = lineend, 
            linejoin = linejoin, linemitre = linemitre, arrow = arrow, 
            arrow.fill = arrow.fill, ..., ref_data = ref_data)), 
    coord_sf(crs = sf::st_crs(ref_data)))
  
}


geom_au_state <- purrr::partial(geom_region, ref_data = australia_state_ref)

Closing remarks, Other Relevant Work, Caveats