Create mathematical art with R
This package provides functions and data for creating mathematical art.
Note: Previously this package contained functions for generating data from parametric equations discovered by the mathematical artist Hamid Naderi Yeganeh. The equations, which are publically available, generate data that, when plotted without further processing, closely resemble Hamid's artworks. To ensure that I do not inadvertently receive credit for Hamid's work and out of respect for the artist I have removed any functions and plots derived from his equations, and apologise to Hamid for any confusion this may have caused.
install.packages(c("devtools", "mapproj", "tidyverse", "ggforce", "Rcpp"))
devtools::install_github("marcusvolz/mathart")
devtools::install_github("marcusvolz/ggart")library(mathart)
library(ggart)
library(ggforce)
library(Rcpp)
library(tidyverse)The shell model is described in the paper "Models for mollusc shell shape" by M.B. Cortie (1989).
See also the following Gist.
df <- mollusc()
df1 <- df %>% mutate(id = 1)
df2 <- df %>% mutate(id = 2)
df3 <- df %>% mutate(id = 3)
p <- ggplot() +
geom_point(aes(x, y), df1, size = 0.03, alpha = 0.03) +
geom_path( aes(x, y), df1, size = 0.03, alpha = 0.03) +
geom_point(aes(x, z), df2, size = 0.03, alpha = 0.03) +
geom_path( aes(x, z), df2, size = 0.03, alpha = 0.03) +
geom_point(aes(y, z), df3, size = 0.03, alpha = 0.03) +
geom_path( aes(y, z), df3, size = 0.03, alpha = 0.03) +
facet_wrap(~id, nrow = 2, scales = "free") +
theme_blankcanvas(margin_cm = 0.5)
ggsave("mollusc01.png", width = 80, height = 80, units = "cm")
Refer to the Wikipedia article for details about harmonographs.
df1 <- harmonograph(A1 = 1, A2 = 1, A3 = 1, A4 = 1,
d1 = 0.004, d2 = 0.0065, d3 = 0.008, d4 = 0.019,
f1 = 3.001, f2 = 2, f3 = 3, f4 = 2,
p1 = 0, p2 = 0, p3 = pi/2, p4 = 3*pi/2) %>% mutate(id = 1)
df2 <- harmonograph(A1 = 1, A2 = 1, A3 = 1, A4 = 1,
d1 = 0.0085, d2 = 0, d3 = 0.065, d4 = 0,
f1 = 2.01, f2 = 3, f3 = 3, f4 = 2,
p1 = 0, p2 = 7*pi/16, p3 = 0, p4 = 0) %>% mutate(id = 2)
df3 <- harmonograph(A1 = 1, A2 = 1, A3 = 1, A4 = 1,
d1 = 0.039, d2 = 0.006, d3 = 0, d4 = 0.0045,
f1 = 10, f2 = 3, f3 = 1, f4 = 2,
p1 = 0, p2 = 0, p3 = pi/2, p4 = 0) %>% mutate(id = 3)
df4 <- harmonograph(A1 = 1, A2 = 1, A3 = 1, A4 = 1,
d1 = 0.02, d2 = 0.0315, d3 = 0.02, d4 = 0.02,
f1 = 2, f2 = 6, f3 = 1.002, f4 = 3,
p1 = pi/16, p2 = 3*pi/2, p3 = 13*pi/16, p4 = pi) %>% mutate(id = 4)
df <- rbind(df1, df2, df3, df4)
p <- ggplot() +
geom_path(aes(x, y), df, alpha = 0.25, size = 0.5) +
coord_equal() +
facet_wrap(~id, nrow = 2) +
theme_blankcanvas(margin_cm = 0)
ggsave("harmonograph01.png", p, width = 20, height = 20, units = "cm")
Refer to the Wikipedia article for details about Lissajous curves.
set.seed(1)
df <- 1:100 %>% map_df(~lissajous(a = runif(1, 0, 10), A = runif(1, 0, 1)), .id = "id")
p <- ggplot() +
geom_path(aes(x, y), df, size = 0.25, lineend = "round") +
facet_wrap(~id, nrow = 10) +
coord_equal() +
theme_blankcanvas(margin_cm = 1)
ggsave("lissajous001.png", p, width = 20, height = 20, units = "cm", dpi = 300)
Refer to the Wikipedia article for details about k-nearest neighbors graphs.
set.seed(2)
df <- lissajous(a = runif(1, 0, 2), b = runif(1, 0, 2), A = runif(1, 0, 2), B = runif(1, 0, 2), d = 200) %>%
sample_n(1001) %>%
k_nearest_neighbour_graph(40)
p <- ggplot() +
geom_segment(aes(x, y, xend = xend, yend = yend), df, size = 0.03) +
coord_equal() +
theme_blankcanvas(margin_cm = 0)
ggsave("knn_lissajous_002.png", p, width = 25, height = 25, units = "cm")
Refer to the Wikipedia article for details about rose curves.
df <- data.frame(x = numeric(0), y = numeric(0), n = integer(0), d = integer(0))
for(n in 1:10) {
for(d in 1:10) {
result <- rose_curve(n, d) %>% mutate(n = n, d = d)
df <- rbind(df, result)
}
}
p <- ggplot() +
geom_path(aes(x, y), df, size = 0.35, lineend = "round") +
facet_grid(d ~ n) +
coord_equal() +
theme_blankcanvas(margin_cm = 1)
ggsave("rose_curves.png", p, width = 20, height = 20, units = "cm")
The Rcpp implementations for the attractor functions in this package are from the blog post Drawing 10 Million Points With ggplot by Antonio Sanchez Chinchon.
df <- lorenz_attractor(a=20, b=8/3, c=28, n=1000000)
p <- ggplot() +
geom_path(aes(x, z), df, alpha = 0.15, size = 0.03) +
coord_equal() +
xlim(-25, 25) + ylim(2.5, 52.5) +
theme_blankcanvas(margin_cm = 0)
ggsave("lorenz_attractor.png", p, width = 20, height = 20, units = "cm")
Refer to the Wikipedia article for details about rapidly exploring random trees.
# Generate rrt edges
set.seed(1)
df <- rapidly_exploring_random_tree() %>% mutate(id = 1:nrow(.))
# Create plot
p <- ggplot() +
geom_segment(aes(x, y, xend = xend, yend = yend, size = -id, alpha = -id), df, lineend = "round") +
coord_equal() +
scale_size_continuous(range = c(0.1, 0.75)) +
scale_alpha_continuous(range = c(0.1, 1)) +
theme_blankcanvas(margin_cm = 0)
# Save plot
ggsave("rapidly_exploring_random_tree.png", p, width = 20, height = 20, units = "cm")
Refer to the Wikipedia article for details about fractal ferns.
n <- 250000
params1 <- data.frame(
a <- c(0, 0.85, 0.2, -0.15),
b <- c(0, 0.04, -0.26, 0.28),
c <- c(0, -0.04, 0.23, 0.26),
d <- c(0.16, 0.85, 0.22, 0.24),
e <- c(0, 0, 0, 0),
f <- c(0, 1.6, 1.6, 0.44),
p <- c(0.01, 0.85, 0.07, 0.07)
)
params2 <- data.frame(
a <- c(0, 0.85, 0.09, -0.09),
b <- c(0, 0.02, -0.28, 0.28),
c <- c(0, -0.02, 0.3, 0.3),
d <- c(0.25, 0.83, 0.11, 0.09),
e <- c(0, 0, 0, 0),
f <- c(-0.14, 1, 0.6, 0.7),
p <- c(0.02, 0.84, 0.07, 0.07)
)
df1 <- fractal_fern(n = n, a = params1$a, b = params1$b, c_ = params1$c, d = params1$d, e = params1$e,
f = params1$f, p = params1$p) %>% mutate(id = 1)
df2 <- fractal_fern(n = n, a = params2$a, b = params2$b, c_ = params2$c, d = params2$d, e = params2$e,
f = params2$f, p = params2$p) %>% mutate(id = 2)
df <- rbind(df1, df2 %>% mutate(x = x*1.75, y = y*1.75))
p <- ggplot() +
geom_point(aes(x, y), df, size = 0.03, alpha = 0.06) +
coord_equal() +
facet_wrap(~id, nrow = 1) +
theme_blankcanvas(margin_cm = 1)
ggsave("fern01.png", width = 20, height = 20, units = "cm")
Refer to the Wikipedia article for details about k-d trees.
points <- mathart::points
result <- kdtree(points)
p <- ggplot() +
geom_segment(aes(x, y, xend = xend, yend = yend), result) +
coord_equal() +
xlim(0, 10000) + ylim(0, 10000) +
theme_blankcanvas(margin_cm = 0)
ggsave("kdtree.png", p, width = 20, height = 20, units = "in")
This plot shows iterations of Weiszfeld's algorithm for finding the geometric median of a given set of points. The algorithm is initialised from 10,000 locations. Refer to the Wikipedia article for details about the geometric median and Weiszfeld's algorithm.
set.seed(1)
terminals <- data.frame(x = runif(10, 0, 10000), y = runif(10, 0, 10000))
df <- 1:10000 %>%
map_df(~weiszfeld(terminals, c(points$x[.], points$y[.])), .id = "id")
p <- ggplot() +
geom_point(aes(x, y), points, size = 1, alpha = 0.25) +
geom_point(aes(x, y), terminals, size = 5, alpha = 1) +
geom_line(aes(x, y, group = id), df, colour = "black", size = 0.5, alpha = 0.03) +
coord_equal() +
xlim(0, 10000) +
ylim(0, 10000) +
theme_blankcanvas(margin_cm = 0)
ggsave("weiszfeld.png", p, width = 20, height = 20, units = "in")