Frankenstein

Remember me, remember me, but ah! forget my fate (Dido’s Lament, Henry Purcell)

A Voronoi diagram divides a plane based on a set of original points. Each polygon, or Voronoi cell, contains an original point and all that are closer to that point than any other.

This is a nice example of a Voronoi tesselation. You can find good explanations of Voronoi diagrams and Delaunay triangulations here (in English) or here (in Spanish).

A grayscale image is simply a matrix where darkness of pixel located in coordinates (i, j) is represented by the value of its corresponding element of the matrix: a grayscale image is a dataset. This is a Voronoi diagraman of Frankenstein:

To do it I followed the next steps:

2. Convert it to gray scale
3. Turn it into a pure black and white image
4. Obtain a random sample of black pixels (previous image corresponds to a sample of 6.000 points)
5. Computes the Voronoi tesselation

Steps 1 to 3 were done with imager, a very appealing package to proccess and analice images. Step 5 was done with deldir, also a convenient package which computes Delaunay triangulation and the Dirichlet or Voronoi tessellations.

The next grid shows tesselations for sample size from 500 to 12.000 points and step equal to 500:

I gathered all previous images in this gif created with magick, another amazing package of R I discovered recently:

This is the code:

library(imager)
library(dplyr)
library(deldir)
library(ggplot2)
library(scales)

# Read and convert to grayscale

# This is just to define frame limits
x %>%
as.data.frame() %>%
group_by() %>%
summarize(xmin=min(x), xmax=max(x), ymin=min(y), ymax=max(y)) %>%
as.vector()->rw

# Filter image to convert it to bw
x %>%
threshold("45%") %>%
as.cimg() %>%
as.data.frame() -> df

