Home > Misc

# Fractal words

Many years ago, a then-fellow-postgrad showed me a fractal, similar to the above, which he'd generated in PostScript. (Examples here.) The amusing point was that you could send these iterated function systems off to the physics department's PostScript-enabled printer, having it calculate tens of thousands of numbers and preventing anyone else from printing anything on it for hours on end.

Those old fractals popped into my head the other week, and I thought it'd be fun to try to recreate them (in R) from scratch. I couldn't remember anything about how to make them – in particular, I didn't know about (and didn't re-discover!) the method of picking some random points and applying various functions to them in what is apparently the normal way for IFS fractals. Instead all calculations were deterministic: each letter is broken down into strokes, and each stroke is filled in with the strokes of the whole word, iterated until the strokes are only a couple of pixels in length.

The size of the letters decays very quickly with each iteration; this picture is 4000 pixels wide, and looks quite nice to my biased eye, but you can only read the word at three levels of iteration.

My implementation must be among the slowest ever for this sort of thing – the code at the end of this page can churn away for ten minutes or so to make a moderate-sized image, and it took 24 minutes for the large image linked in the previous paragraph.

The code itself looks enormous, but the vast bulk of it is just me defining parametric curves for each letter of the alphabet. After putting all of the relevant strokes into the base_strokes list, the real work is done by the write_fractal and pixel_points functions – write_fractal is the function that gets iterated, with pixel_points calculating the pixel locations of the stroke at each iteration.

Each stroke is defined by two curves, one giving the top and one the bottom ("top" and "bottom" refer to the orientation of the next iteration of letters to be drawn). The top curves are parametrised by the vectors x1 and y1 (or something similar, ending with a '1' subscript); bottom curves by x2 and y2.

``````library(EBImage)

tau <<- 2*pi

# Size in pixels of final image:
N = 320
M = 640

# At full letter_width = 1, letters might look
# too close to each other, especially if they
# have vertical strokes right next to each other.
letter_width = 1
letter_width = min(1, letter_width)
letter_width = max(0.1, letter_width)

fractal_str = "FRACTAL"

fractal_str = toupper(fractal_str)

max_iter <<- ceiling(log(M) / log(nchar(fractal_str)))

# Matrix to hold the image:
fractal_img <<- matrix(rep(0, N*M), ncol=M, nrow=N)

# Discretisation of the parametric curves defining the strokes,
# with t in [0, 1].
delta_t <<- 0.01

letter_a = function() {
# Returns a list of parametric curves for the letter A.
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - 0.9*t

x1_2 = 0.12 + 0*t
y1_2 = 1 - 0.9*t

# Stroke 2:
x2_1 = seq(0.02, 0.98, length.out = n)
y2_1 = 0*t

x2_2 = x2_1
y2_2 = 0.1 + 0*t

# Stroke 3:
x3_1 = 0.98 + 0*t
y3_1 = 0.1 + 0.9*t

x3_2 = 0.88 + 0*t
y3_2 = 0.1 + 0.9*t

# Stroke 4:

x4_1 = seq(0.12, 0.88, length.out = n)
y4_1 = 0.4 + 0*t

x4_2 = x4_1
y4_2 = 0.5 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2),
list(x1 = x4_1, y1 = y4_1, x2 = x4_2, y2 = y4_2)))
}

letter_b = function() {
# Returns a list of parametric curves for the letter B.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
t = seq(-tau/4, tau/4, length.out = length(t))
x2_1 = 0.12 + 0.86*cos(t)
y2_1 = 0.75 + 0.25*sin(t)

x2_2 = 0.12 + 0.76*cos(t)
y2_2 = 0.75 + 0.15*sin(t)

# Stroke 3:
x3_1 = 0.12 + 0.86*cos(t)
y3_1 = 0.25 + 0.25*sin(t)

x3_2 = 0.12 + 0.76*cos(t)
y3_2 = 0.25 + 0.15*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_c = function() {
t = seq(0, 1, by=delta_t)

t_max = 0.8*tau
t_min = 0.2*tau

t = seq(t_max, t_min, length.out = length(t))

# (x, y) = (a*cos(t), b*sin(t))
a = (0.98 - 0.02) / (cos(t_min) + 1)
x0 = a + 0.02

x1_1 = x0 + a*cos(t)
y1_1 = 0.5 - 0.5*sin(t)

x1_2= x0 + (a - 0.1)*cos(t)
y1_2 = 0.5 - 0.4*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2)))
}

