Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/evamaerey/ggsomewhere
a template package for making place-base ggplot2 extension packages
https://github.com/evamaerey/ggsomewhere
Last synced: 11 days ago
JSON representation
a template package for making place-base ggplot2 extension packages
- Host: GitHub
- URL: https://github.com/evamaerey/ggsomewhere
- Owner: EvaMaeRey
- Created: 2024-03-22T21:11:28.000Z (8 months ago)
- Default Branch: main
- Last Pushed: 2024-05-02T03:23:18.000Z (6 months ago)
- Last Synced: 2024-05-02T18:12:05.038Z (6 months ago)
- Language: R
- Size: 566 KB
- Stars: 2
- Watchers: 1
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.Rmd
Awesome Lists containing this project
README
---
output: github_document
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
# ggsomewhere
The goal of ggsomewhere (and it's github repository) is to provide tools for building spatial ggplot2 extensions.
The approach makes use of ggplot2's sf plotting capabilities, the sf2stat package to prepare reference data for use inside a stat_* or geom_* layer, and the knitrExtra package functions for managing functions from a readme and working with template functions included in the readme.
## Fully worked example...
How you'd use sf2stat to build functionality with scope, region type, and location name. When using the code templates for this north carolina county example, we'll be replacing 'scope', 'region', and 'locations' as follows
- 'scope' -> 'northcarolina'
- 'region' -> 'county'
- 'locations' -> a vector of region names
Let's see how we might recreate the functionality in the ggnorthcarolina package using some templates in this readme.
In the example, the scope of the package is 'northcarolina'. The region of interest is 'county', and the location names that we are using are the county names.
## Create package architecture
```{r, eval = F}
devtools::create(".")
```
## Step 00. prep reference data
### Create raw data folder
```{r, eval = F}
usethis::use_data_raw()
```
## Preparation
The reference data should have just the id columns and the geometry. Then it should be named similar to this:
geo_reference_northcarolina_county
Where 'northcarolina' is is the character string that will replace 'scope' when using the code templates, and 'county' is the character string that will replace region in the
```{r nc_geo_reference_prep, eval = T}
nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))
geo_reference_northcarolina_county <- nc |>
dplyr::select(county_name = NAME, fips = FIPS) |>
sf2stat:::sf_df_prep_for_stat(id_col_name = "county_name")
usethis::use_data(geo_reference_northcarolina_county, overwrite = T)
```
```{r, eval = F}
knitrExtra:::chunk_to_dir("nc_geo_reference_prep",
dir = "data-raw/")
```
## Use template to create `stat_county()` functionality
```{r}
knitrExtra:::chunk_variants_to_dir(chunk_name = "stat_region_template",
file_name = "stat_county.R",
replace1 = "scope",
replacements1 = "northcarolina",
replace2 = "region",
replacements2 = "county")
```
```{r stat_region_template, eval = F}
compute_panel_scope_region <- function(data,
scales,
keep_id = NULL,
drop_id = NULL,
stamp = FALSE){
if(!stamp){data <- dplyr::inner_join(data, geo_reference_scope_region)}
if( stamp){data <- geo_reference_scope_region }
if(!is.null(keep_id)){ data <- dplyr::filter(data, id_col %in% keep_id) }
if(!is.null(drop_id)){ data <- dplyr::filter(data, !(id_col %in% drop_id)) }
data
}
# step 2
StatSfscoperegion <- ggplot2::ggproto(`_class` = "StatSfscoperegion",
`_inherit` = ggplot2::Stat,
# required_aes = c("fips|county_name"),
compute_panel = compute_panel_scope_region,
default_aes = ggplot2::aes(label = after_stat(id_col)))
stat_region <- function(
mapping = NULL,
data = NULL,
geom = ggplot2::GeomSf,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE,
crs = "NAD27", # "NAD27", 5070, "WGS84", "NAD83", 4326 , 3857
...) {
c(ggplot2::layer_sf(
stat = StatSfscoperegion, # proto object from step 2
geom = geom, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = rlang::list2(na.rm = na.rm, ...)
),
coord_sf(crs = crs,
default_crs = sf::st_crs(crs),
datum = crs,
default = TRUE)
)
}
```
### test it out `stat_county()`
```{r}
source("./R/stat_county.R")
library(ggplot2)
nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))
nc |>
sf::st_drop_geometry() |>
ggplot() +
aes(fips = FIPS) +
stat_county() +
aes(fill = BIR79)
```
## Use template to create useful derivitive functions
```{r}
knitrExtra:::chunk_variants_to_dir(chunk_name = "geom_region_template",
file_name = "geom_county.R",
replace1 = "region",
replacements1 = "county")
```
```{r geom_region_template, eval = F}
geom_region <- stat_region
geom_region_label <- function(...){stat_region(geom = "text",...)}
stamp_region <- function(...){
stat_region(stamp = T,
data = mtcars,
aes(fill = NULL, color = NULL, label = NULL,
fips = NULL, region_name = NULL),
...)}
stamp_region_label <- function(...){
stat_region(stamp = T,
geom = "text",
data = mtcars,
aes(fill = NULL, color = NULL,
fips = NULL, region_name = NULL),
...)}
```
### try those out
```{r}
source("./R/geom_county.R")
nc |>
sf::st_drop_geometry() |>
ggplot() +
aes(fips = FIPS) +
geom_county() +
geom_county_label(check_overlap = T,
color = "grey85") +
aes(fill = BIR79)
last_plot() +
stamp_county() +
stamp_county_label()
ggplot() +
stamp_county()
last_plot() +
stamp_county_label(check_overlap = T)
last_plot() +
stamp_county(keep_id = "Wake", fill = "darkred")
```
## Use template to write convenience functions for each region
```{r eval= F}
locations <- geo_reference_northcarolina_county$county_name
locations_snake <- tolower(locations) |>
stringr::str_replace_all(" ", "_")
knitrExtra:::chunk_variants_to_dir(chunk_name = "stamp_region_location",
file_name = "stamp_county_location.R",
replace1 = "region",
replacements1 = rep("county", length(locations)),
replace2 = "location",
replacements2 = locations_snake,
replace3 = "Location",
replacements3 = locations)
```
```{r stamp_region_location}
#' Title
#'
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
stamp_region_location <- function(...){stamp_region(keep_id = 'Location', ...)}
#' Title
#'
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
stamp_region_label_location <- function(...){stamp_region_label(keep_id = 'Location', ...)}
```
### Try it out
```{r last_test}
source("./R/stamp_county_location.R")
nc |>
sf::st_drop_geometry() |>
ggplot() +
aes(fips = FIPS) +
stamp_county() +
stamp_county_ashe(fill = "darkred")
last_plot() +
stamp_county_label_ashe(color = "oldlace")
```