Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/evamaerey/ggcirclepack
Experimental; write up for ggplot2 extenders meet up
https://github.com/evamaerey/ggcirclepack
Last synced: 11 days ago
JSON representation
Experimental; write up for ggplot2 extenders meet up
- Host: GitHub
- URL: https://github.com/evamaerey/ggcirclepack
- Owner: EvaMaeRey
- Created: 2022-04-27T19:23:33.000Z (over 2 years ago)
- Default Branch: main
- Last Pushed: 2024-07-05T21:26:34.000Z (4 months ago)
- Last Synced: 2024-07-06T02:23:19.666Z (4 months ago)
- Language: R
- Homepage: https://evamaerey.github.io/ggcirclepack/
- Size: 23.2 MB
- Stars: 12
- Watchers: 1
- Forks: 0
- Open Issues: 1
-
Metadata Files:
- Readme: README.Rmd
Awesome Lists containing this project
README
---
output:
github_document:
toc: TRUE
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
```
# ggcirclepack
circle pack is an experimental package that uses the {packcircles} package to handle circle packing computation.
### Note to the reader
Your feedback is on this work is greatly appreciated.
Beyond the descriptions of our work, we interject comments on our hesitations 🤔 and areas that need some work 🚧, for your consideration marked with emoji.
Your help and feedback would be greatly appreciated on any of the questions...
- Are functions named intuitively? *'According to IBM studies, intuitive variable naming contributes more to code readability than comments, or for that matter, any other factor' McConnell, S. Code complete*
- Do functions work as you expect?
- Is there rewriting that could make the code more concise?
- What tests should be performed?
# status quo *without* {ggcirclepack}: precomputation required to create two more data frames
```{r}
library(tidyverse)
gapminder::gapminder %>%
filter(continent == "Americas") %>%
filter(year == 2002) %>%
select(country, pop) %>%
mutate(id = row_number()) ->
df_w_id
packcircles::circleProgressiveLayout(df_w_id$pop,
sizetype = 'area') ->
x0y0radius
x0y0radius %>%
packcircles::circleLayoutVertices(npoints = 50) ->
circle_outlines
circle_outlines %>%
left_join(df_w_id) %>%
ggplot() +
aes(x = x, y = y) +
geom_polygon(colour = "black", alpha = 0.6) +
aes(group = id) +
aes(fill = pop) +
geom_text(data = cbind(df_w_id, x0y0radius),
aes(x, y, size = pop, label = country,
group = NULL, fill = NULL)) +
theme(legend.position = "none") +
coord_equal()
```
# Proposed UI
```{r example, out.width="33%", fig.show="hold", message=F, eval = F}
library(tidyverse)
library(ggcirclepack)
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country, area = pop) +
geom_circlepack() + # draws packed circles
geom_circlepack_text() + # labels at the center
coord_fixed(ratio = 1)
```
# Package functions
## geom_circlepack_text (center)
### Step 1. compute panel
```{r compute_panel_circlepack_center}
#' compute_panel_circlepack_center
#'
#' @return
#' @export
#'
#' @examples
compute_panel_circlepack_center <- function(data, scales, fun = sum){
# get aes names as they appear in the data
if(is.null(data$slice)){data$slice <- TRUE}
data %>%
dplyr::filter(.data$slice) ->
data
grp_cols <- c("id", "fill", "alpha",
"colour", "group", "linewidth",
"label", "size",
"linetype", "render")
# Thanks June! https://github.com/teunbrand/ggplot-extension-club/discussions/15
data %>%
group_by(group_by(pick(any_of(grp_cols)))) ->
data
if(is.null(data$area)){data <- mutate(data, area = 1)}
if(is.null(data$wt)){data$wt <- 1}
data %>%
summarize(area = fun(.data$area*.data$wt), .groups = 'drop') ->
data
data %>%
arrange(id) -> # this doesn't feel very principled; motivation is when you go from no fill to color, preserves circle position...
data
if(is.null(data$within)){data$within <- 1}
data %>%
group_by(.data$within) %>%
mutate(prop = .data$area/sum(.data$area)) %>%
mutate(percent = round(.data$prop*100)) ->
data
data %>%
pull(area) %>%
packcircles::circleProgressiveLayout(
sizetype = 'area') %>%
cbind(data) ->
data
if(!is.null(data$render)){
data %>%
filter(.data$render) ->
data
}
data
}
```
### Step 1.1 test compute
```{r}
gapminder::gapminder %>%
filter(continent == "Americas") %>%
filter(year == 2002) %>%
# input must have required aesthetic inputs as columns
select(area = pop, id = country) %>%
compute_panel_circlepack_center() %>%
head()
gapminder::gapminder %>%
filter(year == 2002) %>%
select(id = continent) %>%
compute_panel_circlepack_center()
gapminder::gapminder %>%
filter(year == 2002) %>%
mutate( render = country == "Argentina") %>%
select(id = continent, render) %>%
compute_panel_circlepack_center()
gapminder::gapminder %>%
# filter(year == 2002) %>%
mutate( render = country == "Argentina") %>%
select(id = continent, render, area = pop) %>%
compute_panel_circlepack_center(fun = mean)
```
### Step 2 and 3 ggproto and geom
```{r geom_circlepack_text}
StatCirclepackcenter <- ggplot2::ggproto(`_class` = "StatCirclepackcenter",
`_inherit` = ggplot2::Stat,
required_aes = c("id"),
compute_panel = compute_panel_circlepack_center,
default_aes = ggplot2::aes(group = after_stat(id),
size = after_stat(area),
label = after_stat(id))
)
#' Title
#'
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
stat_circlepack_center <- function(mapping = NULL, data = NULL,
geom = "text",
position = "identity", na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
geom = geom, # inherit other behavior
stat = StatCirclepackcenter, # proto object from Step 2
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
#' Title
#'
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
geom_circlepack_text <- stat_circlepack_center
```
### Step 4. test geom
```{r}
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country, area = pop) +
geom_circlepack_text(alpha = .5) +
coord_equal() +
labs(title = "gapminder 2002 countries")
last_plot() +
aes(render = pop > 20000000)
```
## geom_circlepack
### Step 1. compute_panel
```{r compute_panel_circlepack}
# Step 1
#' compute_panel_circlepack
#'
#' @param data
#' @param scales
#'
#' @return
#' @export
#'
#' @examples
compute_panel_circlepack <- function(data, scales, npoints = 50, fun = sum){
# get aes names as they appear in the data
if(is.null(data$slice)){data$slice <- TRUE}
data %>%
dplyr::filter(.data$slice) ->
data
grp_cols <- c("id", "fill", "alpha",
"colour", "group", "linewidth", "label", "size",
"linetype", "render")
# Thanks June! https://github.com/teunbrand/ggplot-extension-club/discussions/15
data %>%
group_by(group_by(pick(any_of(grp_cols)))) ->
data
if(is.null(data$area)){data$area <- 1}
if(is.null(data$wt)){data$wt <- 1}
data %>%
summarize(area = fun(.data$area*.data$wt), .groups = 'drop') ->
data
data %>%
arrange(id) -> # this doesn't feel very principled; motivation is when you go from no fill to color, preserves circle position...
data
if(is.null(data$within)){data$within <- 1}
data %>%
group_by(.data$within) %>%
mutate(prop = .data$area/sum(.data$area)) %>%
mutate(percent = round(.data$prop*100)) ->
data
data$id = 1:nrow(data)
data %>%
pull(area) %>%
packcircles::circleProgressiveLayout(
sizetype = 'area') %>%
packcircles::circleLayoutVertices(npoints = npoints) %>%
left_join(data, by = join_by(id))
}
```
### Step 1.1. test compute
```{r}
gapminder::gapminder %>%
filter(continent == "Americas") %>%
filter(year == 2002) %>%
# input must have required aesthetic inputs as columns
rename(id = country, area = pop) %>%
compute_panel_circlepack() %>%
head()
```
### Step 2 & 3 ggproto and geom
```{r geom_circlepack}
StatCirclepack <- ggplot2::ggproto(`_class` = "StatCirclepack",
`_inherit` = ggplot2::Stat,
required_aes = c("id"),
compute_panel = compute_panel_circlepack,
default_aes = ggplot2::aes(group = after_stat(id))
)
#' Title
#'
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
geom_circlepack <- function(mapping = NULL, data = NULL,
position = "identity", na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatCirclepack, # 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, ...)
)
}
```
### Step 4. test geom
```{r}
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country) +
geom_circlepack(alpha = .5) +
geom_circlepack_text() +
coord_equal() +
labs(title = "gapminder 2002 countries")
last_plot() +
aes(fill = continent) +
labs(title = "from 5 continents")
last_plot() +
aes(area = pop) +
geom_circlepack_text() +
labs(title = "with very different populations")
last_plot() +
facet_wrap(facets = vars(continent)) +
labs(title = "faceting")
last_plot() +
scale_size_continuous(range = c(0, 4)) +
theme(legend.position = "none") +
labs(title = "remove legends")
last_plot() +
aes(area = gdpPercap*pop) +
labs(title = "and very different GDPs")
last_plot() +
aes(area = gdpPercap) +
labs(title = "and per capita GDPs 2002")
last_plot() +
aes(slice = continent == "Europe") +
facet_null() +
aes(fill = after_stat(area)) +
aes(label = paste0(country, "\n$", round(gdpPercap)))
gapminder::gapminder %>%
filter(year == 2002,
continent == "Europe") %>%
ggplot() +
aes(id = country, area = pop*gdpPercap) +
geom_circlepack() +
geom_circlepack_text(vjust = 0, color = "grey75",
lineheight = .7) +
aes(label = str_wrap(country, 10)) +
coord_equal() +
scale_size(range = c(.5,4.5)) +
aes(slice = continent == "Europe") +
labs(title = "Percent of European Economy 2002") +
aes(fill = after_stat(area)) +
ggnewscale::new_scale(new_aes = "size") +
geom_circlepack_text(vjust = 1.2, color = "grey65",
aes(label = paste(after_stat(percent),
"percent"),
size = stage(after_stat = area,
after_scale = size*.85))) +
scale_size(range = c(.5, 3.5)) +
ggstamp::theme_void_fill("whitesmoke") +
theme(legend.position = "none") +
coord_equal()
pride_index <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-06-11/pride_index.csv')
comm_types <- c("large urban city",
"medium city",
"small city",
"small town",
"very small town",
"rural community")
pride_it <- pride_index %>%
# fix a typo
mutate(campus_location = str_replace(campus_location, "Swarrthmore", "Swarthmore")) %>%
mutate(community_type = fct_relevel(community_type, comm_types)) %>%
mutate(state = str_sub(campus_location, -2, -1)) %>%
mutate(campus_name = str_replace(campus_name, "University", "U"))
ggplot(pride_it) +
aes(id = campus_name) +
aes(area = students) +
aes(fill = rating == 5) +
geom_circlepack(linewidth = 0.2, color = "grey99") +
aes(label = str_wrap(after_stat(id), 10)) +
stat_circlepack_center(geom = GeomText,
lineheight = .8) +
scale_size(range = c(0,2)) +
aes(size = students*as.numeric(rating == 5)) + # freshly working
facet_wrap(facets = vars(community_type))
```
```{r}
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country) +
geom_circlepack(alpha = .5) +
coord_equal() +
aes(area = pop) +
geom_circlepack_text(aes(label = after_stat(
paste(id, "\n",
round(area/1000000, 1), "mil."))), lineheight = .8)
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = continent) +
geom_circlepack() +
geom_circlepack_text(alpha = .5) +
coord_equal() +
aes(fill = continent)
last_plot() +
aes(id = country)
last_plot() +
aes(area = pop)
last_plot() +
facet_wrap(~continent)
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country) +
geom_circlepack() +
geom_circlepack_text(alpha = .5) +
aes(area = pop) +
coord_equal() +
aes(fill = continent) +
aes(render = pop > 20000000)
prop_by <- function(...) {
area <- evalq(area, parent.frame())
if (length(list(...)) == 0) {
area / sum(area)
} else {
area / ave(area, ..., FUN = function(x) sum(abs(x)))
}
}
last_plot() +
aes(label = after_stat(scales::percent(prop_by("All"), 2)))
last_plot() +
aes(label = after_stat(scales::percent(prop_by(fill), 2)))
```
```{r}
# GeomTextRepel
gapminder::gapminder %>%
filter(year == 2002) %>%
ggplot() +
aes(id = country) +
geom_circlepack() +
layer(geom = ggrepel::GeomTextRepel,
stat = StatCirclepackcenter,
position = "identity") +
aes(area = pop) +
coord_equal() +
aes(fill = continent) +
aes(render = pop > 20000000)
```
```{r}
gapminder::gapminder %>%
ggplot() +
aes(id = country, area = pop) +
geom_circlepack(fun = mean) +
geom_circlepack_text(fun = mean) +
aes(label = paste(after_stat(id), "\n",
round(after_stat(area)/ 1000000), "million")) +
labs(title = "Average Population - Millions from 1952-2012") +
aes(fill = I("plum2")) +
coord_equal()
```
```{r}
mpg %>%
ggplot() +
aes(id = cyl, area = hwy) +
geom_circlepack(fun = mean) +
geom_circlepack_text(fun = mean, lineheight = .8) +
scale_size(range = c(4,5)) +
labs(title = "Average highway MPG by number of cyl") +
coord_equal() +
aes(label =
after_stat(paste0(id,"cyl\n",
round(area), "mpg"))) +
aes(fill = after_stat(area)) +
scale_fill_viridis_c(begin = .3, end = .7)
```
# Package the functions
```{r}
knitrExtra:::chunk_to_r(chunk_name = "compute_panel_circlepack")
knitrExtra:::chunk_to_r(chunk_name = "geom_circlepack")
knitrExtra:::chunk_to_r(chunk_name = "compute_panel_circlepack_center")
knitrExtra:::chunk_to_r(chunk_name = "geom_circlepack_text")
```
```{r, eval = F}
devtools::document()
devtools::check()
devtools::install(pkg = ".", upgrade = "never")
```
# Issues
Wish list for ggcirclepack:
## More computation under the hood for a count data case.
```{r, eval = F}
tidytitanic::tidy_titanic %>%
head()
```
```{r}
tidytitanic::tidy_titanic %>%
ggplot() +
aes(id = "all") +
geom_circlepack() +
geom_circlepack_text(aes(label = after_stat(area)), color = "gray50") +
coord_equal() +
labs(title = "Titanic Passengers")
layer_data(i = 2)
last_plot() +
aes(fill = sex) +
scale_size(range = c(3, 6))
last_plot() +
aes(alpha = survived) +
scale_alpha_discrete(range = c(.6,.9))
last_plot() +
facet_wrap(~class)
last_plot() +
facet_grid(age ~ class)
```