# Drrrawing with purrr

**R – Fronkonstin**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

La luna es un pozo chico

las flores no valen nada

lo que valen son tus brazos

cuando de noche me abrazan

(Zorongo Gitano, Carmen Linares)

When I publish a post showing my drawings, I use to place some outputs, give some highlights about the techniques involved as well as a link to the R code that I write to generate them. That’s my typical *generative-art* post (here you have an example of it). I think that my audience knows to program in R and is curious enough to run and modify the code by themselves to generate their own outputs. Today I will try to be more *educational* and will explain step by step how you can obtain drawings like these:

There are two reasons for this decision:

- It can illustrate quite well my
*mental journey*from a simple idea to what I think is a interesting enough experiment to publish. - I think that this experiment is a good example of the use of
`accumulate`

, a very useful function from the*life-changing*`purrr`

package.

Here we go: there are many ways of drawing a pentagon in R. Following you will find a piece of code that does it using `accumulate`

function from `purrr`

package. I will use only two libraries for this experiment: `ggplot2`

and `purrr`

so I will just load in the `tidyverse`

(both libraries take part of it):

library(tidyverse) pentagon <- tibble( x = accumulate(1:4, ~.x+cos(.y*2*pi/5), .init = 0), y = accumulate(1:4, ~.x+sin(.y*2*pi/5), .init = 0), xend = accumulate(2:5, ~.x+cos(.y*2*pi/5), .init = cos(2*pi/5)), yend = accumulate(2:5, ~.x+sin(.y*2*pi/5), .init = sin(2*pi/5))) ggplot(pentagon)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

The function `accumulate`

applies sequentially some function a number of times storing all the intermediate results. When I say sequentially I mean that the input of any step is the output of the prevoius one. The `accumulate`

function uses internally two important arguments called `.x`

and `.y`

: my own way to understand its significance is that `.x`

is the previous value of the output vector and `.y`

is the previous value of the one which controls the iteration. Let’s see a example: imagine that I want to create a vector with the first 10 natural numbers. This is an option:

> accumulate(1:10, ~.y) [1] 1 2 3 4 5 6 7 8 9 10

The vector which controls the iteration in this case is `1:10`

and `.y`

are the values of it so I just have to define a function wich returns that values and this is as simple as `~.y`

. The first iteration takes the first element of that vector. This is another way to do it:

> accumulate(1:10, ~.x+1) [1] 1 2 3 4 5 6 7 8 9 10

To replicate the same output with `.x`

I have to change a bit the function to `~.x+1`

because if not, it will always return `1`

. Remember that `.x`

is the previous output of the function and it is initialized with `1`

(the first value of the vector `1:10`

). Intead of initializing `.x`

with the first value of the vector of the first argument of `accumulate`

, you can define exactly its first value using `.init`

:

accumulate(2:10, ~.y, .init = 1) accumulate(1:9, ~.x+1, .init = 1)

Note that using `.init`

I have to change the vector to reproduce the same output as before. I hope now you will understand how I generated the initial and ending points of the previous pentagon. Some points to help you if not:

- I generate a tibble with
`5`

rows, each of one defines a different segment of the pentagon - First segments starts at
`(0,0)`

- The rotating angle is equal to
`2*pi/5`

- The ending point of each segment becomes the starting point of the following one

The next step is to *encapsulate* this into a function to draw regular polygons with any given number of edges. I only have to generalize the number of steps and the rotating angle of `accumulate`

:

polygon <- function(n) { tibble( x = accumulate(1:(n-1), ~.x+cos(.y*2*pi/n), .init = 0), y = accumulate(1:(n-1), ~.x+sin(.y*2*pi/n), .init = 0), xend = accumulate(2:n, ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)), yend = accumulate(2:n, ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n))) } ggplot(polygon(6))+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void() ggplot(polygon(7))+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void() ggplot(polygon(8))+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void() ggplot(polygon(9))+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

Now, let’s place another segment in the middle of each edge, perpendicular to it towards its centre. To do it I *mutate* de data frame to add those segments using *simple* trigonometry: I just have to add `pi/2`

to the angle wich forms the edge, obtained with `atan2`

function:

polygon(5) -> df1 df1 %>% mutate(angle = atan2(yend-y, xend-x)+pi/2, x = 0.5*x+0.5*xend, y = 0.5*y+0.5*yend, xend = x+0.2*cos(angle), yend = y+0.2*sin(angle)) %>% select(x, y, xend, yend) -> df2 df1 %>% bind_rows(df2) -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

These new segments have longitude equal to `0.2`

, smaller than the original edges of the pentagon. Now, let’s connect the ending points of these perpendicular segments. It is easy using `mutate`

and `first`

functions. Another smaller pentagon appears:

