Beautiful Curves: The Harmonograph

Each of us has their own mappa mundi (Gala, my indispensable friend)

The harmonograph is a mechanism which, by means of several pendulums, draws trajectories that can be analyzed not only from a mathematical point of view but also from an artistic one. In its double pendulum version, one pendulum moves a pencil and the other one moves a platform with a piece of paper on it. You can see an example here. The harmonograph is easy to use: you only have to put pendulums into motion and wait for them to stop. The result are amazing undulating drawings like this one:

grafico0x2First harmonographs were built in 1857 by Scottish mathematician Hugh Blackburn, based on the previous work of French mathematician Jean Antoine Lissajous. There is not an unique way to describe mathematically the motion of the pencil. I have implemented the one I found in this sensational blog, where motion in both x and y axis depending on time is defined by:

<br /> x(t)=e^{-d_{1}t}sin(f_{1}t+p_{1})+e^{-d_{2}t}sin(f_{2}t+p_{2})\\<br /> y(t)=e^{-d_{3}t}sin(f_{3}t+p_{3})+e^{-d_{4}t}sin(f_{4}t+p_{4})<br />

I initialize parameters randomly so every time you run the script, you obtain a different output. Here is a mosaic with some of mine:
Collage3

This is the code to simulate the harmonograph (no extra package is required). If you create some nice work of art, I will be very happy to admire it (you can find my email here):

f1=jitter(sample(c(2,3),1));f2=jitter(sample(c(2,3),1));f3=jitter(sample(c(2,3),1));f4=jitter(sample(c(2,3),1))
d1=runif(1,0,1e-02);d2=runif(1,0,1e-02);d3=runif(1,0,1e-02);d4=runif(1,0,1e-02)
p1=runif(1,0,pi);p2=runif(1,0,pi);p3=runif(1,0,pi);p4=runif(1,0,pi)
xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
t=seq(1, 100, by=.001)
dat=data.frame(t=t, x=xt(t), y=yt(t))
with(dat, plot(x,y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))

9 thoughts on “Beautiful Curves: The Harmonograph

  1. Great post!
    I made an alternative with the time colored in rainbow scale and you can see the harmonogram (is that the word?) actually growing:

    f1=jitter(sample(c(2,3),1));f2=jitter(sample(c(2,3),1));f3=jitter(sample(c(2,3),1));f4=jitter(sample(c(2,3),1))
    d1=runif(1,0,1e-02);d2=runif(1,0,1e-02);d3=runif(1,0,1e-02);d4=runif(1,0,1e-02)
    p1=runif(1,0,pi);p2=runif(1,0,pi);p3=runif(1,0,pi);p4=runif(1,0,pi)
    xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
    yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
    t=seq(1, 100, by=.001)
    dat=data.frame(t=t, x=xt(t), y=yt(t))
    COL <- rainbow(nrow(dat))
    plot(dat$x, dat$y, type = "n", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n')
    for (i in 1:nrow(dat)) points(dat$x[i], dat$y[i], col = COL[i], pch = 16, cex = 0.2)

    Cheers, Andrej

    1. It’s nice! I like it! The next step is to control time to avoid the way R has to throw points in “buckets”. Do you want to try? 🙂 Thank you very much!

      1. No prob! Just flush the graphic device after each point;

        for (i in 1:nrow(dat)) {
        points(dat$x[i], dat$y[i], col = COL[i], pch = 16, cex = 0.2)
        dev.flush()
        }

  2. I am just discovering this very old post. By now I am sure you’ve extended this to 3D.

    If not:
    library(plotly)

    f1=jitter(sample(c(2,3),1));f2=jitter(sample(c(2,3),1));f3=jitter(sample(c(2,3),1));f4=jitter(sample(c(2,3),1));
    f5=jitter(sample(c(2,3),1));f6=jitter(sample(c(2,3),1))
    d1=runif(1,0,1e-02);d2=runif(1,0,1e-02);d3=runif(1,0,1e-02);d4=runif(1,0,1e-02);d5=runif(1,0,1e-02);d6=runif(1,0,1e-02)
    p1=runif(1,0,pi);p2=runif(1,0,pi);p3=runif(1,0,pi);p4=runif(1,0,pi);p5=runif(1,0,pi);p6=runif(1,0,pi)
    xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
    yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
    zt = function(t) exp(-d5*t)*sin(t*f5+p5)+exp(-d6*t)*sin(t*f6+p6)
    t=seq(1, 200, by=.001)
    dat=data.frame(t=t, x=xt(t), y=yt(t), z = zt(t))
    color_samp%
    add_paths(line = list(color = color_samp, linesize = 0.1)) %>%
    layout(scene = list(xaxis = list(title = ”, autorange = TRUE, showgrid = FALSE, zeroline = FALSE, showline = FALSE, autotick = TRUE, ticks = ”, showticklabels = FALSE),
    yaxis = list(title = ”, autorange = TRUE, showgrid = FALSE, zeroline = FALSE, showline = FALSE, autotick = TRUE, ticks = ”, showticklabels = FALSE),
    zaxis = list(title = ”, autorange = TRUE, showgrid = FALSE, zeroline = FALSE, showline = FALSE, autotick = TRUE, ticks = ”, showticklabels = FALSE)
    )
    )

    I’ve come up with some beautiful patterns. Thank you for the inspiration.

Leave a Reply to A.N. Spiess Cancel reply

Your email address will not be published. Required fields are marked *