Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/evamaerey/ggtemp
write geom_* and stat_* layers concisely for in-script use
https://github.com/evamaerey/ggtemp
Last synced: 11 days ago
JSON representation
write geom_* and stat_* layers concisely for in-script use
- Host: GitHub
- URL: https://github.com/evamaerey/ggtemp
- Owner: EvaMaeRey
- License: other
- Created: 2024-01-24T21:21:40.000Z (10 months ago)
- Default Branch: main
- Last Pushed: 2024-03-01T19:07:57.000Z (8 months ago)
- Last Synced: 2024-03-02T18:45:47.430Z (8 months ago)
- Language: R
- Homepage: https://evamaerey.github.io/ggtemp/
- Size: 8.12 MB
- Stars: 0
- Watchers: 1
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.Rmd
- License: LICENSE
Awesome Lists containing this project
README
---
output:
github_document:
toc: FALSE
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval = T,
fig.path = "man/figures/README-",
warning = F,
message = F
)
```
Proposing the {ggtemp} package! 🦄
The goal of {ggtemp} is to make writing some quick, useful extension functions succinctly (right now writing new stat_* and geom_* layers are the focus.
Currently, the amount of code required to write some extensions is a bit of a mouthful, and could feel prohibitive for day-to-day analysis scripts. Specifically, defining new geom_* and stat_* layers outside of the context of a package, I believe, is not common, but could be quite useful, ultimately making plot builds themselves intuitive and fun, and code more readable. However the usual amount of code required to make define new geom_* or stat_* functions, might feel like it 'gunks up' your script currently.
With the {ggtemp} package, we'll live in a different world (🦄 🦄 🦄) where the task is a snap 🫰, and the readability of the in-script definition of a geom_* or stat_* function is quite succinct:
Proposed API where we create a new geom_* layer function.
Related:
0. [First experiment sketch]( https://evamaerey.github.io/mytidytuesday/2024-01-22-insta-geom/insta-geom.html )
1. [Elio C's Stat Rasa (June Choe refered me to this cool post!)]( https://eliocamp.github.io/codigo-r/en/2018/05/how-to-make-a-generic-stat-in-ggplot2/ )
2. I enjoyed [working with StatRasa in my sketchbook]( https://evamaerey.github.io/mytidytuesday/2024-02-05-ggexpress-follow-up/ggexpress-follow-up.html)
2. [ggplot2 extension cookbook](https://evamaerey.github.io/ggplot2-extension-cookbook/) might serve as reference for long-form syntax.
### Issues and where this all might be going:
There doesn't seem to be a complete match of the full functionality of the layers. For example, you have to write mapping = aes() to specify the aesthetic mapping within the layer.
1. Maybe we can fix this.
2. Maybe the temp utilities can be used for prototyping, and then we return to the more conventional syntax
```
library(ggtemp)
# 1. work out some compute
compute_group_xmean <- function(data, scales){
data |> # a dataframe with vars x, the required aesthetic
summarize(x = mean(x)) |>
mutate(xend = x) |>
mutate(y = -Inf, yend = Inf)
}
# 2. create layer function based on compute geom_xmean)
create_layer_temp(fun_name = "geom_xmean",
compute_group = compute_group_xmean,
required_aes = "x",
geom_defaut = "segment")
# 3. Use temp layer!
ggplot(data = cars) +
aes(x = speed, y = dist) +
geom_point() +
geom_xmean()
```
# Part I. Work out functionality ✅
## Intro Thoughts
What if you just want to define a basic computational engine (geom_* or stat_* function) on the fly in a script. It seems like it requires a good amount of code, but there are things that repeat. Below, we see if we define a StatTemp within a function, and use that function to remove some of the repetition for vanilla-y extensions.
TLDR: This seems to work, and surprisingly well (??). I thought I'd only be able to use StatTemp once, but you seem to be able to define multiple geoms_* functions with the same define_temp_geom wrapper...
## Status Quo: 1. compute, 2. ggproto, 3. define layer
```{r cars}
library(tidyverse)
compute_panel_equilateral <- function(data, scales, n = 15){
data |>
mutate(group = row_number()) |>
crossing(tibble(z = 0:n)) |>
mutate(around = 2*pi*z/max(z)) |>
mutate(x = x0 + cos(around)*r,
y = y0 + sin(around)*r)
}
StatCircle <- ggproto(
`_class` = "StatCircle",
`_inherit` = ggplot2::Stat,
compute_panel = compute_panel_equilateral,
required_aes = c("x0", "y0", "r"))
geom_circle <- function(
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatCircle, # proto object from Step 2
geom = ggplot2::GeomPolygon, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3) |>
ggplot() +
aes(x0 = x0, y0 = y0, r = r) +
geom_circle() +
aes(fill = r)
```
## Experimental: `define_layer_temp()` combines 2 and 3 in using a temp Stat under the hood
```{r define_layer_temp}
`%||%` <- ggplot2:::`%||%`
define_layer_temp <- function(
default_aes = ggplot2::aes(),
required_aes = character(),
dropped_aes = character(),
optional_aes = character(),
non_missing_aes = character(),
compute_group = NULL,
compute_panel = NULL,
compute_layer = NULL,
setup_data = NULL,
# finish_layer = # we'll work on making these stat ggproto slots accessible too
# retransform
# extra_params =
# setup_params
# parameters
geom = NULL,
geom_default = ggplot2::GeomPoint,
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE,
...) {
StatTemp <- ggproto(
`_class` = "StatTemp",
`_inherit` = ggplot2::Stat,
default_aes = default_aes,
required_aes = required_aes)
if(!is.null(compute_group)){StatTemp$compute_group <- compute_group}
if(!is.null(compute_panel)){StatTemp$compute_panel <- compute_panel}
if(!is.null(compute_layer)){StatTemp$compute_layer <- compute_layer}
if(!is.null(setup_data)){StatTemp$setup_data <- setup_data}
if(is.null(geom)){geom <- geom_default}
ggplot2::layer(
stat = StatTemp,
geom = geom,
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
```
### Try it out
#### abbreviated definition `geom_circle()` using `define_layer_temp`
```{r}
compute_panel_circle <- function(data, scales, n = 15){
data |>
mutate(group = row_number()) |>
crossing(tibble(z = 0:n)) |>
mutate(around = 2*pi*z/max(z)) |>
mutate(x = x0 + cos(around)*r,
y = y0 + sin(around)*r)
}
geom_circle <- function(...){
define_layer_temp(
required_aes = c("x0", "y0", "r"),
compute_panel = compute_panel_circle,
geom_default = ggplot2::GeomPath,
...)
}
```
#### use `geom_circle()`
We see that the layers that are created can always have there geom switched (provided that required aes are computed in the background).
```{r}
library(ggplot2)
data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3) |>
ggplot() +
aes(x0 = x0, y0 = y0, r = r) +
geom_circle() +
aes(fill = r)
last_plot() +
geom_circle(geom = "point")
```
### Can you define a second w/ the same StatTemp...
#### define geom_heart
```{r}
compute_panel_heart <- function(data, scales){
data %>%
mutate(group = row_number()) %>%
tidyr::crossing(around = 0:15/15) %>%
dplyr::mutate(
y = y0 + r * (
.85 * cos(2*pi*around)
- .35 * cos(2 * 2*pi*around)
- .25 * cos(3 * 2*pi*around)
- .05 * cos(4 * 2*pi*around)
),
x = x0 + r * (sin(2*pi*around)^3))
}
geom_heart <- function(...){
define_layer_temp(
required_aes = c("x0", "y0", "r"),
compute_panel = compute_panel_heart,
geom_default =ggplot2::GeomPolygon,
...)
}
```
#### try using both geom_heart and geom_circle together...
```{r}
data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3) |>
ggplot() +
aes(x0 = x0, y0 = y0, r = r) +
geom_heart(alpha = .3) +
geom_circle(color = "red",
data = data.frame(x0 = 4,y0 = 2, r = 1)) +
annotate(geom = "point", x = .5, y = .5, size = 8, color = "green")
```
## And `create_layer_temp` method, even more experimental (but feeling nicer to use)
### First just checking out how assign works.
```{r }
assign(x = "geom_circle",
value =
function(...){
define_layer_temp(
required_aes = c("x0", "y0", "r"),
compute_panel = compute_panel_circle,
geom_default =ggplot2::GeomPath,
...)
}
)
```
### wrapping this...
```{r create_layer_temp}
create_layer_temp <- function(fun_name ="geom_circle",
compute_panel = NULL,
compute_group = NULL,
required_aes = character(),
default_aes = aes(),
geom_default ="point", ...){
assign(x = fun_name,
value = function(...){
define_layer_temp(
required_aes = required_aes,
default_aes = default_aes,
compute_panel = compute_panel,
compute_group = compute_group,
geom_default = geom_default,
...) },
pos = 1
)
}
```
#### and trying it out
```{r}
create_layer_temp(fun_name = "stat_circle",
required_aes = c("x0", "y0", "r"),
compute_panel = compute_panel_circle,
geom_default ="polygon")
library(ggplot2)
ggplot(cars) +
aes(x0 = speed, y0 = dist, r = 3) +
stat_circle(alpha = .4) +
coord_equal()
```
## Let's do star example!
```{r}
compute_panel_star <- function(data, scales, n_points = 5, prop_inner_r){
n_vertices <- n_points * 2
data %>%
mutate(group = row_number()) %>%
tidyr::crossing(around = 2*pi*0:(n_vertices)/(n_vertices)+pi/2) %>%
dplyr::mutate(
y = y + (r - r*c(rep(c(0,.35), 5), 0)
) * sin(around) ,
x = x + (r - r*c(rep(c(0,.35), 5), 0)
) * cos(around)
)
}
create_layer_temp(fun_name = "geom_star",
compute_panel = compute_panel_star,
required_aes = c("x", "y", "r"),
geom_default ="polygon")
library(ggplot2)
ggplot(cars[1:8,] ) +
aes(x = speed, y = dist, r = 1) +
geom_star() +
coord_equal()
last_plot() +
geom_star(geom = "point", color = "magenta")
```
### A point with no required aes
```{r, fig.show="hold", out.width="33%"}
`%||%` <- ggplot2:::`%||%`
compute_group_point <- function(data, scales){
if(is.null(data$y)){data$y <- 0}
if(is.null(data$x)){data$x <- 0}
data
}
cars |>
select(x = speed, y = dist) |>
compute_group_point() |>
head()
create_layer_temp(fun_name = "geom_point_zero_xy_defaults",
compute_group = compute_group_point,
required_aes = character(),
default_aes = aes(x = NULL, y = NULL),
geom_default = "point")
ggplot(cars) +
geom_point_zero_xy_defaults(alpha = .7)
last_plot() +
aes(x = speed)
last_plot() +
aes(y = dist)
```
# geom_xmean on the fly with compute group...
```{r}
# 1. write some compute
compute_group_xmean <- function(data, scales){
data |>
summarize(x = mean(x)) |>
mutate(xend = x) |>
mutate(y = -Inf, yend = Inf)
}
# 2. define function
create_layer_temp(fun_name = "geom_xmean",
compute_group = compute_group_xmean,
required_aes = "x",
geom_default ="segment")
# 3. use function
ggplot(cars) +
aes(x = speed, y = dist) +
geom_point() +
geom_xmean() +
aes(color = speed > 18)
```
## compute_oval_minmax
```{r}
compute_oval_minmax <- function(data, scales, n = 100){
data |>
summarize(
x0 = sum(range(x))/2,
y0 = sum(range(y))/2,
rx = (range(x)[2] - range(x)[1])/2 ,
ry = (range(y)[2] - range(y)[1])/2) |>
# mutate(group = row_number()) |>
crossing(tibble(z = 0:n)) |>
mutate(around = 2*pi*z/max(z)) |>
mutate(x = x0 + cos(around)*rx,
y = y0 + sin(around)*ry)
}
mtcars |>
select(x = wt, y = mpg) |>
compute_oval_minmax()
# 2. define function
create_layer_temp(fun_name = "geom_oval_xy_range",
compute_group = compute_oval_minmax,
required_aes = c("x","y"),
geom_default = "path")
ggplot(mtcars) +
aes(x = wt, y = mpg) +
geom_point() +
geom_oval_xy_range()
last_plot() +
aes(color = wt > 3.4)
```
```{r}
compute_group_progression <- function(data, scales){
data |>
mutate(xend = lead(x)) |>
mutate(yend = lead(y))
}
create_layer_temp(fun_name = "stat_progression",
compute_group = compute_group_progression,
required_aes = c("x","y"),
geom_default = "segment")
# A some point this illustrated a problem for me. But cannot articulate now. I think I wanted to make the arrow argument available to the user, but it failed.
geom_progression <- function(...){
stat_progression(arrow = arrow(ends = "last", length = unit(.1, "in")),...)
}
tibble::tribble(~event, ~date,
"Announcement", 0,
"deadline", 3,
"extended\ndeadline", 5) |>
ggplot() +
aes(x = date, y = "Conf") +
geom_progression() +
geom_point() +
geom_text(aes(label = event), vjust = 0)
# And w/ stackoverflow example.
# https://stackoverflow.com/questions/70249589/how-to-add-multiple-arrows-to-a-path-according-to-line-direction-using-ggplot2
data.frame(long = c(0.596, 0.641, 0.695, 0.741, 0.788, 0.837,
0.887, 0.937, 0.993, 0.984, 0.934, 0.886,
0.838, 0.778, 0.738, 0.681, 0.642, 0.593),
lat = c(23.630, 24.085, 24.643, 25.067, 25.491, 25.899,
26.305, 26.670, 27.049, 27.025, 26.836, 26.636,
26.429, 26.152, 25.965, 25.664, 25.442, 24.510)) %>%
ggplot() +
aes(x = long, y = lat) +
geom_progression()
```
# spatial 'status quo' of ggplot2 extension cookbook
```{r}
northcarolina_county_reference0 <-
sf::st_read(system.file("shape/nc.shp", package="sf")) |>
dplyr::rename(county_name = NAME,
fips = FIPS) |>
dplyr::select(county_name, fips, geometry)
return_st_bbox_df <- function(sf_df){
bb <- sf::st_bbox(sf_df)
data.frame(xmin = bb[1], ymin = bb[2],
xmax = bb[3], ymax = bb[4])
}
add_xy_coords <- function(geo_df){
geo_df |>
dplyr::pull(geometry) |>
sf::st_zm() |>
sf::st_point_on_surface() ->
points_sf
the_coords <- do.call(rbind, sf::st_geometry(points_sf)) %>%
tibble::as_tibble() %>% setNames(c("x","y"))
cbind(geo_df, the_coords)
}
northcarolina_county_reference <- northcarolina_county_reference0 |>
dplyr::mutate(bb =
purrr::map(geometry,
return_st_bbox_df)) |>
tidyr::unnest(bb) |>
data.frame() |>
add_xy_coords()
compute_panel_county <- function(data, scales){
data |>
dplyr::inner_join(northcarolina_county_reference)
}
StatNcfips <- ggplot2::ggproto(`_class` = "StatNcfips",
`_inherit` = ggplot2::Stat,
required_aes = "fips|county_name",
compute_panel = compute_panel_county)
stat_county <- 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 = StatNcfips, # 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)
)
}
ggnorthcarolina::northcarolina_county_flat |>
ggplot() +
aes(fips = fips) +
stat_county(crs = "NAD83") +
aes(fill = SID74/BIR74) +
stat_county(geom = 'text',
aes(label = SID74),
color = "oldlace")
```
# define_layer_sf_temp build. Let's go!
```{r}
northcarolina_county_reference0 <-
sf::st_read(system.file("shape/nc.shp", package="sf")) |>
dplyr::rename(county_name = NAME,
fips = FIPS) |>
dplyr::select(county_name, fips, geometry)
```
```{r define_layer_sf_temp}
return_st_bbox_df <- function(sf_df){
bb <- sf::st_bbox(sf_df)
data.frame(xmin = bb[1], ymin = bb[2],
xmax = bb[3], ymax = bb[4])
}
add_xy_coords <- function(geo_df){
geo_df |>
dplyr::pull(geometry) |>
sf::st_zm() |>
sf::st_point_on_surface() ->
points_sf
the_coords <- do.call(rbind, sf::st_geometry(points_sf)) %>%
tibble::as_tibble() %>% setNames(c("x","y"))
cbind(geo_df, the_coords)
}
define_layer_sf_temp <- function(ref_df,
geom = NULL,
geom_default = ggplot2::GeomSf,
required_aes,
default_aes = ggplot2::aes(),
stamp = FALSE,
keep_default = NULL,
drop_default = NULL,
id_col_name = NULL, # for keep drop
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE,
crs = sf::st_crs(ref_df),
...){
ref_df_w_bb_and_xy_centers <-
ref_df |>
dplyr::mutate(bb =
purrr::map(geometry,
return_st_bbox_df)) |>
tidyr::unnest(bb) |>
data.frame() |>
add_xy_coords()
if(is.null(id_col_name)){id_col_name <- 1}
ref_df_w_bb_and_xy_centers$id_col <- ref_df[,id_col_name]
compute_panel_geo <- function(data, scales, keep_id = keep_default, drop_id = drop_default){
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)) }
if(!stamp){data <- dplyr::inner_join(data, ref_df_w_bb_and_xy_centers)}
if( stamp){data <- ref_df_w_bb_and_xy_centers }
data
}
StatTempsf <- ggplot2::ggproto(`_class` = "StatTempsf",
`_inherit` = ggplot2::Stat,
required_aes = required_aes,
compute_panel = compute_panel_geo,
default_aes = default_aes)
if(is.null(geom)){geom <- geom_default}
c(ggplot2::layer_sf(
stat = StatTempsf, # 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)
)
}
```
### Try it out
```{r}
sf::st_read(system.file("shape/nc.shp", package="sf")) |>
dplyr::rename(county_name = NAME,
fips = FIPS) |>
dplyr::select(county_name, fips, geometry) ->
nc_reference
geom_county2 <- function(...){
define_layer_sf_temp(ref_df = nc_reference,
required_aes = "fips|county_name",
default_aes = aes(label = after_stat(county_name)),
...)
}
ggnorthcarolina::northcarolina_county_flat |>
ggplot() +
aes(fips = fips) +
geom_county2() +
aes(fill = SID74/BIR74) +
geom_county2(geom = "text",
color = "pink")
last_plot() +
aes(label = BIR74)
last_plot() +
geom_county2(geom = "text",
mapping = aes(label = BIR74), check_overlap = T) #oh!
```
```{r create_layer_sf_temp}
create_layer_sf_temp <- function(ref_df,
fun_name ="geom_my_sf",
required_aes,
default_aes = ggplot2::aes(),
geom_default = ggplot2::GeomSf,
keep_default = NULL,
drop_default = NULL,
...){
assign(x = fun_name,
value = function(...){
define_layer_sf_temp(ref_df = ref_df,
required_aes = required_aes,
geom_default = geom_default,
default_aes = default_aes,
keep = keep_default,
drop = drop_default,
...) },
pos = 1
)
}
```
```{r}
sf::st_read(system.file("shape/nc.shp", package="sf")) |>
dplyr::rename(county_name = NAME,
fips = FIPS) |>
dplyr::select(county_name, fips, geometry) ->
my_ref_data
create_layer_sf_temp(ref_df = my_ref_data,
fun_name = "geom_county",
required_aes = "county_name|fips",
default_aes = ggplot2::aes(label = after_stat(county_name)))
ggnorthcarolina::northcarolina_county_flat |>
ggplot() +
aes(fips = fips) +
geom_county() +
aes(fill = SID74/BIR74) +
geom_county(geom = "text",
mapping = aes(label = BIR74)) # oh ho!!
ggnorthcarolina::northcarolina_county_flat |>
ggplot() +
aes(fips = fips) +
geom_county(stamp = T)
```
```{r}
library(tmap)
data(NLD_prov)
data("NLD_muni")
# create geo reference data frame
NLD_prov |>
dplyr::select(prov_code = code, prov_name = name, geometry) ->
netherlands_prov_ref_geo
NLD_muni |>
dplyr::select(muni_code = code, muni_name = name, geometry) ->
netherlands_muni_ref_geo
# create new geom_* function
create_layer_sf_temp(ref_df = netherlands_prov_ref_geo,
fun_name = "geom_nl_prov",
required_aes = "prov_name|prov_code",
default_aes = aes(label = after_stat(prov_name)))
create_layer_sf_temp(ref_df = netherlands_muni_ref_geo,
fun_name = "geom_nl_muni",
required_aes = "muni_name|muni_code",
default_aes = aes(label = after_stat(muni_name)))
# Make a map
NLD_prov |>
sf::st_drop_geometry() |>
ggplot() +
aes(prov_code = code) +
geom_nl_prov() +
geom_nl_prov(geom = "text") +
aes(fill = pop_15_24)
NLD_muni |>
sf::st_drop_geometry() |>
ggplot() +
aes(muni_code = code) +
geom_nl_muni() +
geom_nl_muni(geom = "text",
data = . %>% filter(population > 100000 ),
check_overlap = T,
color = "gray80",
face = "bold") +
aes(fill = pop_15_24) +
scale_fill_viridis_c() +
ggstamp::theme_void_fill("grey")
```
```{r}
rnaturalearth::ne_countries(
scale = "medium", returnclass = "sf") %>%
select(name, continent, geometry, iso_a3) %>%
rename(country_name = name,
iso3c = iso_a3
) ->
ref_data
create_layer_sf_temp(ref_df = ref_data,
fun_name = "geom_country",
required_aes = "country_name|iso3c")
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(country_name = country) +
geom_country() +
geom_country(geom = "text",
mapping = aes(label = country),
check_overlap =T)
library(tidyverse)
heritage_wide <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-02-06/heritage.csv')
heritage <- heritage_wide |>
pivot_longer(-1, names_to = "year", values_to = "count") |>
mutate(year = as.numeric(year)) |>
mutate(country = as.factor(country))
heritage |>
ggplot() +
aes(country_name = country) +
geom_country() +
aes(fill = count) +
facet_grid(~year) +
geom_country(geom = "text", mapping = aes(label = paste(country, count, sep = "\n")))
```
# Part II. Packaging and documentation 🚧 ✅
## Phase 1. Minimal working package
- Bit A. Created files for package archetecture, running `devtools::create(".")` in interactive session. ✅
- Bit B. Added roxygen skeleton? 🚧
- Bit C. Managed dependencies ? 🚧
```{r, eval = F}
usethis::use_package("ggplot2")
```
- Bit D. Moved functions R folder? ✅
```{r}
readme2pkg::chunk_to_r("define_layer_temp")
readme2pkg::chunk_to_r("create_layer_temp")
readme2pkg::chunk_to_r("define_layer_sf_temp")
readme2pkg::chunk_to_r("create_layer_sf_temp")
```
- Run `devtools::check()` and addressed errors. 🚧
```{r, results='hide', error=T, eval = F}
devtools::check(pkg = ".")
```
- ✅
```{r, eval = F}
devtools::build()
```
- Bit G. Write and test traditional README that uses built package. 🚧 ✅
Install package with:
```
remotes::installgithub("EvaMaeRey/readme2pkg.template")
```
Then...
```{r, eval = T}
library(ggtemp) ##<< change to your package name here
compute_panel_circle <- function(data, scales, n = 15){
data |>
mutate(group = row_number()) |>
crossing(tibble(z = 0:n)) |>
mutate(around = 2*pi*z/max(z)) |>
mutate(x = x0 + cos(around)*r,
y = y0 + sin(around)*r)
}
geom_circle_points <- function(...){
ggtemp:::define_layer_temp(
required_aes = c("x0", "y0", "r"),
compute_panel = compute_panel_circle,
geom_default =ggplot2::GeomPoint,
...)
}
library(ggplot2)
ggplot(cars) +
aes(x0 = speed, y0 = dist, r = 1) +
geom_circle_points()
```
- Bit H. Chosen a license? 🚧 ✅
```{r}
usethis::use_mit_license()
```
- Bit I. Add lifecycle badge (experimental)
```{r}
usethis::use_lifecycle_badge("experimental")
```
## Phase 2: Listen & iterate 🚧 ✅
Try to get feedback from experts on API, implementation, default decisions. Is there already work that solves this problem?
## Phase 3: Let things settle
### Bit A. Settle on examples. Put them in the roxygen skeleton and readme. 🚧 ✅
### Bit B. Written formal tests of functions and save to test that folders 🚧 ✅
That would look like this...
```{r test_calc_times_two_works, eval = F}
library(testthat)
test_that("calc times 2 works", {
expect_equal(times_two(4), 8)
expect_equal(times_two(5), 10)
})
```
```{r, eval = F}
readme2pkg::chunk_to_tests_testthat("test_calc_times_two_works")
```
### Bit C. Added a description and author information in the DESCRIPTION file 🚧 ✅
### Bit D. Addressed *all* notes, warnings and errors. 🚧 ✅
## Phase 4. Promote to wider audience...
### Bit A. Package website built? 🚧 ✅
### Bit B. Package website deployed? 🚧 ✅
## Phase 5: Harden/commit
### Submit to CRAN? 🚧 ✅
# Appendix: Reports, Environment
## Description file extract
```{r}
# readlines(Description)
```
## Environment
Here I just want to print the packages and the versions
```{r}
all <- sessionInfo() |> print() |> capture.output()
all[11:17]
```
## `devtools::check()` report
```{r, error = T, results="hide", warning=F}
devtools::check(pkg = ".")
```
## Non-developer introduction to package (and test of installed package)
The goal of the {xxx} package
To install the dev version use the following:
```
remotes::install_github("owner/repo") #
```
## Example using package
```{r, eval = F}
library(mypackage)
myfunction(mtcars)
```