# Function to compute and plot Voronoi tesselation depending on sample size
doPlot = function(n)
{
#Voronoi tesselation
df %>%
sample_n(n, weight=(1-value)) %>%
select(x,y) %>%
deldir(rw=rw, sort=TRUE) %>%
.$dirsgs -> data # This is just to add some alpha to lines depending on its longitude data %>% mutate(long=sqrt((x1-x2)^2+(y1-y2)^2), alpha=findInterval(long, quantile(long, probs = seq(0, 1, length.out = 20)))/21)-> data # A little bit of ggplot to plot results data %>% ggplot(aes(alpha=(1-alpha))) + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black", lwd=1) + scale_x_continuous(expand=c(0,0))+ scale_y_continuous(expand=c(0,0), trans=reverse_trans())+ theme(legend.position = "none", panel.background = element_rect(fill="white"), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), axis.text = element_blank())->plot return(plot) } # I call the previous function and store resulting plot in jpeg format i=5000 name=paste0("frankie",i,".jpeg") jpeg(name, width = 600, height = 800, units = "px", quality = 100) doPlot(i) dev.off() # Once all images are stored I can create gif library(magick) frames=c() images=list.files(pattern="jpeg") for (i in length(images):1) { x=image_read(images[i]) x=image_scale(x, "300") c(x, frames) -> frames } animation=image_animate(frames, fps = 2) image_write(animation, "Frankenstein.gif")  The Ex Libris Generator Go ahead stomp your feet on the floorboards Clap your hands if that’s really what you came here for (Heaven, The Milk Carton Kids) Inspired by curves created by the harmonograph, I have done a Shiny app to generate random images that you can personalize and use as an Exlibris. You can try the App here. For me, an exlibris (also known as bookplates) can be a nice, original and useful present for book-lovers. This is an example: More examples: I always put the code at the end of my posts. Since I always have doubts about how many people are interested in what I do, today will be different. I will share the code with those who ask it to me in any of the following ways: • Sending me a direct message on Twitter • Droping me an email Cheers! The Somnambulist and Pi How wary we are of something warm and unborn. Something calmly by zero will divide (Unbegotten, The Somnambulist) Some time ago, I assumed the mission to draw a plot for the cover of the new album of The Somnambulist, a music band from Berlin. They wanted a circlization of Pi, which is a graphic where numbers are represented in a circular layout. The idea is connecting each digit of Pi to its successive digit with links to the position of the numerically corresponding external sectors. I used a color palette composed by 10 nuances of the visible spectrum as a tribute for Planck, as Marco (the vocalist) requested me. After a number of attempts: The album is named Unbegotten, a german word which means archaic. As Marco told me, in theology it also means kind of eternal because of being never born and so never dying. I like how π is integrated into the title to substitute the string “tt” in the middle. Pi is also eternal so the association is genuine. The music of The Somnambulist is intense, dark and powerful and is waiting for you here to listen it. My favorite song is the one that gives name to the album. If you want to know more about circlizong numbers, you can visit this post, where you also can see the code I used as starting point to do this plot. Chaotic Galaxies Tell me, which side of the earth does this nose come from? Ha! (ALF) Reading about strange attractors I came across with this book, where I discovered a way to generate two dimensional chaotic maps. The generic equation is pretty simple: $x_{n+1}= a_{1}+a_{2}x_{n}+a_{3}x_{n}^{2}+a_{4}x_{n}y_{n}+a_{5}y_{n}+a_{6}y_{n}^{2}$ $y_{n+1}= a_{7}+a_{8}x_{n}+a_{9}x_{n}^{2}+a_{10}x_{n}y_{n}+a_{11}y_{n}+a_{12}y_{n}^{2}$ I used it to generate these chaotic galaxies: Changing the vector of parameters you can obtain other galaxies. Do you want to try? library(ggplot2) library(dplyr) #Generic function attractor = function(x, y, z) { c(z[1]+z[2]*x+z[3]*x^2+ z[4]*x*y+ z[5]*y+ z[6]*y^2, z[7]+z[8]*x+z[9]*x^2+z[10]*x*y+z[11]*y+z[12]*y^2) } #Function to iterate the generic function over the initial point c(0,0) galaxy= function(iter, z) { df=data.frame(x=0,y=0) for (i in 2:iter) df[i,]=attractor(df[i-1, 1], df[i-1, 2], z) df %>% rbind(data.frame(x=runif(iter/10, min(df$x), max(df$x)), y=runif(iter/10, min(df$y), max(df$y))))-> df return(df) } opt=theme(legend.position="none", panel.background = element_rect(fill="#00000c"), plot.background = element_rect(fill="#00000c"), panel.grid=element_blank(), axis.ticks=element_blank(), axis.title=element_blank(), axis.text=element_blank(), plot.margin=unit(c(-0.1,-0.1,-0.1,-0.1), "cm")) #First galaxy z1=c(1.0, -0.1, -0.2, 1.0, 0.3, 0.6, 0.0, 0.2, -0.6, -0.4, -0.6, 0.6) galaxy1=galaxy(iter=2400, z=z1) %>% ggplot(aes(x,y))+ geom_point(shape= 8, size=jitter(12, factor=4), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=16, size= jitter(4, factor=2), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=46, size= 0, color="#ffff00")+opt #Second galaxy z2=c(-1.1, -1.0, 0.4, -1.2, -0.7, 0.0, -0.7, 0.9, 0.3, 1.1, -0.2, 0.4) galaxy2=galaxy(iter=2400, z=z2) %>% ggplot(aes(x,y))+ geom_point(shape= 8, size=jitter(12, factor=4), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=16, size= jitter(4, factor=2), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=46, size= 0, color="#ffff00")+opt #Third galaxy z3=c(-0.3, 0.7, 0.7, 0.6, 0.0, -1.1, 0.2, -0.6, -0.1, -0.1, 0.4, -0.7) galaxy3=galaxy(iter=2400, z=z3) %>% ggplot(aes(x,y))+ geom_point(shape= 8, size=jitter(12, factor=4), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=16, size= jitter(4, factor=2), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=46, size= 0, color="#ffff00")+opt #Fourth galaxy z4=c(-1.2, -0.6, -0.5, 0.1, -0.7, 0.2, -0.9, 0.9, 0.1, -0.3, -0.9, 0.3) galaxy4=galaxy(iter=2400, z=z4) %>% ggplot(aes(x,y))+ geom_point(shape= 8, size=jitter(12, factor=4), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=16, size= jitter(4, factor=2), color="#ffff99", alpha=jitter(.05, factor=2))+ geom_point(shape=46, size= 0, color="#ffff00")+opt  The Breathtaking 1-Matrix La luna sale a caminar siguiendo tus pupilas (Ojos color sol, Calle 13) This is a 5×5 1-matrix: $\begin{bmatrix} 1 &1 &1 &1 &1 \\ 1 &1 &1 &1 &1 \\ 1 &1 &1 &1 &1 \\ 1 &1 &1 &1 &1 \\ 1 &1 &1 &1 &1 \end{bmatrix}$ And this is a 20×20 1-matrix visualized: Maybe in some other galaxy, aliens represent matrix in this way. par(mar = c(1, 1, 1, 1), bg="violetred4") circlize::chordDiagram(matrix(1, 20, 20), col="white", symmetric = TRUE, transparency = 0.85, annotationTrack = NULL)  Gummy Worms Just keep swimming (Dory in Finding Nemo) Inspired by this post, I decided to create gummy worms like this: Or these: When I was young I used to eat them. Do you want to try? This is the code: library(rgl) library(RColorBrewer) t=seq(1, 6, by=.04) f = function(a, b, c, d, e, f, t) exp(-a*t)*sin(t*b+c)+exp(-d*t)*sin(t*e+f) v1=runif(6,0,1e-02) v2=runif(6, 2, 3) v3=runif(6,-pi/2,pi/2) open3d() spheres3d(x=f(v1[1], v2[1], v3[1], v1[4], v2[4], v3[4], t), y=f(v1[2], v2[2], v3[2], v1[5], v2[5], v3[5], t), z=f(v1[3], v2[3], v3[3], v1[6], v2[6], v3[6], t), radius=.3, color=sample(brewer.pal(8, "Dark2"),1))  Playing With Julia (Set) Viento, me pongo en movimiento y hago crecer las olas del mar que tienes dentro (Tercer Movimiento: Lo de Dentro, Extremoduro) I really enjoy drawing complex numbers: it is a huge source of entertainment for me. In this experiment I play with the Julia Set, another beautiful fractal like this one. This is what I have done: • Choosing the function f(z)=exp(z3)-0.621 • Generating a grid of complex numbers with both real and imaginary parts in [-2, 2] • Iterating f(z) over the grid a number of times so zn+1 = f(zn) • Drawing the resulting grid as I did here • Gathering all plots into a GIF with ImageMagick as I did in my previous post: each frame corresponds to a different number of iterations This is the result: I love how easy is doing difficult things in R. You can play with the code changing f(z) as well as color palettes. Be ready to get surprised: library(ggplot2) library(dplyr) library(RColorBrewer) setwd("YOUR WORKING DIRECTORY HERE") dir.create("output") setwd("output") f = function(z,c) exp(z^3)+c # Grid of complex z0 <- outer(seq(-2, 2, length.out = 1200),1i*seq(-2, 2, length.out = 1200),'+') %>% c() opt <- theme(legend.position="none", panel.background = element_rect(fill="white"), plot.margin=grid::unit(c(1,1,0,0), "mm"), panel.grid=element_blank(), axis.ticks=element_blank(), axis.title=element_blank(), axis.text=element_blank()) for (i in 1:35) { z=z0 # i iterations of f(z) for (k in 1:i) z <- f(z, c=-0.621) df=data.frame(x=Re(z0), y=Im(z0), z=as.vector(exp(-Mod(z)))) %>% na.omit() p=ggplot(df, aes(x=x, y=y, color=z)) + geom_tile() + scale_x_continuous(expand=c(0,0))+ scale_y_continuous(expand=c(0,0))+ scale_colour_gradientn(colours=brewer.pal(8, "Paired")) + opt ggsave(plot=p, file=paste0("plot", stringr::str_pad(i, 4, pad = "0"),".png"), width = 1.2, height = 1.2) } # Place the exact path where ImageMagick is installed system('"C:\\Program Files\\ImageMagick-6.9.3-Q16\\convert.exe" -delay 20 -loop 0 *.png julia.gif') # cleaning up file.remove(list.files(pattern=".png"))  Zooming You don’t have to be beautiful to turn me on (Kiss, Prince) I discovered recently how easy is to create GIFs with R using ImageMagick and I feel like a kid with a new toy. To begin this new era of my life as R programmer I have done this: First of all, read this article: it explains very well how to start doing GIFs from scratch. The one I have done is inspired in this previous post where I take a set of complex numbers to transform and color it using HSV technique. In this case I use this next transformation: $f(z)= -Im(z)+(Re(z)+0.5*Im(z))*1i$ Modifying the range of Real and Imaginary parts of complex numbers I obtain the zooming effect. The code is very simple. Play with it changing the transformation or the animation options. Send me your creations, I would love to see them: library(dplyr) library(ggplot2) dir.create("output") setwd("output") id=1 # label tO name plots for (i in seq(from=320, to=20, length.out = 38)){ z=outer(seq(from = -i, to = i, length.out = 300),1i*seq(from = -i, to = i, length.out = 500),'+') %>% c() z0=z for (k in 1:100) z <- -Im(z)+(Re(z)+0.5*Im(z))*1i df=data.frame(x=Re(z0), y=Im(z0), h=(Arg(z)<0)*1+Arg(z)/(2*pi), s=(1+sin(2*pi*log(1+Mod(z))))/2, v=(1+cos(2*pi*log(1+Mod(z))))/2) %>% mutate(col=hsv(h,s,v)) ggplot(df, aes(x, y)) + geom_tile(fill=df$col)+
scale_x_continuous(expand=c(0,0))+
scale_y_continuous(expand=c(0,0))+
labs(x=NULL, y=NULL)+
theme(legend.position="none",
panel.background = element_rect(fill="white"),
plot.margin=grid::unit(c(1,1,0,0), "mm"),
panel.grid=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank(),
axis.text=element_blank())
id=id+1
}
system('"C:\\Program Files\\ImageMagick-6.9.3-Q16\\convert.exe" -delay 10 -loop 0 -duplicate 1,-2-1 *.png zooming.gif')
# cleaning up
file.remove(list.files(pattern=".png"))


