diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..4f56a79 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,46 @@ +on: + push: + branches: [main, dev] + pull_request: + branches: [main, dev] + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ runner.os }}/R/${{ matrix.config.r }}/actions + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-tinytex@v2 + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 diff --git a/.gitignore b/.gitignore index b06f4d0..dc6ae43 100644 --- a/.gitignore +++ b/.gitignore @@ -1,14 +1,26 @@ +# R files .Rproj.user .Rhistory .RData .Ruserdata +*.Rcheck +..Rcheck + /doc/ -xkcd_*.tar.gz +# ? /Meta/ + +# OSX .DS_Store -*.Rcheck -..Rcheck + + + +# render /.quarto/ **/*.quarto_ipynb -*.svg -docs/* \ No newline at end of file + +# pkgdown +docs/* +inst/* +!inst/_pkgdown.yml +vignettes/*.html diff --git a/DESCRIPTION b/DESCRIPTION index 4f2d303..29ba4f1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,7 +15,7 @@ Description: Provides custom geoms and themes to create charts and graphics in The package utilizes custom layers for jittered lines, segments, circles, and figures, and includes a theme that supports the necessary 'XKCD' font. License: MIT + file LICENSE -URL: https://github.com/ToledoEM/xkcd +URL: https://github.com/ToledoEM/xkcd, https://toledoem.github.io/xkcd BugReports: https://github.com/ToledoEM/xkcd/issues Depends: R (>= 4.0), ggplot2 (>= 3.4.0) Imports: diff --git a/README.md b/README.md index 4734688..25a06ab 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,11 @@ # xkcd +[![R-CMD-check](https://github.com/ToledoEM/xkcd/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ToledoEM/xkcd/actions/workflows/R-CMD-check.yaml) +[![CRAN status](https://www.r-pkg.org/badges/version/xkcd)](https://CRAN.R-project.org/package=xkcd) +[![CRAN downloads](https://cranlogs.r-pkg.org/badges/xkcd)](https://CRAN.R-project.org/package=xkcd) +[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -![](https://toledoem.github.io/img/xkcd_logo.png) +![xkcd package logo](https://toledoem.github.io/img/xkcd_logo.png) An R package to create hand-drawn (xkcd-style) plots and elements for ggplot2. @@ -92,7 +96,7 @@ try({ }, silent = TRUE) ``` -![test :-) ](vignettes/font_check.png) +![Font check example plot](man/figures/font_check.png) @@ -124,11 +128,15 @@ library(xkcd) This is opt-in to avoid surprising side-effects during package attach. -## Example Images +## Figure Pose Helper + +An interactive browser tool to design `xkcdman()` poses visually — drag limbs, adjust sliders, and copy the generated R code directly into your script. + +**[Open the Figure Pose Helper](https://toledoem.github.io/xkcd/stickfigurehelper/index.html)** -Below are three examples from the vignette: +## Example Images -![Font availability check (font_check)](vignettes/font_check.png) +Below are two examples from the vignette: ![Mother's Day example (mommy_plot)](vignettes/mommy_plot.png) @@ -160,12 +168,20 @@ devtools::build_vignettes() devtools::install_local() ``` -To render the vignette directly: +To render the vignettes directly: ```r rmarkdown::render("vignettes/xkcd-intro.Rmd") +rmarkdown::render("vignettes/xkcd-figure.Rmd") +rmarkdown::render("vignettes/xkcd-penguins.Rmd") ``` +Three vignettes are available: + +- **xkcd-intro** — Introduction and basic usage +- **xkcd-figure** — Drawing xkcd-style stick figures +- **xkcd-penguins** — Example with the Palmer Penguins dataset + ## Dependencies The package requires: diff --git a/_pkgdown.yml b/_pkgdown.yml deleted file mode 100644 index 9f7d2cd..0000000 --- a/_pkgdown.yml +++ /dev/null @@ -1,25 +0,0 @@ -url: https://toledoem.github.io/xkcd/ -destination: docs/ - -template: - bootstrap: 5 - includes: - in_header: | - - -navbar: - title: xkcd - left: - - text: Home - href: index.html - - text: Reference - href: reference/index.html - - text: Articles - href: articles/index.html - -articles: - - title: Vignettes - contents: - - xkcd-intro - diff --git a/build-site.sh b/build-site.sh new file mode 100755 index 0000000..32a65fc --- /dev/null +++ b/build-site.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash +set -euo pipefail + +# Build pkgdown site +Rscript -e "pkgdown::build_site()" + +# Copy the Figure Pose Helper into the rendered site +mkdir -p docs/stickfigurehelper +cp stickfigurehelper/index.html docs/stickfigurehelper/index.html + +echo "Site built. Helper available at docs/stickfigurehelper/index.html" diff --git a/inst/_pkgdown.yml b/inst/_pkgdown.yml index 57aa1b9..7c34149 100644 --- a/inst/_pkgdown.yml +++ b/inst/_pkgdown.yml @@ -7,6 +7,7 @@ template: in_header: | + navbar: title: xkcd left: @@ -16,8 +17,12 @@ navbar: href: reference/index.html - text: Articles href: articles/index.html + - text: Figure Pose Helper + href: stickfigurehelper/index.html + articles: - title: Vignettes contents: - xkcd-intro - + - xkcd-penguins + - xkcd-figure diff --git a/man/figures/font_check.png b/man/figures/font_check.png new file mode 100644 index 0000000..04e9033 Binary files /dev/null and b/man/figures/font_check.png differ diff --git a/stickfigurehelper/index.html b/stickfigurehelper/index.html new file mode 100644 index 0000000..78e8741 --- /dev/null +++ b/stickfigurehelper/index.html @@ -0,0 +1,1074 @@ + + + + + + + XKCD figure Pose Helper + + + +
+ xkcd Figure Pose Helper + drag segments · adjust sliders · copy R code +
+ +
+ + +
+
+ Drag any segment end-point to rotate + hover over figure +
+ +
+
+ + + + + + + diff --git a/vignettes/caritas_plot.png b/vignettes/caritas_plot.png index 25cf51a..cdb8e5d 100644 Binary files a/vignettes/caritas_plot.png and b/vignettes/caritas_plot.png differ diff --git a/vignettes/mommy_plot.png b/vignettes/mommy_plot.png index 4a1be54..4492c0e 100644 Binary files a/vignettes/mommy_plot.png and b/vignettes/mommy_plot.png differ diff --git a/vignettes/xkcd-figure.Rmd b/vignettes/xkcd-figure.Rmd new file mode 100644 index 0000000..90a8160 --- /dev/null +++ b/vignettes/xkcd-figure.Rmd @@ -0,0 +1,549 @@ +--- +title: "xkcd figure: The Stick Figure Guide" +author: "ToledoEM" +date: "`r Sys.Date()`" +output: + rmarkdown::html_vignette: + code_folding: hide +vignette: > + %\VignetteIndexEntry{xkcd figure: The Stick Figure Guide} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = TRUE, + message = FALSE, + warning = FALSE, + fig.width = 9, + fig.height = 6 +) +``` + +```{r libraries} +library(xkcd) +library(ggplot2) +``` + +## How xkcdman works + +The wild anatomy of a stick figure. + +`xkcdman()` draws a stick figure defined entirely by **angles** (in radians) +for each body segment. The figure has 8 parts: + +| Parameter | Body part | +|---|---| +| `angleofneck` | neck — connects head to top of spine | +| `angleofspine` | spine — main torso | +| `anglerighthumerus` | right upper arm | +| `anglerightradius` | right forearm | +| `anglelefthumerus` | left upper arm | +| `angleleftradius` | left forearm | +| `anglerightleg` | right leg | +| `angleleftleg` | left leg | + +Two other parameters control **size and proportion**: + +- `scale` — diameter of the head (all other segments are proportional to it). + Set it to roughly 10–15% of `diff(yrange)`. +- `ratioxy` — `diff(xrange) / diff(yrange)`. Corrects for axis scaling so + the figure is not stretched horizontally or vertically. + +All angles follow the standard mathematical convention: **0 = right, +π/2 = up, π = left, 3π/2 (or −π/2) = down**. + +--- + +## Part 1 — Anatomy diagram + +Each bone is drawn separately with its own color so you can see exactly what +each parameter controls. The helper below draws a single labeled figure with +colored segments. + +```{r anatomy, fig.width=7, fig.height=7} +# --- geometry helper: compute bone endpoints from the same formulas as xkcdman +make_figure <- function(x, y, scale, ratioxy, + angleofneck, angleofspine, + anglerighthumerus, anglerightradius, + anglelefthumerus, angleleftradius, + anglerightleg, angleleftleg) { + + dh <- scale # head diameter + ls <- dh # spine length + ll <- ls * 1.2 # leg length + lh <- ls * 0.6 # humerus length + lr <- ls * 0.5 # radius length + + # key joint positions + shoulder <- c(x, y) + + (dh / 2) * c(cos(angleofneck) * ratioxy, sin(angleofneck)) + hip <- shoulder + + ls * c(cos(angleofspine) * ratioxy, sin(angleofspine)) + end_rh <- shoulder + + lh * c(cos(anglerighthumerus) * ratioxy, sin(anglerighthumerus)) + end_lh <- shoulder + + lh * c(cos(anglelefthumerus) * ratioxy, sin(anglelefthumerus)) + + seg <- function(from, angle, dist) + data.frame( + x = from[1], + y = from[2], + xend = from[1] + dist * cos(angle) * ratioxy, + yend = from[2] + dist * sin(angle) + ) + + list( + head = data.frame(x = x, y = y, diameter = dh), + spine = seg(shoulder, angleofspine, ls), + rarm1 = seg(shoulder, anglerighthumerus, lh), + rarm2 = seg(end_rh, anglerightradius, lr), + larm1 = seg(shoulder, anglelefthumerus, lh), + larm2 = seg(end_lh, angleleftradius, lr), + rleg = seg(hip, anglerightleg, ll), + lleg = seg(hip, angleleftleg, ll) + ) +} + +# Standard upright pose — large figure centred in the plot +xrange <- c(0, 10) +yrange <- c(0, 10) +rxy <- diff(xrange) / diff(yrange) +sc <- 2.5 # bigger figure fills the space + +f <- make_figure( + x = 5, y = 7.2, scale = sc, ratioxy = rxy, + angleofneck = -pi / 2, + angleofspine = -pi / 2, + anglerighthumerus = -pi / 6, + anglerightradius = pi / 6, + anglelefthumerus = -pi / 2 - pi / 6, + angleleftradius = -pi / 6, + anglerightleg = 3 * pi / 2 - pi / 12, + angleleftleg = 3 * pi / 2 + pi / 12 +) + +colours <- c( + head = "#e41a1c", + spine = "#377eb8", + rarm1 = "#ff7f00", + rarm2 = "#ff7f00", + larm1 = "#4daf4a", + larm2 = "#4daf4a", + rleg = "#984ea3", + lleg = "#a65628" +) + +set.seed(99) +p_anat <- ggplot() + coord_fixed(xlim = xrange, ylim = yrange) + +# head +p_anat <- p_anat + + geom_xkcdpath(aes(x = x, y = y, diameter = diameter), + data = f$head, colour = colours["head"], + linewidth = 1.4, ratioxy = rxy, mask = FALSE) + +# bones +bones <- c("spine", "rarm1", "rarm2", "larm1", "larm2", "rleg", "lleg") +for (b in bones) { + p_anat <- p_anat + + geom_xkcdpath(aes(x = x, y = y, xend = xend, yend = yend), + data = f[[b]], colour = colours[b], + linewidth = 1.4, mask = FALSE, + xjitteramount = 0.02, yjitteramount = 0.02) +} + +library(ggrepel) + +# Label origins at bone midpoints, nudged outward from figure centre +labels_df <- data.frame( + x = c( + f$head$x, + (f$spine$x + f$spine$xend) / 2, + (f$rarm1$x + f$rarm1$xend) / 2, + (f$rarm2$x + f$rarm2$xend) / 2, + (f$larm1$x + f$larm1$xend) / 2, + (f$larm2$x + f$larm2$xend) / 2, + (f$rleg$x + f$rleg$xend) / 2, + (f$lleg$x + f$lleg$xend) / 2 + ), + y = c( + f$head$y, + (f$spine$y + f$spine$yend) / 2, + (f$rarm1$y + f$rarm1$yend) / 2, + (f$rarm2$y + f$rarm2$yend) / 2, + (f$larm1$y + f$larm1$yend) / 2, + (f$larm2$y + f$larm2$yend) / 2, + (f$rleg$y + f$rleg$yend) / 2, + (f$lleg$y + f$lleg$yend) / 2 + ), + label = c("head / scale", "angleofspine", + "anglerighthumerus", "anglerightradius", + "anglelefthumerus", "angleleftradius", + "anglerightleg", "angleleftleg"), + col = unname(colours[c("head","spine","rarm1","rarm2","larm1","larm2","rleg","lleg")]), + # nudge labels away from figure: right side +x, left side -x, head up + nx = c( 2.0, 0.3, 2.5, 2.8, -2.5, -2.8, -2.0, 2.0), + ny = c( 1.2, 0, 0.4, -0.5, 0.4, -0.5, -0.5, -0.8) +) + +p_anat <- p_anat + + geom_text_repel( + aes(x = x, y = y, label = label, colour = col), + data = labels_df, + nudge_x = labels_df$nx, + nudge_y = labels_df$ny, + family = "xkcd", + size = 4, + box.padding = unit(0.1, "lines"), + point.padding = unit(0.1, "lines"), + force = 1, + min.segment.length = 0.3, + segment.size = 0.4, + segment.colour = "grey50", + seed = 42, + show.legend = FALSE + ) + + scale_colour_identity() + +p_anat <- p_anat + + annotate("text", x = 5, y = 9.3, + label = "xkcdman anatomy", family = "xkcd", size = 6) + + annotate("text", x = 5, y = 8.9, + label = "angleofneck connects head to shoulder", + family = "xkcd", size = 3, colour = "grey40") + + theme_xkcd() + + theme(axis.text = element_blank(), axis.ticks = element_blank(), + axis.title = element_blank()) + +p_anat +``` + +--- + +## Part 2 — Pose gallery + +Six figures in a faceted layout, each with a different pose. Every figure +uses the same helper so we only specify the angles that change. + +```{r poses, fig.width = 11, fig.height = 8} +# Helper: return list(segs = df, head = df) for one pose +pose_segments <- function(pose_name, x, y, scale, ratioxy, + angleofneck, angleofspine, + anglerighthumerus, anglerightradius, + anglelefthumerus, angleleftradius, + anglerightleg, angleleftleg) { + + f <- make_figure(x, y, scale, ratioxy, + angleofneck, angleofspine, + anglerighthumerus, anglerightradius, + anglelefthumerus, angleleftradius, + anglerightleg, angleleftleg) + + segs <- do.call(rbind, lapply( + c("spine","rarm1","rarm2","larm1","larm2","rleg","lleg"), + function(b) { d <- f[[b]]; d$part <- b; d } + )) + segs$pose <- pose_name + + head_df <- data.frame(x = f$head$x, y = f$head$y, + diameter = f$head$diameter, + xend = NA_real_, yend = NA_real_, + part = "head", pose = pose_name) + + list(segs = segs, head = head_df) +} + +# Helper: vary one angle across values, return list(segs=df, heads=df) +vary_angle <- function(param, values, labels) { + all_segs <- NULL + all_heads <- NULL + for (i in seq_along(values)) { + args <- neutral + args[[param]] <- values[i] + r <- pose_segments( + pose_name = labels[i], + x = 5, y = 7.2, scale = 1.4, ratioxy = 1, + angleofneck = args$angleofneck, + angleofspine = args$angleofspine, + anglerighthumerus = args$anglerighthumerus, + anglerightradius = args$anglerightradius, + anglelefthumerus = args$anglelefthumerus, + angleleftradius = args$angleleftradius, + anglerightleg = args$anglerightleg, + angleleftleg = args$angleleftleg + ) + all_segs <- rbind(all_segs, r$segs) + all_heads <- rbind(all_heads, r$head) + } + list(segs = all_segs, heads = all_heads) +} + +# Common geometry: square data space +xr <- c(0, 10); yr <- c(0, 10); rxy <- 1; sc <- 1.4 + +poses <- list( + # 1. Standing at rest + pose_segments("Standing", + x = 5, y = 7.2, scale = sc, ratioxy = rxy, + angleofneck = -pi/2, + angleofspine = -pi/2, + anglerighthumerus = -pi/6, + anglerightradius = pi/6, + anglelefthumerus = -pi/2 - pi/6, + angleleftradius = -pi/6, + anglerightleg = 3*pi/2 - pi/12, + angleleftleg = 3*pi/2 + pi/12), + + # 2. Arms raised (cheering) + pose_segments("Arms up", + x = 5, y = 7.2, scale = sc, ratioxy = rxy, + angleofneck = -pi/2, + angleofspine = -pi/2, + anglerighthumerus = pi/3, + anglerightradius = pi/2, + anglelefthumerus = pi - pi/3, + angleleftradius = pi/2, + anglerightleg = 3*pi/2 - pi/12, + angleleftleg = 3*pi/2 + pi/12), + + # 3. Walking (leaning forward, legs apart) + pose_segments("Walking", + x = 5, y = 7.4, scale = sc, ratioxy = rxy, + angleofneck = -pi/2 + pi/10, + angleofspine = -pi/2 + pi/10, + anglerighthumerus = pi/2 + pi/6, + anglerightradius = pi/2, + anglelefthumerus = -pi/6, + angleleftradius = 0, + anglerightleg = 3*pi/2 - pi/5, + angleleftleg = 3*pi/2 + pi/4), + + # 4. Pointing right + pose_segments("Pointing", + x = 5, y = 7.2, scale = sc, ratioxy = rxy, + angleofneck = -pi/2, + angleofspine = -pi/2, + anglerighthumerus = 0, + anglerightradius = 0, + anglelefthumerus = -pi/2 - pi/6, + angleleftradius = -pi/6, + anglerightleg = 3*pi/2 - pi/12, + angleleftleg = 3*pi/2 + pi/12), + + # 5. Sitting (spine horizontal, legs bent) + pose_segments("Sitting", + x = 5, y = 5.8, scale = sc, ratioxy = rxy, + angleofneck = -pi/2, + angleofspine = 0, + anglerighthumerus = -pi/2 - pi/6, + anglerightradius = -pi/2, + anglelefthumerus = -pi/2 + pi/6, + angleleftradius = -pi/2, + anglerightleg = pi/2, + angleleftleg = pi/2 + pi/2), + + # 6. Falling / off-balance + pose_segments("Falling", + x = 5, y = 7.0, scale = sc, ratioxy = rxy, + angleofneck = -pi/2 - pi/4, + angleofspine = -pi/2 - pi/4, + anglerighthumerus = pi/4, + anglerightradius = pi/2, + anglelefthumerus = pi - pi/8, + angleleftradius = pi/2 + pi/4, + anglerightleg = 3*pi/2 + pi/6, + angleleftleg = 3*pi/2 - pi/3) +) + +# Combine into one data frame +all_segs <- do.call(rbind, lapply(poses, `[[`, "segs")) +all_heads <- do.call(rbind, lapply(poses, `[[`, "head")) + +part_colours <- c( + head = "#e41a1c", + spine = "#377eb8", + rarm1 = "#ff7f00", rarm2 = "#ff7f00", + larm1 = "#4daf4a", larm2 = "#4daf4a", + rleg = "#984ea3", + lleg = "#a65628" +) + +all_segs$colour <- part_colours[all_segs$part] +all_heads$colour <- part_colours["head"] + +# Fix facet order +pose_order <- c("Standing","Arms up","Walking","Pointing","Sitting","Falling") +all_segs$pose <- factor(all_segs$pose, levels = pose_order) +all_heads$pose <- factor(all_heads$pose, levels = pose_order) + +set.seed(42) + +p_poses <- ggplot() + + # draw each bone segment + geom_xkcdpath( + aes(x = x, y = y, xend = xend, yend = yend, colour = colour), + data = all_segs, + linewidth = 1.3, mask = FALSE, + xjitteramount = 0.04, yjitteramount = 0.04, + inherit.aes = FALSE + ) + + # draw each head circle + geom_xkcdpath( + aes(x = x, y = y, diameter = diameter, colour = colour), + data = all_heads, + linewidth = 1.3, ratioxy = 1, mask = FALSE, + inherit.aes = FALSE + ) + + scale_colour_identity( + guide = "legend", + name = "Body part", + breaks = part_colours[c("head","spine","rarm1","larm1","rleg","lleg")], + labels = c("head / scale","spine","right arm","left arm","right leg","left leg") + ) + + facet_wrap(~ pose, ncol = 3) + + coord_fixed(xlim = xr, ylim = yr) + + theme_xkcd() + + theme( + axis.text = element_blank(), + axis.ticks = element_blank(), + axis.title = element_blank(), + strip.text = element_text(family = "xkcd", size = 13) + ) + + labs(title = "xkcdman pose gallery") + +p_poses +``` + +--- + +## Part 3 — Angle reference + +The figure below shows the same upright figure four times, varying one +parameter at a time across a row, so you can see directly how each angle +value changes the pose. + +```{r angle_reference, fig.width = 11, fig.height = 9} +# Neutral (upright) pose used as baseline +neutral <- list( + angleofneck = -pi/2, + angleofspine = -pi/2, + anglerighthumerus = -pi/6, + anglerightradius = pi/6, + anglelefthumerus = -pi/2 - pi/6, + angleleftradius = -pi/6, + anglerightleg = 3*pi/2 - pi/12, + angleleftleg = 3*pi/2 + pi/12 +) + +params_to_vary <- list( + list(p = "angleofspine", + v = c(-pi/2, -pi/2 + pi/6, -pi/2 + pi/3, 0), + l = c("spine: -pi/2\n(upright)", "spine: -pi/3", "spine: -pi/6", "spine: 0\n(horizontal)")), + list(p = "anglerighthumerus", + v = c(-pi/6, 0, pi/4, pi/2), + l = c("rarm: -pi/6\n(rest)", "rarm: 0\n(right)", "rarm: pi/4", "rarm: pi/2\n(up)")), + list(p = "anglerightleg", + v = c(3*pi/2 - pi/12, 3*pi/2 - pi/4, 3*pi/2 + pi/4, 3*pi/2 - pi/2), + l = c("rleg: rest", "rleg: back", "rleg: forward", "rleg: up")), + list(p = "anglelefthumerus", + v = c(-pi/2-pi/6, pi-pi/6, pi/2+pi/6, pi), + l = c("larm: rest", "larm: left", "larm: up-left", "larm: out")) +) + +ref_segs <- do.call(rbind, lapply(params_to_vary, function(pv) { + r <- vary_angle(pv$p, pv$v, pv$l) + r$segs$group_param <- pv$p + r$segs +})) + +ref_heads <- do.call(rbind, lapply(params_to_vary, function(pv) { + r <- vary_angle(pv$p, pv$v, pv$l) + r$heads$group_param <- pv$p + r$heads +})) + +ref_segs$colour <- part_colours[ref_segs$part] +ref_heads$colour <- part_colours["head"] + +# highlighted part per param group +highlight_map <- c( + angleofspine = "#377eb8", + anglerighthumerus = "#ff7f00", + anglerightleg = "#984ea3", + anglelefthumerus = "#4daf4a" +) + +ref_segs$colour <- ifelse( + (ref_segs$part == "spine" & ref_segs$group_param == "angleofspine") | + (ref_segs$part == "rarm1" & ref_segs$group_param == "anglerighthumerus") | + (ref_segs$part == "rarm2" & ref_segs$group_param == "anglerighthumerus") | + (ref_segs$part == "rleg" & ref_segs$group_param == "anglerightleg") | + (ref_segs$part == "larm1" & ref_segs$group_param == "anglelefthumerus") | + (ref_segs$part == "larm2" & ref_segs$group_param == "anglelefthumerus"), + ref_segs$colour, + "grey70" +) + +# Facet label: combine group_param + pose +ref_segs$facet_label <- paste0(ref_segs$group_param, "\n", ref_segs$pose) +ref_heads$facet_label <- paste0(ref_heads$group_param, "\n", ref_heads$pose) + +# Build ordered factor across all 16 facets +facet_order <- unlist(lapply(params_to_vary, function(pv) + paste0(pv$p, "\n", pv$l) +)) +ref_segs$facet_label <- factor(ref_segs$facet_label, levels = facet_order) +ref_heads$facet_label <- factor(ref_heads$facet_label, levels = facet_order) + +set.seed(7) + +p_ref <- ggplot() + + geom_xkcdpath( + aes(x = x, y = y, xend = xend, yend = yend, colour = colour), + data = ref_segs, + linewidth = 1.2, mask = FALSE, + xjitteramount = 0.03, yjitteramount = 0.03, + inherit.aes = FALSE + ) + + geom_xkcdpath( + aes(x = x, y = y, diameter = diameter), + data = ref_heads, + linewidth = 1.2, colour = "#e41a1c", ratioxy = 1, mask = FALSE, + inherit.aes = FALSE + ) + + scale_colour_identity() + + facet_wrap(~ facet_label, ncol = 4) + + coord_fixed(xlim = xr, ylim = yr) + + theme_xkcd() + + theme( + axis.text = element_blank(), + axis.ticks = element_blank(), + axis.title = element_blank(), + strip.text = element_text(family = "xkcd", size = 9) + ) + + labs(title = "Angle reference: one parameter varied per row") + +p_ref +``` + +--- + +## Quick reference card + +``` +angleofspine -pi/2 upright | 0 horizontal | pi/2 upside down +angleofneck match angleofspine for natural look +anglerighthumerus -pi/6 hanging | 0 right | pi/2 raised +anglerightradius follow anglerighthumerus + pi/6 for natural elbow bend +anglelefthumerus mirror of right: -pi/2 - anglerighthumerus +angleleftradius mirror of right +anglerightleg 3*pi/2 - pi/12 (slight outward spread) +angleleftleg 3*pi/2 + pi/12 (slight outward spread) + +scale ~10-15% of diff(yrange) +ratioxy diff(xrange) / diff(yrange) -- always set this! +``` + + diff --git a/vignettes/xkcd-penguins.Rmd b/vignettes/xkcd-penguins.Rmd new file mode 100644 index 0000000..de29e95 --- /dev/null +++ b/vignettes/xkcd-penguins.Rmd @@ -0,0 +1,451 @@ +--- +title: "Palmer Penguins with xkcd" +author: "ToledoEM" +date: "`r Sys.Date()`" +output: + rmarkdown::html_vignette: + code_folding: hide +vignette: > + %\VignetteIndexEntry{Palmer Penguins with xkcd} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = TRUE, + message = FALSE, + warning = FALSE, + fig.width = 8, + fig.height = 5 +) +``` + +## Overview + +This vignette demonstrates every function in the **xkcd** package using the +[Palmer Penguins](https://allisonhorst.github.io/palmerpenguins/) dataset — a +fun alternative to `mtcars` featuring size measurements of three penguin species +observed on islands near Palmer Station, Antarctica. + +```{r libraries} +library(xkcd) +library(tidyverse) +library(palmerpenguins) + +# Drop rows with missing values for cleaner plots +penguins <- na.omit(penguins) +``` + +> **Reproducibility note:** All plots use `set.seed()` because xkcd lines are +> drawn with random jitter — fix the seed to get the same figure every time. + +--- + +## 1. `theme_xkcd()` — The XKCD Look + +`theme_xkcd()` applies a hand-drawn feel to any ggplot2 chart: no grid lines, +black axis ticks, and — if the xkcd font is installed — the iconic comic font. + +```{r theme_xkcd} +set.seed(123456) +ggplot(penguins, aes(flipper_length_mm, body_mass_g, colour = species)) + + geom_point(size = 2, alpha = 0.7) + + labs( + title = "Flipper length vs body mass", + x = "Flipper length mm", + y = "Body mass g", + colour = "Species" + ) + + theme_xkcd() +``` + +`theme_xkcd()` returns a standard ggplot2 `theme` object, so you can layer +additional `theme()` calls on top of it. + +--- + +## 2. `xkcdaxis()` — Hand-Drawn Axes + +`xkcdaxis()` replaces the default ggplot2 axis lines with wobbly, hand-drawn +ones. Pass the x and y ranges of your data and it adds jittered axis arrows, a +clipped coordinate system, and calls `theme_xkcd()` internally. + +```{r xkcdaxis} +xrange <- range(penguins$bill_length_mm) +yrange <- range(penguins$bill_depth_mm) + +set.seed(7) +ggplot() + + geom_point( + aes(bill_length_mm, bill_depth_mm, colour = species), + data = penguins, size = 2, alpha = 0.8 + ) + + xkcdaxis(xrange, yrange) + + labs( + x = "Bill length mm", + y = "Bill depth mm", + colour = "Species", + title = "Bill dimensions by species" + ) +``` + +`xkcdaxis()` returns a list of ggplot2 layers — just `+` it onto any plot. + +--- + +## 3. `geom_xkcdpath()` — Wobbly Lines and Segments + +`geom_xkcdpath()` is the low-level building block used by the other functions. +It draws jittered, Bezier-smoothed line **segments** (using `x`, `y`, `xend`, +`yend`) or fuzzy **circles** (using `x`, `y`, `diameter`). + +### 3a. Annotating a trend with a segment + +```{r geom_xkcdpath_segment} +# Gentoo penguins — add an arrow-like segment pointing at the cluster +xrange <- range(penguins$flipper_length_mm) +yrange <- range(penguins$body_mass_g) + +arrow_df <- data.frame( + x = 228, y = 4200, + xend = 220, yend = 5300 +) + +set.seed(99) +ggplot() + + geom_point( + aes(flipper_length_mm, body_mass_g, colour = species), + data = penguins, size = 2, alpha = 0.7 + ) + + geom_xkcdpath( + mapping = aes(x = x, y = y, xend = xend, yend = yend), + data = arrow_df, + linewidth = 1, xjitteramount = 1, yjitteramount = 60, + mask = TRUE + ) + + annotate("text", x = 230, y = 4100, + label = "Big Gentoos!", family = "xkcd", size = 5) + + xkcdaxis(xrange, yrange) + + labs(x = "Flipper length mm", y = "Body mass g", colour = "Species") +``` + +### 3b. Drawing a circle + +Use `diameter` instead of `xend`/`yend` to draw a fuzzy circle. The `ratioxy` +aesthetic keeps the circle from looking like an ellipse when x and y have +different scales. + +```{r geom_xkcdpath_circle} +xrange <- c(160, 240) +yrange <- c(2500, 6500) +ratioxy <- diff(xrange) / diff(yrange) + +# diameter is in x-axis units; ratioxy corrects for the different x/y scales +# so the circle appears round on screen +circle_df <- data.frame(x = 200, y = 4000, diameter = 20) + +set.seed(5) +ggplot() + + geom_point( + aes(flipper_length_mm, body_mass_g, colour = species), + data = penguins, size = 2, alpha = 0.7 + ) + + geom_xkcdpath( + aes(x = x, y = y, diameter = diameter), + data = circle_df, linewidth = 1.2, colour = "firebrick", + ratioxy = ratioxy, mask = FALSE + ) + + annotate("text", x = 200, y = 3600, + label = "Overlap zone", family = "xkcd", size = 4, colour = "firebrick") + + xkcdaxis(xrange, yrange) + + labs(x = "Flipper length mm", y = "Body mass g", colour = "Species", + title = "A fuzzy circle highlights the overlap zone") +``` + +--- + +## 4. `xkcdrect()` — Fuzzy Rectangles + +`xkcdrect()` draws filled rectangles with wobbly hand-drawn borders, perfect +for bar-chart-style plots. Required aesthetics: `xmin`, `xmax`, `ymin`, `ymax`. + +```{r xkcdrect} +# Average body mass per species as a bar chart using fuzzy rectangles +avg_mass <- penguins |> + group_by(species) |> + summarise(mean_mass = mean(body_mass_g), .groups = "drop") |> + mutate( + xmin = as.numeric(species) - 0.35, + xmax = as.numeric(species) + 0.35, + ymin = 0, + ymax = mean_mass + ) + +xrange <- c(0.5, 3.5) +yrange <- c(0, max(avg_mass$mean_mass) + 300) + +set.seed(11) +ggplot() + + xkcdrect( + aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), + data = avg_mass, + fillcolour = c("#f28e2b", "#4e79a7", "#59a14f"), + bordercolour = "black", + borderlinewidth = 1 + ) + + annotate("text", + x = 1:3, + y = avg_mass$mean_mass + 150, + label = levels(penguins$species), + family = "xkcd", size = 5) + + xkcdaxis(xrange, yrange) + + scale_x_continuous(breaks = 1:3, labels = levels(penguins$species)) + + labs( + x = "Species", + y = "Mean body mass g", + title = "Average penguin weight" + ) +``` + +--- + +## 5. `xkcdman()` — Stick Figures + +`xkcdman()` draws a customisable stick figure. Every body part (spine, arms, +legs, neck) is controlled by an angle. The key parameters are: + +| Aesthetic | Meaning | +|-----------|---------| +| `x`, `y` | Head position | +| `scale` | Overall size | +| `ratioxy` | x/y scale ratio (keeps figure from being distorted) | +| `angleofspine` | Spine angle (−π/2 = upright) | +| `anglerighthumerus` / `anglelefthumerus` | Upper arm angles | +| `anglerightradius` / `angleleftradius` | Lower arm angles | +| `anglerightleg` / `angleleftleg` | Leg angles | +| `angleofneck` | Neck angle | + +### 5a. Two penguin researchers + +The key to well-proportioned stick figures is `scale` and `ratioxy`. +`scale` should be ~10–15% of `diff(yrange)` so the figure is visible. +`ratioxy = diff(xrange) / diff(yrange)` corrects for axis distortion so limbs +don't look stretched. Place figures **above** the data cloud, inside the plot +limits, and expand `yrange` to make room. + +```{r xkcdman_basic} +xrange <- range(penguins$flipper_length_mm) +# Expand y upward to give room for figures above the data +yrange <- c(min(penguins$body_mass_g) - 200, max(penguins$body_mass_g) + 1200) +ratioxy <- diff(xrange) / diff(yrange) + +# scale ≈ 10% of yrange so figures are clearly visible +scale_val <- diff(yrange) * 0.10 + +dataman <- data.frame( + x = c(178, 228), + y = c(max(penguins$body_mass_g) + 500, + min(penguins$body_mass_g) + 1500), + scale = scale_val, + ratioxy = ratioxy, + angleofspine = -pi / 2, + anglerighthumerus = c(-pi / 6, -pi / 6), + anglelefthumerus = c(-pi / 2 - pi / 6, -pi / 2 - pi / 6), + anglerightradius = c(pi / 5, -pi / 5), + angleleftradius = c(pi / 5, -pi / 5), + anglerightleg = 3 * pi / 2 - pi / 12, + angleleftleg = 3 * pi / 2 + pi / 12, + angleofneck = -pi / 2 +) + +mapping <- aes( + x = x, y = y, scale = scale, ratioxy = ratioxy, + angleofspine = angleofspine, + anglerighthumerus = anglerighthumerus, + anglelefthumerus = anglelefthumerus, + anglerightradius = anglerightradius, + angleleftradius = angleleftradius, + anglerightleg = anglerightleg, + angleleftleg = angleleftleg, + angleofneck = angleofneck +) + +set.seed(22) +ggplot() + + geom_point( + aes(flipper_length_mm, body_mass_g, colour = species), + data = penguins, size = 2, alpha = 0.7 + ) + + xkcdaxis(xrange, yrange) + + xkcdman(mapping, dataman) + + annotate("text", x = 174, y = max(penguins$body_mass_g) + 1050, + label = "Small\nones!", family = "xkcd", size = 4) + + annotate("text", x = 234, y = max(penguins$body_mass_g) - 1050, + label = "Big\nones!", family = "xkcd", size = 4) + + labs(x = "Flipper length mm", y = "Body mass g", colour = "Species", + title = "Two researchers discuss the data") +``` + +### 5b. One stick figure per island + +One figure stands at the centroid of each island's data. `runif()` gives each +figure a slightly different pose. + +```{r xkcdman_per_island} +island_means <- penguins |> + group_by(island) |> + summarise( + mx = mean(flipper_length_mm), + my = mean(body_mass_g), + .groups = "drop" + ) + +xrange <- range(penguins$flipper_length_mm) +yrange <- c(min(penguins$body_mass_g) - 200, max(penguins$body_mass_g) + 1400) +ratioxy <- diff(xrange) / diff(yrange) +scale_val <- diff(yrange) * 0.10 + +set.seed(33) +dataman <- data.frame( + x = island_means$mx, + y = island_means$my + 800, + scale = scale_val, + ratioxy = ratioxy, + angleofspine = -pi / 2, + anglerighthumerus = runif(3, -pi / 6 - pi / 10, -pi / 6 + pi / 10), + anglelefthumerus = runif(3, -pi / 2 - pi / 6 - pi / 10, -pi / 2 - pi / 6 + pi / 10), + anglerightradius = runif(3, pi / 5 - pi / 10, pi / 5 + pi / 10), + angleleftradius = runif(3, pi / 5 - pi / 10, pi / 5 + pi / 10), + anglerightleg = 3 * pi / 2 - pi / 12, + angleleftleg = 3 * pi / 2 + pi / 12, + angleofneck = -pi / 2 +) + +mapping <- aes( + x = x, y = y, scale = scale, ratioxy = ratioxy, + angleofspine = angleofspine, + anglerighthumerus = anglerighthumerus, + anglelefthumerus = anglelefthumerus, + anglerightradius = anglerightradius, + angleleftradius = angleleftradius, + anglerightleg = anglerightleg, + angleleftleg = angleleftleg, + angleofneck = angleofneck +) + +set.seed(33) +ggplot() + + geom_point( + aes(flipper_length_mm, body_mass_g, colour = island), + data = penguins, size = 2, alpha = 0.7 + ) + + xkcdaxis(xrange, yrange) + + xkcdman(mapping, dataman) + + annotate("text", + x = island_means$mx, + y = island_means$my + 1350, + label = island_means$island, + family = "xkcd", size = 4) + + labs(x = "Flipper length mm", y = "Body mass g", colour = "Island", + title = "One researcher per island",caption = "Trogersen and Dream Island overlap!!") +``` + +--- + +## 6. Putting It All Together + +A single plot that uses every function: `theme_xkcd()`, `xkcdaxis()`, +`xkcdrect()`, `xkcdman()`, and `geom_xkcdpath()`. + +```{r full_example} +# Yearly penguin count as fuzzy bars + a stick figure + annotation arrow +counts <- penguins |> + group_by(year, species) |> + summarise(n = n(), .groups = "drop") |> + group_by(year) |> + summarise(total = sum(n), .groups = "drop") |> + mutate( + xmin = year - 0.35, + xmax = year + 0.35, + ymin = 0, + ymax = total + ) + +xrange <- c(2006.5, 2009.5) +# Expand y to give the figure room above the tallest bar +yrange <- c(0, max(counts$total) + 60) +ratioxy <- diff(xrange) / diff(yrange) +scale_val <- diff(yrange) * 0.12 # ~12% of y range = clearly visible + +# Figure stands above the 2009 bar (tallest), pointing left +dataman <- data.frame( + x = 2009, + y = min(counts$total) - 30, + scale = scale_val, + ratioxy = ratioxy, + angleofspine = -pi / 2, + anglerighthumerus = -pi / 6, + anglelefthumerus = -pi / 2 - pi / 6, + anglerightradius = pi / 5, + angleleftradius = pi / 5, + anglerightleg = 3 * pi / 2 - pi / 12, + angleleftleg = 3 * pi / 2 + pi / 12, + angleofneck = -pi / 2 +) + +man_mapping <- aes( + x = x, y = y, scale = scale, ratioxy = ratioxy, + angleofspine = angleofspine, + anglerighthumerus = anglerighthumerus, + anglelefthumerus = anglelefthumerus, + anglerightradius = anglerightradius, + angleleftradius = angleleftradius, + anglerightleg = anglerightleg, + angleleftleg = angleleftleg, + angleofneck = angleofneck +) + +# Arrow from annotation label to 2009 bar top +arrow_df <- data.frame( + x = 2007.8, y = max(counts$total) + 48, + xend = 2008.6, yend = max(counts$total) + 10 +) + +set.seed(55) +ggplot() + + xkcdrect( + aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), + data = counts, + fillcolour = "#aecbfa", bordercolour = "black", borderlinewidth = 1 + ) + + geom_xkcdpath( + aes(x = x, y = y, xend = xend, yend = yend), + data = arrow_df, + linewidth = 1, xjitteramount = 0.03, yjitteramount = 3, mask = TRUE + ) + + xkcdman(man_mapping, dataman,color="white") + + xkcdaxis(xrange, yrange) + + annotate("text", x = 2007.5, y = max(counts$total) + 48, + label = "More penguins\nevery year!", family = "xkcd", size = 4) + + annotate("text", x = counts$year, y = counts$total + 8, + label = counts$total, family = "xkcd", size = 5) + + scale_x_continuous(breaks = c(2007, 2008, 2009)) + + labs(x = "Year", y = "Penguins observed", + title = "Palmer penguins surveyed per year") +``` + +--- + +## Function Quick Reference + +| Function | What it does | +|---|---| +| `theme_xkcd()` | Applies XKCD theme (no grid, comic font if available) | +| `xkcdaxis(xrange, yrange)` | Draws wobbly hand-drawn axes | +| `geom_xkcdpath()` | Draws jittered segments or circles | +| `xkcdrect()` | Draws fuzzy filled rectangles | +| `xkcdman()` | Draws a customisable stick figure | + +All functions are ggplot2-compatible and can be combined freely with standard +`geom_*`, `annotate()`, `scale_*`, and `facet_*` calls.