polygon(5) -> df1 df1 %>% mutate(angle = atan2(yend-y, xend-x)+pi/2, x = 0.5*x+0.5*xend, y = 0.5*y+0.5*yend, xend = x+0.2*cos(angle), yend = y+0.2*sin(angle)) %>% select(x, y, xend, yend) -> df2 df2 %>% mutate( x=xend, y=yend, xend=lead(x, default=first(x)), yend=lead(y, default=first(y))) %>% select(x, y, xend, yend) -> df3 df1 %>% bind_rows(df2) %>% bind_rows(df3) -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

Since we are repeating these steps many times, I will write two functions: one to generate perpendicular segments to the edges called `mid_points`

and another one to connect its ending points called `con_points`

. The next code creates both funtions and uses them to add another level to our previous drawing:

mid_points <- function(d) { d %>% mutate( angle=atan2(yend-y, xend-x) + pi/2, x=0.5*x+0.5*xend, y=0.5*y+0.5*yend, xend=x+0.2*cos(angle), yend=y+0.2*sin(angle)) %>% select(x, y, xend, yend) } con_points <- function(d) { d %>% mutate( x=xend, y=yend, xend=lead(x, default=first(x)), yend=lead(y, default=first(y))) %>% select(x, y, xend, yend) } polygon(5) -> df1 df2 <- mid_points(df1) df3 <- con_points(df2) df4 <- mid_points(df3) df5 <- con_points(df4) df1 %>% bind_rows(df2) %>% bind_rows(df3) %>% bind_rows(df4) %>% bind_rows(df5) -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

This pattern is called Sutcliffe pentagon. In the previous step, I did iterations *manually*. The function `accumulate`

can help us to do it automatically. This code reproduces exactly the previous plot:

edges <- 5 niter <- 4 polygon(edges) -> df1 accumulate(.f = function(old, y) { if (y%%2!=0) mid_points(old) else con_points(old) }, 1:niter, .init=df1) %>% bind_rows() -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

Substituting `edges`

by `7`

and `niter`

by `6`

as well in the first two rows of the previous code, generates a different pattern, in this case heptagonal:

Let’s start to play with the parameters to change the appearance of the drawings. What if we do not start the perpendicular segments from the midpoints of the edges? It’s easy: we just need to add a parameter that will name `p`

to the function `mid_points`

(`p=0.5`

means starting from the middle). This is our heptagon pattern when `p`

is equal to `0.3`

:

mid_points <- function(d, p) { d %>% mutate( angle=atan2(yend-y, xend-x) + pi/2, x=p*x+(1-p)*xend, y=p*y+(1-p)*yend, xend=x+0.2*cos(angle), yend=y+0.2*sin(angle)) %>% select(x, y, xend, yend) } edges <- 7 niter <- 6 polygon(edges) -> df1 accumulate(.f = function(old, y) { if (y%%2==0) mid_points(old, 0.3) else con_points(old) }, 1:niter, .init=df1) %>% bind_rows() -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

Another simple modification is to allow any angle between edges and next iteration segments (perpendicular until now ) so let’s add another parameter, called `a`

, to the`mid_points`

function:

mid_points <- function(d, p, a) { d %>% mutate( angle=atan2(yend-y, xend-x) + a, x=p*x+(1-p)*xend, y=p*y+(1-p)*yend, xend=x+0.2*cos(angle), yend=y+0.2*sin(angle)) %>% select(x, y, xend, yend) } edges <- 7 niter <- 18 polygon(edges) -> df1 accumulate(.f = function(old, y) { if (y%%2!=0) mid_points(old, 0.3, pi/5) else con_points(old) }, 1:niter, .init=df1) %>% bind_rows() -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

That’s nice! It looks like a shutter. Now it’s time to change the longitude of the segments starting from the edges (those perpendicular in our first drawings). Now all them measure `0.2`

. I will take advantage of the parameter `y`

of `accumulate`

and apply a user defined function to modify that longitude each iteration. This example uses the identity function (`FUN = function(x) x`

) to increase longitude step by step:

mid_points <- function(d, p, a, i, FUN = function(x) x) { d %>% mutate( angle=atan2(yend-y, xend-x) + a, radius=FUN(i), x=p*x+(1-p)*xend, y=p*y+(1-p)*yend, xend=x+radius*cos(angle), yend=y+radius*sin(angle)) %>% select(x, y, xend, yend) } edges <- 7 niter <- 18 polygon(edges) -> df1 accumulate(.f = function(old, y) { if (y%%2!=0) mid_points(old, 0.3, pi/5, y) else con_points(old) }, 1:niter, .init=df1) %>% bind_rows() -> df ggplot(df)+ geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+ coord_equal()+ theme_void()

What if we increase `niter`

from 18 to 250?