The Coaster Maker by Shiny

The word you invented is well formed and could be used in the Italian language (The Accademia della Crusca regarding to the word “Petaloso”, recently invented by an eight-year-old boy)

Are you tired of your old coasters? Do you like to make things by your own? Do you have a PC and a printer at home? If you answered yes to all these questions, just follow these simple instructions:

• Install R and RStudio in your PC
• Open RStudio and create a new Shiny Web App multiple file (ui.R/server.R)
• Substitute sample code of each file by the code below
• Press Run App
• Press buttom Get your coaster! until you obtain a image you like
• Print the image
• Cut out the image
• Place on the coaster your favorite drinking

These are some examples:

This is the code of ui.R

#
# This is the user-interface definition of a Shiny web application. You can
# run the application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#
library(shiny)
shinyUI(fluidPage(
titlePanel("The coaster maker"),
sidebarLayout(
sidebarPanel(
#helpText(),

# adding the new div tag to the sidebar
tags$div(class="header", checked=NA, tags$p("This coasters are generated by hypocycloid curves.The curve is formed by the locus of a point,
attached to a circle, that rolls on the inside of another circle.
In the curve's equation the first part denotes the relative position between the two circles,
the second part denotes the rotation of the rolling circle.")),
tags$div(class="header", checked=NA, HTML( "More info <a href=\"http://www.2dcurves.com/roulette/rouletteh.html#rhodon\">here</a>")), actionButton('rerun','Get your coaster!') ), mainPanel( plotOutput("HarmPlot") ) ) ))  This is the code of server.R # This is the server logic of a Shiny web application. You can run the # application by clicking 'Run App' above. # # Find out more about building applications with Shiny here: # # http://shiny.rstudio.com/ # library(shiny) library(ggplot2) CreateDS = function () { t=seq(-31*pi, 31*pi, 0.002) a=sample(seq(from=1/31, to=29/31, by=2/31), 1) b=runif(1, min = 1, max = 3) data.frame(x=(1-a)*cos(a*t)+a*b*cos((1-a)*t), y=(1-a)*sin(a*t)-a*b*sin((1-a)*t)) } shinyServer(function(input, output) { dat<-reactive({if (input$rerun) dat=CreateDS() else dat=CreateDS()})
output$HarmPlot<-renderPlot({ ggplot(dat())+ geom_point(data=data.frame(x=0,y=0), aes(x,y), color=rgb(rbeta(1, .5, .5), rbeta(1, .5, .5), rbeta(1, .5, .5)) , shape=19, fill="yellow", size=220)+ geom_polygon(aes(x, y), fill=rgb(rbeta(1, 2, 2), rbeta(1, 2, 2), rbeta(1, 2, 2))) + theme(legend.position="none", panel.background = element_rect(fill="white"), panel.grid=element_blank(), axis.ticks=element_blank(), axis.title=element_blank(), axis.text=element_blank()) }, height = 500, width = 500) })  Sunflowers The world is full of wonderful things, like sunflowers (Machanguito, my islander friend) Sunflower seeds are arranged following a mathematical pattern where golden ratio plays a starring role. There are tons of web sites explaining this amazing fact. In general, the arrangement of leaves on a plant stem are ruled by spirals. This fact is called phyllotaxis, and I did this experiment about it some time ago. Voronoi tessellation originated by points arranged according the golden angle spiral give rise to this sunflowers: I know this drawing will like to my friend Machanguito because he loves sunflowers. He also loves dancing, chocolate cookies, music and swimming in the sea. Machanguito loves life, it is just that simple. He is also a big defender of renewable energy and writes down his thoughts on recycled papers. You can follow his adventures here. This is the code: library(deldir) library(ggplot2) library(dplyr) opt = theme(legend.position = "none", panel.background = element_rect(fill="red4"), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), axis.text = element_blank()) CreateSunFlower <- function(nob=500, dx=0, dy=0) { data.frame(r=sqrt(1:nob), t=(1:nob)*(3-sqrt(5))*pi) %>% mutate(x=r*cos(t)+dx, y=r*sin(t)+dy) } g=seq(from=0, by = 45, length.out = 4) jitter(g, amount=2) %>% expand.grid(jitter(g, amount=2)) %>% apply(1, function(x) CreateSunFlower(nob=round(jitter(220, factor=15)), dx=x[1], dy=x[2])) %>% do.call("rbind", .) %>% deldir() %>% .$dirsgs -> sunflowers
ggplot(sunflowers) +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="greenyellow") +
scale_x_continuous(expand=c(0,0))+
scale_y_continuous(expand=c(0,0))+
opt