Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/evamaerey/ggcallout
https://github.com/evamaerey/ggcallout
Last synced: 11 days ago
JSON representation
- Host: GitHub
- URL: https://github.com/evamaerey/ggcallout
- Owner: EvaMaeRey
- Created: 2024-04-13T03:59:40.000Z (7 months ago)
- Default Branch: main
- Last Pushed: 2024-04-13T18:08:14.000Z (7 months ago)
- Last Synced: 2024-04-13T18:12:04.821Z (7 months ago)
- Language: R
- Size: 91.8 KB
- Stars: 1
- Watchers: 1
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.Rmd
Awesome Lists containing this project
README
---
output:
github_document:
toc: TRUE
toc_depth: 2
---
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval = T
)
```
# Part 0. Proposal
Proposing the {ggcallout} package! 🦄
The goal of {ggcallout} is to make callouts easier. Maybe just a proof of concept and we'll just look at scatterplots to start.
Without the package, we live in the effort-ful world that follows 🏋: It's so effortful, I'm not gonna save filling this out for later...
```{r}
x <- 4
2*x
```
With the {ggcallout} package, we'll live in a different world (🦄 🦄 🦄) where the task is a snap 🫰:
Proposed API:
```
library(ggcallout)
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(gdpPercap, lifeExp, id = country) +
geom_point(color = "darkgray") +
# labels as 'Norway' with default link length and padding
geom_labellink(which_id = "Norway",
label_direction = -120) +
# label is specified by the user
geom_labellink(which_id = "Brazil",
label = "People want to\nknow about Brazil",
label_direction = -70,
link_prop = .2) +
```
# Part I. Work out functionality 🚧 ✅
Here is a function that will do some work...
```{r}
readme2pkg::chunk_to_r("StatLabellink")
```
```{r StatLabellink}
compute_labellink <- function(data, scales, label_direction = 180 + 45, link_prop = .1, prop_pointer_pad = .0175, hjust = NULL, vjust = NULL, which_index = NULL, which_id = NULL){
if(is.null(data$id)){data$id <- "hello world"}
if(is.null(which_index)){which_index <- which(data$id %in% which_id)}
data$default_label <- data$id
xmean <- mean(data$x)
ymean <- mean(data$y)
range_x <- diff(range(data$x))
range_y <- diff(range(data$y)) # look at range of plot?
xdir <- cos(pi*label_direction/180)
ydir <- sin(pi*label_direction/180)
xpush <- range_x * link_prop * xdir
ypush <- range_y * link_prop * ydir
xpointer_pad <- range_x * xdir * prop_pointer_pad
ypointer_pad <- range_y * ydir * prop_pointer_pad
more_x_than_y <- abs(xdir) > abs(ydir)
if(is.null(hjust)){hjust <- ifelse(more_x_than_y, sign(xdir) != 1, .5)}
if(is.null(vjust)){vjust <- ifelse(more_x_than_y, .5, sign(ydir) != 1)}
data |>
# dplyr::mutate(label_length = nchar(label)) |>
# dplyr::mutate(link_prop = ifelse(label_length > 10, .2, .1)) |>
dplyr::mutate(x = x + xpush) |>
dplyr::mutate(y = y + ypush) |>
dplyr::mutate(xend = .data$x - (xpush - xpointer_pad)) |>
dplyr::mutate(yend = .data$y - (ypush - ypointer_pad)) |>
dplyr::mutate(hjust = hjust) |>
dplyr::mutate(vjust = vjust) |>
dplyr::slice(which_index)
}
StatLabellink <- ggplot2::ggproto("Labellink",
ggplot2::Stat,
compute_panel = compute_labellink,
default_aes =
ggplot2::aes(label = ggplot2::after_stat(default_label)))
```
```{r}
compute_index <- function(data, scales){
data |>
mutate(index = row_number())
}
StatIndex <- ggplot2::ggproto("StatIndex",
ggplot2::Stat,
compute_panel = compute_index,
default_aes =
ggplot2::aes(label = ggplot2::after_stat(index)))
geom_index <- function(){
layer("label", "index", position = "identity",
params = list(label.size = NA, fill = NA, hjust = "inward",
vjust = "inward"))
}
```
```{r, eval = F}
library(tidyverse)
ggplot(cars, aes(speed, dist)) +
geom_point() +
layer("label", "index", position = "identity",
params = list(label.size = NA, fill = NA, hjust = 0,
vjust = 0))
```
## Try out compute function
```{r}
library(tidyverse)
gapminder::gapminder |>
filter(year == 2002) |>
select(id = country, x = lifeExp, y = gdpPercap) |>
compute_labellink(which_id = "Chile")
gapminder::gapminder |>
filter(year == 2002) |>
select(id = country, x = lifeExp, y = gdpPercap) |>
compute_labellink(which_index = 3)
gapminder::gapminder |>
filter(year == 2002) |>
select(x = lifeExp, y = gdpPercap) |>
compute_labellink(which_index = 3)
```
## Trying out Stat within plot
```{r}
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(id = country, x = lifeExp, y = gdpPercap) +
geom_point() +
layer("label", "labellink", position = "identity",
params = list(which_id = "Chile")) +
layer("segment", "labellink", position = "identity",
params = list(which_id = "Chile")) +
scale_x_log10()
ggplot(cars) +
aes(speed, dist) +
geom_point() +
layer("segment",
"labellink",
position = "identity",
# data = cars[23,],
params = list(which_index = 23, arrow =
arrow(ends = "last",
length = unit(.1, "inches"),
type = "closed"))) +
layer("label",
"labellink",
position = "identity",
# data = cars[23,],
params = list(which_index = 23,
label = "let me tell you about this guy" |> str_wrap(15),
alpha = 0,
lineheight = .8,
label.size = 0,
label.padding = unit(0.7, "lines"))) +
layer("point",
"labellink",
position = "identity",
# data = cars[23,],
params = list(which_index = 23,
color = "red"))
```
# Pass stat to user-facing function
```{r}
readme2pkg::chunk_to_r("geom_labellink")
```
```{r geom_labellink}
geom_labellink <- function( mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...){
list(
ggplot2::layer("segment",
"labellink",
position = position,
data = data,
mapping = mapping,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(arrow =
arrow(ends = "last",
length = unit(.1, "inches"),
type = "closed"), na.rm = na.rm,
...)),
ggplot2::layer("label",
"labellink",
position = position,
data = data,
mapping = mapping,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
alpha = 0,
lineheight = .8,
label.size = 0,
label.padding = unit(0.4, "lines"),
na.rm = na.rm,
...))
)
}
```
```{r geom_labellink_direction_helpers}
geom_labellink_north <- function(...) geom_labellink(label_direction = 90, ...)
geom_labellink_east <- function(...) geom_labellink(label_direction = 0, ...)
geom_labellink_south <- function(...) geom_labellink(label_direction = -90, ...)
geom_labellink_west <- function(...) geom_labellink(label_direction = 180, ...)
geom_labellink_ne <- function(...) geom_labellink(label_direction = 45, ...)
geom_labellink_se <- function(...) geom_labellink(label_direction = -45, ...)
geom_labellink_nw <- function(...) geom_labellink(label_direction = 135, ...)
geom_labellink_sw <- function(...) geom_labellink(label_direction = -135, ...)
geom_labellink_nee <- function(...) geom_labellink(label_direction = 45/2, ...)
geom_labellink_nne <- function(...) geom_labellink(label_direction = 45/2 + 45, ...)
geom_labellink_nnw <- function(...) geom_labellink(label_direction = 45/2 + 90, ...)
geom_labellink_nww <- function(...) geom_labellink(label_direction = 45/2 + 135, ...)
geom_labellink_see <- function(...) geom_labellink(label_direction = -45/2, ...)
geom_labellink_sse <- function(...) geom_labellink(label_direction = -45/2 - 45, ...)
geom_labellink_ssw <- function(...) geom_labellink(label_direction = -45/2 - 90, ...)
geom_labellink_sww <- function(...) geom_labellink(label_direction = -45/2 - 135, ...)
```
```{r}
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(x = gdpPercap, y = lifeExp, id = country) +
geom_point(color = "darkgrey") +
geom_labellink(which_id = "Chile",
label_direction = 45) +
geom_labellink(which_id = "Brazil",
label_direction = -65,
label = "Brazil is a pretty\n interesting case")
last_plot() +
scale_x_log10()
last_plot() %+%
(gapminder::gapminder |>
filter(year == 2002) |>
filter(gdpPercap > 3000))
chickwts |>
ggplot() +
aes(weight, weight) +
geom_point() +
geom_labellink(which_index = 2)
chickwts |>
ggplot() +
aes(weight, feed, id = weight) +
geom_point() +
geom_labellink(which_index = 4,
label_direction = -10,
label = "The chicks fed horsebeans had a lower than average weight" |> str_wrap(20))
pressure |>
ggplot() +
aes(temperature, pressure, id = temperature) +
geom_point() +
geom_path() +
geom_labellink(which_id = 20,
aes(label = "At a low temp of 20\n degrees pressure is low"),
label_direction = 70) +
geom_labellink(which_id = 300,
label = "At 300 degress,\npressure is building",
label_direction = 160) +
geom_labellink(which_index = nrow(pressure),
label = "At the highest temp in the study, we're\nin a high pressure situation") +
ggstamp::stamp_label(x = 80, y = 425,
label = "You may have heard of the pressure dataset. But did you know these facinating details?" |> str_wrap(20))
airquality |>
remove_missing() |>
ggplot() +
aes(Temp, Ozone, id = Temp) +
geom_point() +
geom_labellink(which_index = 5,
label_direction = 100,
hjust = .5,
link_prop = .2,
label = "Here's a relatively a low temperature observation" |> str_wrap(20))
datasets::anscombe |>
ggplot() +
aes(x = x4, y = y4) +
geom_point() +
# geom_index() +
geom_labellink(which_index = 8,
label = "This is the high-leverage observation in Anscombe's #4" |>
str_wrap(18),
label_direction = -170,
link_prop = .25)
```
```{r}
anscombe |>
ggplot() +
aes(x1, y1) +
geom_point() +
geom_labellink(which_index = 2,
label = "This is an observation in Anscombe's first dataset" |> str_wrap(15),
link_prop = .2,
label_direction = 120
)
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(gdpPercap, lifeExp, id = country) +
geom_point() +
facet_wrap(~continent) +
geom_labellink(which_id = "Chile",
label_direction = -45,
link_prop = .5)
mpg |>
ggplot() +
aes(cty, hwy) +
geom_point(aes(color = fl), alpha = .7) +
geom_labellink(which_index = 50,
label = "A point represents a single make and model in the mpg dataset: 'Fuel economy data from 1999 to 2008 for 38 popular models of cars'" |> str_wrap(15),
label_direction = 110,
link_prop = .2) +
geom_labellink(which_id = "c",
aes(id = fl),
label_direction = 120,
label = "fuel type is c") +
geom_labellink(which_id = c("d","e") ,
aes(id = fl),
label_direction = -45)
```
```{r}
mtcars |>
rownames_to_column() |>
mutate(make = factor(rowname)) |>
ggplot() +
aes(x = wt, y = mpg, id = make) +
geom_point() +
geom_index()
geom_labellink(which_id = "Mazda RX4",
label_direction = 85,
link_prop = .2)
mtcars |>
rownames_to_column() |>
mutate(make = factor(rowname)) |>
ggplot2::remove_missing() |>
ggplot() +
aes(x = wt, y = mpg, id = make ) +
geom_point() +
# geom_index()
geom_labellink(which_index = 18,
label = "The Fiat 128 has great milage compared to other makes in the mtcars dataset" |> str_wrap(25),
label_direction = -30) +
geom_labellink(which_index = 15,
label = "The Cadillac Fleetwood had pretty terrible milage" |> str_wrap(12),
label_direction = 130,
link_prop = .2)
mtcars |>
rownames_to_column() |>
mutate(rowname = factor(rowname)) |>
select(x = wt, y = mpg, id = rowname) |>
compute_labellink(which_id = "Mazda RX4")
gapminder::gapminder |>
filter(year == 2002) |>
select(x = gdpPercap, y = lifeExp, id = country) |>
compute_labellink(which_id = "Chile")
```
```{r}
nhl_player_births <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-01-09/nhl_player_births.csv')
set.seed(1245)
nhl_player_births |>
mutate(birth_date_2020 = birth_date %>% str_replace("....", "2000") %>%
as_date()) |>
mutate(first_last = paste(first_name, last_name)) |>
arrange(birth_date) %>%
ggplot() +
aes(x = birth_date_2020,
y = birth_year) +
geom_point(color = "cadetblue", alpha = .25) +
# geom_index() +
geom_labellink(which_index = 1,
label = "Jack Lviolette has the earliest birthday in the dataset: July 27, 1879" |> str_wrap(30),
label_direction = 60,
link_prop = .3,
color = "grey10") +
geom_labellink(which_index = nrow(nhl_player_births),
label = "Connor Bedard has the most recent birthday in the dataset: July 17, 2005" |> str_wrap(25),
link_prop = .2,
label_direction = -100,
color = "grey10")
ggwipe::last_plot_wipe(index = 2) +
ggpointdensity::geom_pointdensity(alpha = .5) +
scale_color_viridis_c()
```
```{r}
outer_space_objects <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-04-23/outer_space_objects.csv')
```
```{r}
space_objects_title <- "Astronomical growth: The number of space objects has grown exponentially
Here we see growth by the top four object-introducing entities
which are the **United States**, **Russia**, **China**, and the **United Kingdom**"
outer_space_objects %>%
filter(Entity != "World") %>%
mutate(EntityLump = fct_lump_n(f = Entity,
w = num_objects, n = 4,
other_level = "Other")) %>%
mutate(entity_year = paste(Entity, Year, sep = "\n")) %>%
filter(num_objects != 0) %>%
filter(EntityLump != "Other") %>%
ggplot() +
aes(Year, num_objects, fill = EntityLump) +
geom_line(aes(group = Entity), color = "gray") +
geom_point(data = . %>% filter(EntityLump != "Other"),
shape = 21, size = 4, color = "white", alpha = .8) +
scale_y_log10(breaks = c(1,10, 100, 1000),
labels = c("1\nobject", "10", "100", "1000\nobjects")) +
labs(y = NULL, x = NULL) +
labs(title = space_objects_title)
last_plot() +
theme_minimal() +
theme(title = ggtext::element_markdown()) +
scale_fill_viridis_d(option = "viridis", end = .8) +
theme(title = ggtext::element_markdown()) +
theme(panel.grid.major.x = element_blank()) +
theme(panel.grid.minor = element_blank()) +
theme(plot.title.position = "plot") +
ggstamp::stamp_text(x = 1990, y = 75,
label = "#tidytuesday viz\nfor educational\n purposes only",
alpha = .1, size = 18, angle = 20) +
labs(caption = "Data: from #tidytuesday project 2024-04-23/outer_space_objects.csv Accessed 2024-04-26")
ggtextExtra:::use_fill_scale_in_title_words(last_plot(), i = 2) +
guides(fill = "none")
```
```{r}
russia1957lab <- "The USSR launched two objects into space in 1957"
us2023lab <- "2166 objects were launched from the US in 2023"
last_plot() +
geom_line(aes(group = Entity), linewidth = .05) +
aes(id = entity_year) +
geom_labellink_north(which_id = "Russia\n1957",
label = russia1957lab |> str_wrap(15),
link_prop = .65, linetype = "dashed") +
geom_labellink_see(which_id = "United States\n2023",
label = us2023lab |> str_wrap(15),
link_prop = .15) +
geom_labellink_se(which_id = "China\n2023",
link_prop = .1) +
geom_labellink_se(which_id = "Russia\n2023",
link_prop = .1) +
geom_labellink_ne(which_id = "United Kingdom\n2023",
label = "UK\n2023",
link_prop = .1) +
geom_labellink_north(which_id = "Russian\n1985",
label = "USSR",
link_prop = .1) +
geom_labellink_south(which_id = "United States\n1974",
label = "USA",
link_prop = .07) +
geom_labellink_south(which_id = "United Kingdom\n2011",
label = "UK",
link_prop = .08) +
geom_labellink_nw(which_id = "China\n1997",
label = "China",
link_prop = .07) +
annotate(alpha = 0,
x = c(1945, 2060),
y = 1,
geom = GeomPoint) +
theme(title = ggtext::element_markdown()) +
theme(panel.grid.major.x = element_blank()) +
theme(panel.grid.minor = element_blank()) +
theme(plot.title.position = "plot") +
labs(y = NULL, x = NULL) +
theme(title = ggtext::element_markdown()) +
guides(fill = "none") +
guides(alpha = "none") +
NULL
```
```{r, fig.width=8, fig.height=6}
ggchalkboard:::geoms_chalk_on(chalk_color = "grey20")
last_plot()
```
```{r}
StatSum$compute_panel
nhl_player_births |>
mutate(birth_date2020 = str_replace(birth_date, "....", "2020") %>% as.Date()) |>
filter(birth_year >= 1970, birth_year <= 2000) |>
ggplot() +
aes(x = month(birth_date, label = T),
y = year(birth_date),
size = NULL) +
layer(stat = StatSum, geom = GeomTile, position = "identity") +
aes(fill = after_stat(n)) +
aes(label = after_stat(n)) +
layer(stat = StatSum, geom = GeomText, position = "identity",
params = list(color = "gray")) +
scale_fill_viridis_c()
```
# Part II. Packaging and documentation 🚧 ✅
## Phase 1. Minimal working package
### Bit A. Created package archetecture, running `devtools::create(".")` in interactive session. 🚧 ✅
```{r, eval = F}
devtools::create(".") # Bit 1. 1X
### Bit 2a: dependencies to functions using '::' syntax to pkg functions
usethis::use_package("ggplot2") # Bit 2b: document dependencies
usethis::use_package("dplyr")
# Bit 3: send code chunk with function to R folder
devtools::check(pkg = ".") # Bit 4: check that package is minimally viable
devtools::install(pkg = ".", upgrade = "never") # Bit 5: install package locally
usethis::use_lifecycle_badge("experimental") # Bit 6: add lifecycle badge
# Bit 7 (below): Write traditional readme
# Bit 8: Compile readme
# Bit 9: Push to github
# Bit 10: listen and iterate
```
### Bit 7. Write traditional README that uses built package (also serves as a test of build). 🚧 ✅
The goal of the {ggcallout} package is to ...
Install package with:
```
remotes::install_github("EvaMaeRey/ggcallout")
```
Once functions are exported you can remove go to two colons, and when things are are really finalized, then go without colons (and rearrange your readme...)
```{r, eval = T}
library(tidyverse)
library(ggcallout) ##<< change to your package name here
gapminder::gapminder |>
filter(year == 2002) |>
ggplot() +
aes(x = gdpPercap, y = lifeExp, id = country) +
geom_point(color = "darkgrey") +
ggcallout:::geom_labellink(which_id = "Chile",
label_direction = 45) +
ggcallout:::geom_labellink(which_id = "Brazil",
label_direction = -65,
label = "Brazil is a pretty\n interesting case")
last_plot() +
scale_x_log10()
```
## Phase 3: Settling and testing 🚧 ✅
### Bit A. Added a description and author information in the [DESCRIPTION file](https://r-pkgs.org/description.html) 🚧 ✅
### Bit B. Added [roxygen skeleton](https://r-pkgs.org/man.html)? 🚧 ✅
### Bit C. Chosen a [license](https://r-pkgs.org/license.html)? 🚧 ✅
```{r, eval = F}
usethis::use_mit_license()
```
### Bit D. Settle on [examples](https://r-pkgs.org/man.html#sec-man-examples). Put them in the roxygen skeleton and readme. 🚧 ✅
### Bit E. Written formal [tests](https://r-pkgs.org/testing-basics.html) 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 F. Check again. Addressed notes, warnings and errors. 🚧 ✅
```{r, eval = F}
devtools::check(pkg = ".")
```
## Phase 4. Promote to wider audience... 🚧 ✅
### Bit A. Package website built? 🚧 ✅
### Bit B. Package website deployed? 🚧 ✅
## Phase 5: Harden/commit: Submit to CRAN/RUniverse 🚧 ✅
# Appendix: Reports, Environment
## Description file complete? 🚧 ✅
```{r, eval = F}
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, eval=F, error = T, results="hide", warning=F}
devtools::check(pkg = ".")
```
## Package directory file tree
```{r}
fs::dir_tree(recurse = T)
```