Intro Thoughts

Status Quo

library(tidyverse)

Experiment

library(tmap)
## Breaking News: tmap 3.x is retiring. Please test v4, e.g. with
## remotes::install_github('r-tmap/tmap')
data(NLD_prov)
data(NLD_muni)

Create reference data.

Now we’re looking at a dependency free method (w/o sf2stat), it’s a bit of code.

I believe this is a work around and it’s just a matter of time before figuring out how to get this more automated using what’s alread in ggplot2.

# lots of work to build sf2stat
# NLD_prov |>
#   dplyr::select(name_prov = name, code_prov = code, geometry) |>
#   sf2stat:::sf_df_prep_for_stat(id_col_name = "name_prov") ->
# nld_prov_geo_reference0

# a fun moment
# # build a plot with sf type data
# NLD_prov %>% 
#   ggplot() + 
#   geom_sf() + 
#   geom_sf_text(aes(label = name))
# 
# # extract xmin ymin, x y, 
# NLD_prov %>% 
#   select(name_prov = name, code_prov = code, geometry) %>%
#   bind_cols(layer_data() %>% select(xmin, xmax, ymin, ymax)) %>% 
#   bind_cols(layer_data(i = 2) %>% select(x, y)) %>% 
#   as.data.frame() %>% 
#   mutate(id_col = name_prov) ->
# nld_prov_geo_reference

# # the way - but now I put it below
# NLD_prov %>% 
#   StatSf$compute_panel(coord = CoordSf) ->
# 
# 
# NLD_prov %>% 
#   StatSfCoordinates$compute_group(coord = CoordSf)


NLD_prov %>% 
   select(name_prov = name, code_prov = code, geometry) %>% 
   mutate(id_col = name_prov)  %>% 
    StatSf$compute_panel(coord = CoordSf) %>%  # adds individual bounding boxes, xmin, ymin etc
    StatSfCoordinates$compute_group(coord = CoordSf) %>% # adds xy coordinates
  tibble() -> # remove sf info
nld_prov_geo_reference
## old-style crs object detected; please recreate object with a recent sf::st_crs()
## old-style crs object detected; please recreate object with a recent sf::st_crs()
## old-style crs object detected; please recreate object with a recent sf::st_crs()

write compute routine

compute_panel_nl_prov <- function(data, scales, keep_id = NULL, drop_id = NULL, stamp = FALSE){
  
  if(!stamp){data <- dplyr::inner_join(data, nld_prov_geo_reference)}
  if( stamp){data <- nld_prov_geo_reference }
  
  if(!is.null(keep_id)){ data <- filter(data, id_col %in% keep_id) }
  if(!is.null(drop_id)){ data <- filter(data, !(id_col %in% drop_id)) }
  
  data
}

write stat

StatNlprov <- ggplot2::ggproto(`_class` = "StatNlprov",
                                `_inherit` = ggplot2::StatSf,
                               required_aes = "name_prov|code_prov",
                               compute_panel = compute_panel_nl_prov,
                               default_aes = 
                                 ggplot2::aes(label = after_stat(id_col)))

try out the stat with geom_sf

NLD_prov |>
  sf::st_drop_geometry() |>
  slice(1:3) |>
  ggplot() + 
  aes(name_prov = name) + 
  geom_sf(stat = StatNlprov, stamp = T) + 
  geom_sf(stat = StatNlprov, fill = "darkred") +
  coord_sf(crs = "EPSG:28992") + 
  geom_sf_label(stat = StatNlprov, keep_id = "Groningen")
## Warning in layer_sf(data = data, mapping = mapping, stat = stat, geom =
## GeomLabel, : Ignoring unknown parameters: `fun.geometry`
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()

write user-facing wrappers

geom_prov <- function(...){
  
  list(
  geom_sf(stat = StatNlprov, ...),
  coord_sf(crs = "EPSG:28992")
  )
  
}


geom_prov_text <- function(...){
  
  list(
  geom_sf_text(stat = StatNlprov, ...),
  coord_sf(crs = "EPSG:28992")
  )
  
}

use user-facers.

NLD_prov |>
  sf::st_drop_geometry() |> # so we can test on flat file (no geometry )
  ggplot() + 
  aes(name_prov = name) + 
  geom_prov() + 
  geom_prov_text(size = 2) 
## Warning in layer_sf(data = data, mapping = mapping, stat = stat, geom =
## GeomText, : Ignoring unknown parameters: `fun.geometry`
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()
## 
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()

last_plot() + 
  aes(fill = population) + 
  scale_fill_viridis_c()
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()

NLD_prov |>
  sf::st_drop_geometry() |>
  ggplot() + 
  aes(name_prov = name) + 
  geom_prov(stamp = T) + 
  geom_prov_text(size = 2) 
## Warning in layer_sf(data = data, mapping = mapping, stat = stat, geom =
## GeomText, : Ignoring unknown parameters: `fun.geometry`
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()

NLD_prov |>
  sf::st_drop_geometry() |>
  ggplot() + 
  aes(name_prov = name) + 
  geom_prov(stamp = T) + 
  geom_prov_text(size = 5, keep_id = "Groningen") 
## Warning in layer_sf(data = data, mapping = mapping, stat = stat, geom =
## GeomText, : Ignoring unknown parameters: `fun.geometry`
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()

ho! new reality in 30 lines of code…

NLD_prov |>
  sf::st_drop_geometry() |>
  ggplot() + 
  aes(name_prov = name) +
  geom_prov() + 
  geom_prov_text(check_overlap = T)
## Warning in layer_sf(data = data, mapping = mapping, stat = stat, geom =
## GeomText, : Ignoring unknown parameters: `fun.geometry`
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()
## 
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent sf::st_crs()

last_plot() + 
  aes(fill = pop_65plus)
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()
## Joining with `by = join_by(name_prov)`
## old-style crs object detected; please recreate object with a recent
## sf::st_crs()

knitr::knit_exit()