https://github.com/friendly/ggsprings
ggplot2 extension to draw springs
https://github.com/friendly/ggsprings
Last synced: about 1 year ago
JSON representation
ggplot2 extension to draw springs
- Host: GitHub
- URL: https://github.com/friendly/ggsprings
- Owner: friendly
- License: gpl-3.0
- Created: 2024-10-12T22:00:14.000Z (over 1 year ago)
- Default Branch: master
- Last Pushed: 2025-04-19T17:18:09.000Z (about 1 year ago)
- Last Synced: 2025-04-24T04:15:58.297Z (about 1 year ago)
- Language: R
- Size: 4.01 MB
- Stars: 5
- Watchers: 2
- Forks: 2
- Open Issues: 1
-
Metadata Files:
- Readme: README.Rmd
- Changelog: NEWS.md
- License: LICENSE.md
Awesome Lists containing this project
README
---
output:
github_document:
toc: TRUE
---
```{r, include = FALSE}
knitr::opts_chunk$set(
message = FALSE,
warning = FALSE,
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
options(digits=3)
library(tidyverse)
```
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
# ggsprings
`ggsprings` is designed to
implement an extension of `geom_path` which draws paths as springs instead of straight lines.
Aside from possible artistic use, the main impetus for this is to draw points connected by springs,
with properties of length, diameter and tension. The initial code for this comes from
[ggplot2: Elegant Graphics for Data Analysis (3e), Ch. 21: A Case Study (springs) ](https://ggplot2-book.org/ext-springs)
A leading example is to illustrate how least squares regression
is "solved" by connecting data points to a rod, where the springs are constrained to be vertical.
The mathematics behind this are well-described in this [Math Stackexchange post](https://math.stackexchange.com/questions/2369673/proving-linear-regression-by-using-physical-springs-model),
where the least squares estimates of intercept and slope are shown to be the equilibrium position that minimized the sum of forces
and torques exerted by springs.
If the springs are allowed to be free, the physical solution is the major PCA axis.
How to do this is described in the `ggplot2` book, https://ggplot2-book.org/ext-springs.
The current version here was copied/pasted from the book.
A blog post by Joshua Loftus, [Least squares by springs](https://joshualoftus.com/posts/2020-11-23-least-squares-as-springs/least-squares-as-springs.html)
illustrates this, citing [code from Thomas Lin Pederson](https://twitter.com/thomasp85/status/1331338379636649986).
Code to reproduce the first example is contained in `examples/springs.R` and `examples/gapminder-ex.R`.
### Illustrations
These images show the intent of `ggsprings` package.
**Least squares regression**
A plot of `lifeExp` vs. `gdpPercap` from the `gapminder` data, with `gdpPercap` on a log10 scale, using the code in the `examples/` folder.
Springs are connected between the observed value `y = lifeExp` and the fitted value on the regression line, `yend = yhat`, computed
with `predict()` for the linear model.
`tension` was set to `5 + (lifeExp - yhat)^2)`.
Code for this is in [examples/gapminder-ex.R](examples/gapminder-ex.R)
```
spring_plot <- simple_plot +
geom_spring(aes(x = gdpPercap,
xend = gdpPercap,
y = lifeExp,
yend = yhat,
diameter = diameter,
tension = tension), color = "darkgray") +
stat_smooth(method = "lm", se = FALSE) +
geom_point(size = 2)
spring_plot
```
{width=60%}
**Principal components analysis**
In PCA, the first principal component maximizes the variance of the linear combination, or equivalently,
minimizes the sum of squares of **perpendicular** distances of the points to the line.
{width=60%}
**Animated version**
This [StatsExchange post](https://stats.stackexchange.com/questions/2691/making-sense-of-principal-component-analysis-eigenvectors-eigenvalues/140579#140579)
show an animation of the process of fitting PCA by springs.
It doesn't actually draw springs, but it gets the animation right. You can see that the forces of the
springs initially produce large changes in the fitted line, these cause the line to swing back and forth
across it's final position, and shortly the forces begin to balance out.
This animation is written in Matlib, using the code in [pca_animmation.m](https://gist.github.com/anonymous/7d888663c6ec679ea65428715b99bfdd).
## Installation
You can install the current version of `ggsprings` from this repo,
```
remotes::install.github("friendly/ggsprings")
```
## TODO
* Finish documenting the package. I don't quite know how to document a `ggproto` or to use `@inheritParams` for ggplot2 extensions. Add some more examples illustrating spring aesthetics and
features.
* Use the package to re-create the [gapminder example](examples/gapminder-ex.R).
* Try to use `gganimate` for an animated example.
* Make a hex logo
* [begun] Write a vignette explaining the connection between least squares and springs better. In particular,
+ Illustrate a sample mean by springs: This is the point where positive and negative deviations
sum to zero $\Sigma (x - \bar{x}) = 0$, and also minimizes the sum of squares, $\Sigma (x - \bar{x})^2$.
+ Illustrate least squares regression in relation to the the normal equations,
---
## What's inside
### create_spring.R
```{r, code = readLines("R/create_spring.R")}
```
### StatSpring.R
```{r, code = readLines("R/StatSpring.R")}
```
### GeomSpring.R
[Documentation Q&A from ](https://github.com/ggplot2-extenders/ggplot-extension-club/discussions/83#discussioncomment-12480523) @friendly and @teunbrand
> I don't quite know how to document a ggproto
They are usually accompanied by @export, @format NULL and @usage NULL roxygen tags and refer with @rdname to a pretty generic piece of documentation stating that these are ggproto classes used for extending ggplot2 and are not intended to be used by users directly.
An example of that from one of my extensions can be found here: https://github.com/teunbrand/ggh4x/blob/main/R/ggh4x_extensions.R
```{r, code = readLines("R/GeomSpring.R")}
```
### geom_spring.R (contains `stat_spring()`)
[Documentation Q&A from ](https://github.com/ggplot2-extenders/ggplot-extension-club/discussions/83#discussioncomment-12480523) @friendly and @teunbrand
> to use @inheritParams for ggplot2 extensions
If you're going for a geom_spring(), you can use something like @inheritParams ggplot2::geom_path or other geom that maximises overlap between arguments.
```{r, code = readLines("R/geom_spring.R")}
```
### StatSmoothFit
```{r}
compute_group_smooth_fit <- function(data, scales, method = NULL, formula = NULL,
xseq = NULL,
level = 0.95, method.args = list(),
na.rm = FALSE, flipped_aes = NA){
if(is.null(xseq)){ # predictions based on observations
StatSmooth$compute_group(data = data, scales = scales,
method = method, formula = formula,
se = FALSE, n= 80, span = 0.75, fullrange = FALSE,
xseq = data$x,
level = .95, method.args = method.args,
na.rm = na.rm, flipped_aes = flipped_aes) |>
dplyr::mutate(xend = data$x,
yend = data$y)
}else{ # predict specific input values
StatSmooth$compute_group(data = data, scales = scales,
method = method, formula = formula,
se = FALSE, n= 80, span = 0.75, fullrange = FALSE,
xseq = xseq,
level = .95, method.args = method.args,
na.rm = na.rm, flipped_aes = flipped_aes)
}
}
```
```{r}
library(ggplot2)
cars |>
select(x = speed, y = dist) |>
compute_group_smooth_fit(method = lm, formula = y~ x) |>
head()
```
```{r}
StatSmoothFit <- ggplot2::ggproto("StatSmoothFit",
ggplot2::StatSmooth,
compute_group = compute_group_smooth_fit,
required_aes = c("x", "y"))
aes_color_accent <- GeomSmooth$default_aes[c("colour")]
GeomPointAccent <- ggproto("GeomPointAccent", GeomPoint,
default_aes = modifyList(GeomPoint$default_aes,
aes_color_accent))
GeomSegmentAccent <- ggproto("GeomSegmentAccent", GeomSegment,
default_aes = modifyList(GeomSegment$default_aes,
aes_color_accent))
GeomSpringAccent <- ggproto("GeomSpringAccent", GeomSpring,
default_aes = modifyList(GeomSpring$default_aes,
aes_color_accent))
layer_smooth_fit <- function (mapping = NULL, data = NULL, stat = StatSmoothFit, geom = GeomPointAccent, position = "identity",
..., show.legend = NA, inherit.aes = TRUE)
{
layer(data = data, mapping = mapping, stat = stat,
geom = geom, position = position, show.legend = show.legend,
inherit.aes = inherit.aes, params = rlang::list2(na.rm = FALSE,
...))
}
stat_smooth_fit <- function(...){layer_smooth_fit(stat = StatSmoothFit, ...)}
geom_smooth_fit <- function(...){layer_smooth_fit(geom = GeomPointAccent, ...)}
geom_residuals <- function(...){layer_smooth_fit(geom = GeomSegmentAccent, ...)}
geom_residual_springs <- function(...){layer_smooth_fit(geom = GeomSpringAccent, ...)}
```
Try it out:
```{r}
library(ggsprings)
mtcars %>%
ggplot() +
aes(x = wt, y = mpg) +
geom_point() +
geom_smooth(method = "lm") +
geom_smooth_fit(method = "lm") +
geom_residuals(method = "lm")
```
Use `geom`residual_springs`
```{r}
mtcars %>%
ggplot() +
aes(x = wt, y = mpg) +
geom_point() +
geom_smooth(method = "lm") +
geom_smooth_fit(method = "lm") +
geom_residual_springs(method = "lm")
```
## Example
Some basic examples top show what is working:
```{r example1, eval = T}
# library(ggsprings)
library(ggplot2)
library(tibble)
#library(dplyr)
set.seed(421)
df <- tibble(
x = runif(5, max = 10),
y = runif(5, max = 10),
xend = runif(5, max = 10),
yend = runif(5, max = 10),
class = sample(letters[1:2], 5, replace = TRUE)
)
ggplot(df) +
geom_spring(aes(x = x, y = y,
xend = xend, yend = yend,
color = class),
linewidth = 2)
```
Using tension and diameter as aesthetics
```{r example2, eval = T}
df <- tibble(
x = runif(5, max = 10),
y = runif(5, max = 10),
xend = runif(5, max = 10),
yend = runif(5, max = 10),
class = sample(letters[1:2], 5, replace = TRUE),
tension = runif(5),
diameter = runif(5, 0.25, 0.75)
)
ggplot(df, aes(x, y, xend = xend, yend = yend)) +
geom_spring(aes(tension = tension,
diameter = diameter,
color = class),
linewidth = 1.2)
```
# Packaging
```{r, eval = F}
devtools::check(".")
devtools::install(pkg = ".", upgrade = "never")
```
# Vignettes
## vignettes/least-squares.Rmd
```{r, child = "vignettes/least-squares.Rmd"}
```
Using tension and diameter defaults
```{r}
set.seed(1234)
N <- 10
df <- tibble(
x = runif(N, 1, 10),
y = runif(N, 1, 10)
)
ggplot(df) +
aes(x = x, y = y,
xend = mean(x),
yend = mean(y)) +
geom_point(size = 5, color = "red") +
geom_spring(color = "blue",
linewidth = 1.2) +
geom_point(aes(x = mean(x), y = mean(y)),
size = 7,
shape = 15,
color = "black") +
scale_x_continuous(breaks = 1:10) +
scale_y_continuous(breaks = 1:10) +
theme_minimal(base_size = 15)
```
## Related
* An [interactive demo](https://www.desmos.com/calculator/90vaqtqpx6) by Trey Goesh allows you to
visualize the effect of moving points, changing spring parameters, etc.