edges <- 7 niter <- 250 step <- 2 polygon(edges) -> df1 accumulate(.f = function(old, y) { if (y%%step!=0) mid_points(old, 0.3, pi/5, y) else con_points(old) }, 1:niter, .init=df1) %>% bind_rows() -> df ggplot(df)+ geom_curve(aes(x=x, y=y, xend=xend, yend=yend), curvature = 0, color="black", alpha=0.1)+ coord_equal()+ theme(legend.position = "none", panel.background = element_rect(fill="white"), plot.background = element_rect(fill="white"), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), axis.text = element_blank())

Not bad, but we can do it better. First of all, note that appart of adding transparency with the parameter `alpha`

inside the `ggplot`

function, I changed the geometry of the plot from `geom_segment`

to `geom_curve`

. Setting `curvature = 0`

as I did generates straight lines so the result is the same as `geom_segment`

but it will give us an additional *degree of freedom* to do our plots. I also changed the `theme_void`

by an explicit customization some of the elements of the plot. Concretely, I want to be able to change the background color. This is the definitive code explained:

library(tidyverse) # This function creates the segments of the original polygon polygon <- function(n) { tibble( x = accumulate(1:(n-1), ~.x+cos(.y*2*pi/n), .init = 0), y = accumulate(1:(n-1), ~.x+sin(.y*2*pi/n), .init = 0), xend = accumulate(2:n, ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)), yend = accumulate(2:n, ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n))) } # This function creates segments from some mid-point of the edges mid_points <- function(d, p, a, i, FUN = ratio_f) { d %>% mutate( angle=atan2(yend-y, xend-x) + a, radius=FUN(i), x=p*x+(1-p)*xend, y=p*y+(1-p)*yend, xend=x+radius*cos(angle), yend=y+radius*sin(angle)) %>% select(x, y, xend, yend) } # This function connect the ending points of mid-segments con_points <- function(d) { d %>% mutate( x=xend, y=yend, xend=lead(x, default=first(x)), yend=lead(y, default=first(y))) %>% select(x, y, xend, yend) } edges <- 3 # Number of edges of the original polygon niter <- 250 # Number of iterations pond <- 0.24 # Weight to calculate the point on the middle of each edge step <- 13 # No of times to draw mid-segments before connect ending points alph <- 0.25 # transparency of curves in geom_curve angle <- 0.6 # angle of mid-segment with the edge curv <- 0.1 # Curvature of curves line_color <- "black" # Color of curves in geom_curve back_color <- "white" # Background of the ggplot ratio_f <- function(x) {sin(x)} # To calculate the longitude of mid-segments # Generation on the fly of the dataset accumulate(.f = function(old, y) { if (y%%step!=0) mid_points(old, pond, angle, y) else con_points(old) }, 1:niter, .init=polygon(edges)) %>% bind_rows() -> df # Plot ggplot(df)+ geom_curve(aes(x=x, y=y, xend=xend, yend=yend), curvature = curv, color=line_color, alpha=alph)+ coord_equal()+ theme(legend.position = "none", panel.background = element_rect(fill=back_color), plot.background = element_rect(fill=back_color), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), axis.text = element_blank())

The next table shows the parameters of each of the previous drawings (from left to right and top to bottom):

edges | niter | pond | step | alph | angle | curv | line_color | back_color | ratio_f | |
---|---|---|---|---|---|---|---|---|---|---|

1 | 4 | 200 | 0.92 | 9 | 0.50 | 6.12 | 0.0 | black | white | function (x) { x } |

2 | 5 | 150 | 0.72 | 13 | 0.35 | 2.96 | 0.0 | black | white | function (x) { sqrt(x) } |

3 | 15 | 250 | 0.67 | 9 | 0.15 | 1.27 | 1.0 | black | white | function (x) { sin(x) } |

4 | 9 | 150 | 0.89 | 14 | 0.35 | 3.23 | 0.0 | black | white | function (x) { sin(x) } |

5 | 5 | 150 | 0.27 | 17 | 0.35 | 4.62 | 0.0 | black | white | function (x) { log(x + 1) } |

6 | 14 | 100 | 0.87 | 14 | 0.15 | 0.57 | -2.0 | black | white | function (x) { 1 – cos(x)^2 } |

7 | 7 | 150 | 0.19 | 6 | 0.45 | 3.59 | 0.0 | black | white | function (x) { 1 – cos(x)^2 } |

8 | 4 | 150 | 0.22 | 10 | 0.45 | 4.78 | 0.0 | black | white | function (x) { 1/x } |

9 | 3 | 250 | 0.24 | 13 | 0.25 | 0.60 | 0.1 | black | white | function (x) { sin(x) } |

You can also play with colors. By the way: this document will help you to choose them by their name. Some examples:

I will not *unveil* the parameters of the previous drawings. Maybe it can encourage you to try by yourself and find your own patterns. If you do, I will love to see them. I hope you enjoy this reading. The code is also available here.

**leave a comment**for the author, please follow the link and comment on their blog:

**R – Fronkonstin**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.