letter_d = function() {
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
t = seq(-tau/4, tau/4, length.out = length(t))
x2_1 = 0.12 + 0.86*cos(t)
y2_1 = 0.5 + 0.5*sin(t)

x2_2 = 0.12 + 0.76*cos(t)
y2_2 = 0.5 + 0.4*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_e = function() {
# Returns a list of parametric curves for the letter E.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = 0.12 + (0.98 - 0.12)*t
y2_1 = 0 + 0*t

x2_2 = 0.12 + (0.98 - 0.12)*t
y2_2 = 0.1 + 0*t

# Stroke 3:
x3_1 = 0.12 + (0.98 - 0.12)*t
y3_1 = 0.45 + 0*t

x3_2 = 0.12 + (0.98 - 0.12)*t
y3_2 = 0.55 + 0*t

# Stroke 4:
x4_1 = 0.12 + (0.98 - 0.12)*t
y4_1 = 0.9 + 0*t

x4_2 = 0.12 + (0.98 - 0.12)*t
y4_2 = 1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2),
list(x1 = x4_1, y1 = y4_1, x2 = x4_2, y2 = y4_2)))
}

letter_f = function() {
# Returns a list of parametric curves for the letter E.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = 0.12 + (0.98 - 0.12)*t
y2_1 = 0 + 0*t

x2_2 = 0.12 + (0.98 - 0.12)*t
y2_2 = 0.1 + 0*t

# Stroke 3:
x3_1 = 0.12 + (0.98 - 0.12)*t
y3_1 = 0.45 + 0*t

x3_2 = 0.12 + (0.98 - 0.12)*t
y3_2 = 0.55 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_g = function() {
t = seq(0, 1, by=delta_t)

t_min = 0.2*tau

# (x, y) = (a*cos(t), b*sin(t))
a = (0.98 - 0.02) / (cos(t_min) + 1)
x0 = a + 0.02

t_max = tau - acos((0.88 - x0)/a)

print(t_max/tau)

t = seq(t_max, t_min, length.out = length(t))

# Stroke 1:
x1_1 = x0 + a*cos(t)
y1_1 = 0.5 - 0.5*sin(t)

x1_2 = x0 + (a - 0.1)*cos(t)
y1_2 = 0.5 - 0.4*sin(t)

# Stroke 2:
t = seq(0, 1, by=delta_t)

x2_1 = 0.88 + 0*t
y2_1 = 1 - 0.45*t

x2_2 = 0.98 - 0*t
y2_2 = 1 - 0.45*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_h = function() {
# Returns a list of parametric curves for the letter H.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = 0.12 + (0.88 - 0.12)*t
y2_1 = 0.45 + 0*t

x2_2 = 0.12 + (0.88 - 0.12)*t
y2_2 = 0.55 + 0*t

# Stroke 3:
x3_1 = 0.88 + 0*t
y3_1 = 1 - t

x3_2 = 0.98 + 0*t
y3_2 = 1 - t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_i = function() {
# Returns a list of parametric curves for the letter I.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.45 + 0*t
y1_1 = 0.9 - 0.8*t

x1_2 = 0.55 + 0*t
y1_2 = 0.9 - 0.8*t

# Stroke 2:
x2_1 = 0.3 + 0.4*t
y2_1 = 0*t

x2_2 = 0.3 + 0.4*t
y2_2 = 0.1 + 0*t

# Stroke 3:
x3_1 = 0.3 + 0.4*t
y3_1 = 0.9 + 0*t

x3_2 = 0.3 + 0.4*t
y3_2 = 1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_j = function() {
t = seq(0, 1, by=delta_t)

t = seq(-tau/2, 0, length.out = length(t) - 1)

# Stroke 1:
x1_1 = c(0.5 + 0.15*cos(t), 0.65)
y1_1 = c(0.75 - 0.15*sin(t), 0.1)

x1_2 = c(0.5 + 0.25*cos(t), 0.75)
y1_2 = c(0.75 - 0.25*sin(t), 0.1)

# Stroke 2:
t = seq(0, 1, by=delta_t)

x2_1 = 0.5 + 0.4*t
y2_1 = 0 + 0*t

x2_2 = 0.5 + 0.4*t
y2_2 = 0.1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_k = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = seq(0.22, 0.98, length.out = n)
y2_1 = seq(0.5, 1, length.out = n)

x2_2 = seq(0.12, 0.88, length.out = n)
y2_2 = seq(0.5, 1, length.out = n)

# Stroke 3:
x3_1 = seq(0.12, 0.88, length.out = n)
y3_1 = seq(0.5, 0, length.out = n)

x3_2 = seq(0.22, 0.98, length.out = n)
y3_2 = seq(0.5, 0, length.out = n)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_l = function() {
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = seq(0.12, 0.98, length.out = length(t))
y2_1 = 0.9 + 0*t

x2_2 = x2_1
y2_2 = 1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_m = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = seq(0.12, 0.5, length.out = n)
y2_1 = seq(0, 0.4, length.out = n)

x2_2 = seq(0.12, 0.5, length.out = n)
y2_2 = seq(0.1, 0.5, length.out = n)

# Stroke 3:
x3_1 = seq(0.5, 0.88, length.out = n)
y3_1 = seq(0.4, 0, length.out = n)

x3_2 = seq(0.5, 0.88, length.out = n)
y3_2 = seq(0.5, 0.1, length.out = n)

# Stroke 4:
x4_1 = 0.98 + 0*t
y4_1 = t

x4_2 = 0.88 + 0*t
y4_2 = t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2),
list(x1 = x4_1, y1 = y4_1, x2 = x4_2, y2 = y4_2)))
}

letter_n = function() {
# Returns a list of parametric curves for the letter N.
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
x2_1 = 0.12 + (0.88 - 0.12)*t
y2_1 = seq(0, 1 - 0.1*sqrt(2), length.out = n)

x2_2 = 0.12 + (0.88 - 0.12)*t
y2_2 = seq(0.1*sqrt(2), 1, length.out = n)

# Stroke 3:
x3_1 = 0.88 + 0*t
y3_1 = 1 - t

x3_2 = 0.98 + 0*t
y3_2 = 1 - t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_o = function() {
t = seq(0, 1, by=delta_t)

t = seq(tau/4, -tau/4, length.out = length(t))

# Stroke 1:
x1_1 = 0.5 + 0.48*cos(t)
y1_1 = 0.5 - 0.5*sin(t)

x1_2 = 0.5 + 0.38*cos(t)
y1_2 = 0.5 - 0.4*sin(t)

# Stroke 2:
x2_1 = 0.5 - 0.48*cos(t)
y2_1 = 0.5 + 0.5*sin(t)

x2_2 = 0.5 - 0.38*cos(t)
y2_2 = 0.5 + 0.4*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_p = function() {
# Returns a list of parametric curves for the letter P.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
t = seq(-tau/4, tau/4, length.out = length(t))
x2_1 = 0.12 + 0.86*cos(t)
y2_1 = 0.25 + 0.25*sin(t)

x2_2 = 0.12 + 0.76*cos(t)
y2_2 = 0.25 + 0.15*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

q_stroke_t = function(a, b, m, c) {
# Ellipse for the main part of the letter Q
# is defined by (x, y) = (a*cos(t), b*sin(t))
#
# The straight stroke is a line y = m*x + c.
# This function returns the intersection time t.

t0 = 0.15*tau

for (ct in 1:5) {
t0 = t0 - (a*m*cos(t0) - b*sin(t0) + c) / (-a*m*sin(t0) - b*cos(t0))
}

return(t0)
}

letter_q = function() {
# Returns a list of parametric curves for the letter P.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = seq(0.5 + 0.1/sqrt(2), 0.75 + 0.1/sqrt(2), length.out = length(t))
y1_1 = seq(0.75 - 0.1/sqrt(2), 1 - 0.1/sqrt(2), length.out = length(t))

x1_2 = seq(0.5, 0.75, length.out = length(t))
y1_2 = seq(0.75, 1, length.out = length(t))

# Stroke 2:
a = 0.48
b = 0.5

t0 = q_stroke_t(a, b, 1, 0.25)
t = seq(t0, 3*tau/4, length.out = length(t))

x2_1 = 0.5 + a*cos(t)
y2_1 = 0.5 + b*sin(t)

a = 0.38
b = 0.4
t0 = q_stroke_t(a, b, 1, 0.25)
t = seq(t0, 3*tau/4, length.out = length(t))

x2_2 = 0.5 + a*cos(t)
y2_2 = 0.5 + b*sin(t)

# Stroke 3:
a = 0.48
b = 0.5

t0 = q_stroke_t(a, b, 1, 0.25 - .1*sqrt(2))
t = seq(3*tau/4, tau+t0, length.out = length(t))

x3_1 = 0.5 + a*cos(t)
y3_1 = 0.5 + b*sin(t)

a = 0.38
b = 0.4
t0 = q_stroke_t(a, b, 1, 0.25 - .1*sqrt(2))
t = seq(3*tau/4, tau+t0, length.out = length(t))

x3_2 = 0.5 + a*cos(t)
y3_2 = 0.5 + b*sin(t)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_r = function() {
# Returns a list of parametric curves for the letter R.
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.02 + 0*t
y1_1 = 1 - t

x1_2 = 0.12 + 0*t
y1_2 = 1 - t

# Stroke 2:
t = seq(-tau/4, tau/4, length.out = length(t))
x2_1 = 0.12 + 0.86*cos(t)
y2_1 = 0.25 + 0.25*sin(t)

x2_2 = 0.12 + 0.76*cos(t)
y2_2 = 0.25 + 0.15*sin(t)

# Stroke 3:
t = seq(0, 1, by=delta_t)
x3_1 = seq(0.12 + 0.1*sqrt(2), 0.98, length.out = length(t))
y3_1 = 0.5 + 0.5*t

x3_2 = seq(0.12, 0.98 - 0.1*sqrt(2), length.out = length(t))
y3_2 = 0.5 + 0.5*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_s = function() {
t = seq(0, 1, by=delta_t)
t = seq(tau/4, 3*tau/4, length.out = length(t) - 1)

# Stroke 1:
x1_1 = c(0.5 + 0.48*cos(t), 0.98)
y1_1 = c(0.275 + 0.275*sin(t), 0)

x1_2 = c(0.5 + 0.38*cos(t), 0.98)
y1_2 = c(0.275 + 0.175*sin(t), 0.1)

# Stroke 2:
t = seq(tau/4, -tau/4, length.out = length(t))
x2_1 = c(0.02, 0.5 + 0.38*cos(t))
y2_1 = c(0.9, 0.725 + 0.175*sin(t))

x2_2 = c(0.02, 0.5 + 0.48*cos(t))
y2_2 = c(1, 0.725 + 0.275*sin(t))

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_t = function() {
t = seq(0, 1, by=delta_t)

# Stroke 1:
x1_1 = 0.45 + 0*t
y1_1 = 1 - 0.9*t

x1_2 = 0.55 + 0*t
y1_2 = 1 - 0.9*t

# Stroke 2:
x2_1 = seq(0.02, 0.98, length.out = length(t))
y2_1 = 0*t

x2_2 = x2_1
y2_2 = 0.1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_u = function() {
t = seq(0, 1, by=delta_t)
t = seq(tau/4, 0, length.out = length(t) - 1)

# Stroke 1:
x1_1 = c(0.5 + 0.38*cos(t), 0.88)
y1_1 = c(0.75 + 0.15*sin(t), 0)

x1_2 = c(0.5 + 0.48*cos(t), 0.98)
y1_2 = c(0.75 + 0.25*sin(t), 0)

# Stroke 2:
t = seq(0, tau/4, length.out = length(t))
x2_1 = c(0.12, 0.5 - 0.38*cos(t))
y2_1 = c(0, 0.75 + 0.15*sin(t))

x2_2 = c(0.02, 0.5 - 0.48*cos(t))
y2_2 = c(0, 0.75 + 0.25*sin(t))

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_v = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = seq(0.02, 0.5, length.out = n)
y1_1 = (1 - sqrt(2)*0.1)*t

x1_2 = x1_1
y1_2 = y1_1 + sqrt(2)*0.1

# Stroke 2:
x2_1 = seq(0.5, 0.98, length.out = n)
y2_1 = (1 - sqrt(2)*0.1)*(1 - t)

x2_2 = x2_1
y2_2 = y2_1 + sqrt(2)*0.1

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2)))
}

letter_w = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = 0.12 + 0*t
y1_1 = t

x1_2 = 0.02 + 0*t
y1_2 = t

# Stroke 2:
x2_1 = seq(0.12, 0.5, length.out = n)
y2_1 = seq(0.9, 0.5, length.out = n)

x2_2 = seq(0.12, 0.5, length.out = n)
y2_2 = seq(1, 0.6, length.out = n)

# Stroke 3:
x3_1 = seq(0.5, 0.88, length.out = n)
y3_1 = seq(0.5, 0.9, length.out = n)

x3_2 = seq(0.5, 0.88, length.out = n)
y3_2 = seq(0.6, 1, length.out = n)

# Stroke 4:
x4_1 = 0.88 + 0*t
y4_1 = 1 - t

x4_2 = 0.98 + 0*t
y4_2 = 1 - t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2),
list(x1 = x4_1, y1 = y4_1, x2 = x4_2, y2 = y4_2)))
}

letter_x = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = seq(0.02, 0.98, length.out = n)
y1_1 = seq(1 - 0.1*sqrt(2), 0, length.out = n)

x1_2 = x1_1
y1_2 = y1_1 + 0.1*sqrt(2)

# Stroke 2:
# The second and third strokes will be either side of the first stroke.
# Need to find the intersection points.  'a' for top of stroke, 'b' for
# bottom of stroke.

m1a = (0.1*sqrt(2) - 1) / 0.96
c1a = -m1a*0.98

m1b = m1a
c1b = c1a + 0.1*sqrt(2)

m2a = (1 - 0.1*sqrt(2)) / 0.96
c2a = -m2a*0.02

m2b = m2a
c2b = c2a + 0.1*sqrt(2)

x0 = (c2a - c1a) / (m1a - m2a)
y0 = m1a*x0 + c1a

x2_1 = seq(0.02, x0, length.out = n)
y2_1 = seq(0, y0, length.out = n)

x0 = (c2b - c1a) / (m1a - m2b)
y0 = m1a*x0 + c1a

x2_2 = seq(0.02, x0, length.out = n)
y2_2 = seq(0.1*sqrt(2), y0, length.out = n)

# Stroke 3:
x0 = (c2a - c1b) / (m1b - m2a)
y0 = m1b*x0 + c1b

x3_1 = seq(x0, 0.98, length.out = n)
y3_1 = seq(y0, 1 - 0.1*sqrt(2), length.out = n)

x0 = (c2b - c1b) / (m1b - m2b)
y0 = m1b*x0 + c1b

x3_2 = seq(x0, 0.98, length.out = n)
y3_2 = seq(y0, 1, length.out = n)

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_y = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = seq(0.02, 0.5, length.out = n)
y1_1 = 0.4*t

x1_2 = x1_1
y1_2 = y1_1 + 0.1*sqrt(2)

# Stroke 2:
x2_1 = seq(0.5, 0.98, length.out = n)
y2_1 = y1_1[n:1]

x2_2 = x2_1
y2_2 = y1_2[n:1]

# Stroke 3:
x3_1 = 0.45 + 0*t
y3_1 = 1 - 0.5*t

x3_2 = 0.55 + 0*t
y3_2 = y3_1

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_z = function() {
t = seq(0, 1, by=delta_t)
n = length(t)

# Stroke 1:
x1_1 = seq(0.02, 0.98, length.out = n)
y1_1 = 0*t

x1_2 = x1_1
y1_2 = 0.1 + 0*t

# Stroke 2:
x2_1 = seq(0.02, 0.98 -0.1*sqrt(2), length.out = n)
y2_1 = seq(0.9, 0.1, length.out = n)

x2_2 = seq(0.02 + 0.1*sqrt(2), 0.98, length.out = n)
y2_2 = y2_1

# Stroke 3:
x3_1 = x1_1
y3_1 = 0.9 + 0*t

x3_2 = x1_1
y3_2 = 1 + 0*t

return(list(list(x1 = x1_1, y1 = y1_1, x2 = x1_2, y2 = y1_2),
list(x1 = x2_1, y1 = y2_1, x2 = x2_2, y2 = y2_2),
list(x1 = x3_1, y1 = y3_1, x2 = x3_2, y2 = y3_2)))
}

letter_strokes = function(letter_str) {
switch(letter_str,
A = letter_a(),
B = letter_b(),
C = letter_c(),
D = letter_d(),
E = letter_e(),
F = letter_f(),
G = letter_g(),
H = letter_h(),
I = letter_i(),
J = letter_j(),
K = letter_k(),
L = letter_l(),
M = letter_m(),
N = letter_n(),
O = letter_o(),
P = letter_p(),
Q = letter_q(),
R = letter_r(),
S = letter_s(),
T = letter_t(),
U = letter_u(),
V = letter_v(),
W = letter_w(),
X = letter_x(),
Y = letter_y(),
Z = letter_z()
)
}

# Create the set of strokes needed to write the word.

num_chars = nchar(fractal_str)

char_width = 1/num_chars
letter_gap = (1 - letter_width)/2

for (i in 1:num_chars) {
this_char = substr(fractal_str, i, i)

this_strokes = letter_strokes(this_char)

start_x = (i - 1 + letter_gap)*char_width
end_x = (i - letter_gap)*char_width

for (j in 1:length(this_strokes)) {
this_strokes[[j]]\$x1 = start_x + this_strokes[[j]]\$x1*letter_width / num_chars
this_strokes[[j]]\$x2 = start_x + this_strokes[[j]]\$x2*letter_width / num_chars
}

if (i == 1) {
base_strokes = this_strokes
} else {
base_strokes = c(base_strokes, this_strokes)
}
}

assign("base_strokes", value=base_strokes, pos=globalenv())

regularise_stroke = function(x, y) {
# Function to convert a stroke into segments of equal length.

n = length(x)

xi = x[1:(n-1)]
yi = y[1:(n-1)]

xf = x[2:n]
yf = y[2:n]

arc_lengths = sqrt((xf - xi)^2 + (yf - yi)^2)

if (max(arc_lengths) - min(arc_lengths) > 1) {
total_length = sum(arc_lengths)
cumul_lengths = c(0, cumsum(arc_lengths))

delta_length = total_length / (n-1)

reg_cumul_lengths = seq(delta_length, total_length, by=delta_length)

indices_floor = sapply(reg_cumul_lengths, function(x) max(which(cumul_lengths < x)))
indices_ceiling = sapply(reg_cumul_lengths, function(x) min(which(cumul_lengths >= x)))
interp_dist = (reg_cumul_lengths - cumul_lengths[indices_floor]) / (cumul_lengths[indices_ceiling] - cumul_lengths[indices_floor])

reg_x = x
reg_y = y

reg_x[2:n] = x[indices_floor] + interp_dist * (x[indices_ceiling] - x[indices_floor])
reg_y[2:n] = y[indices_floor] + interp_dist * (y[indices_ceiling] - y[indices_floor])

return(list(x=reg_x, y=reg_y))
} else {
return(list(x=x, y=y))
}

}

pixel_points = function(stroke_x, stroke_y, x1, y1, x2, y2, iter_level) {
# Returns pixel locations of the stroke in the next iteration of the fractal.
# stroke_x and stroke_y are from base_strokes: they have to be
# transformed so that they fit inside the top and bottom of the
# current stroke, defined by (x1, y1) and (x2, y2).
#
# stroke_x defines how far along each curve to go; stroke_y says where
# to define the point in between the two curves.
#
# iter_level is only passed to this function because I was using it
# while debugging.

n = length(stroke_x)

t = seq(0, 1, by = delta_t)

indices_floor = sapply(stroke_x, function(x) max(which(t < x)))
indices_ceiling = sapply(stroke_x, function(x) min(which(t >= x)))
interp_dist = (stroke_x - t[indices_floor]) / (t[indices_ceiling] - t[indices_floor])

temp_x1 = x1[indices_floor] + interp_dist * (x1[indices_ceiling] - x1[indices_floor])
temp_y1 = y1[indices_floor] + interp_dist * (y1[indices_ceiling] - y1[indices_floor])
temp_x2 = x2[indices_floor] + interp_dist * (x2[indices_ceiling] - x2[indices_floor])
temp_y2 = y2[indices_floor] + interp_dist * (y2[indices_ceiling] - y2[indices_floor])

temp_x = temp_x1 + stroke_y * (temp_x2 - temp_x1)
temp_y = temp_y1 + stroke_y * (temp_y2 - temp_y1)

reg_stroke = regularise_stroke(temp_x, temp_y)
new_x = reg_stroke\$x
new_y = reg_stroke\$y

return(list(x = new_x, y = new_y))
}

write_fractal = function(word_str, x1, y1, x2, y2, iter_level) {
# (x1, y1): parametrised top of stroke
# (x2, y2): parametrised bottom of stroke

n = length(x1)

for (i in 1:length(base_strokes)) {
if (iter_level < 3) {
print(sprintf("Doing stroke %d at iteration %d", i, iter_level))
}

pixels1 = pixel_points(base_strokes[[i]]\$x1, base_strokes[[i]]\$y1, x1, y1, x2, y2, iter_level)
pixels2 = pixel_points(base_strokes[[i]]\$x2, base_strokes[[i]]\$y2, x1, y1, x2, y2, iter_level)

width = max(pixels1\$x) - min(pixels1\$x)
height = max(pixels1\$y) - min(pixels1\$y)

this_x0 = pixels1\$x[1]
this_y0 = pixels1\$y[2]

if ((width + height < 3) | (iter_level > max_iter)) {
fractal_img[floor(this_y0), floor(this_x0)] <<- 1
} else {
write_fractal(word_str, pixels1\$x, pixels1\$y, pixels2\$x, pixels2\$y, iter_level + 1)
}
}

return(0)
}

# Define initial "stroke" in which to start the iterations:
t = seq(0, 1, by=delta_t)
x1 = 1 + t*(M - 1)
x2 = x1
y1 = 1 + 0*t
y2 = N + 0*t

write_fractal(fractal_str, x1, y1, x2, y2, 1)

fractal_img <<- 1 - fractal_img
# Transpose because EBImage's convention is different to my head's:
fractal_img <<- t(fractal_img)
image_towrite = Image(fractal_img, colormode=Color)
writeImage(image_towrite, "fractal.png")```
```

Posted 2014-03-23.

Home > Misc