A Sierpinski triangle is a simple fractal that can be made in a number of interesting ways. Continuing my exploration of array programming, I've been working out how to create them in Klong.
Perhaps surprisingly, Klong does not have a bitwise-AND operation for numbers, so I first have to define my own. I've opted for a naive but easy function to accomplish this through successive division by two.
First is an integer division (:%), here dividing 5 by 2:
5:%2
2
And for the remainder, there is a remainder operation (!):
5!2
1
Repeated division by two results in the remainders forming the binary digit in reverse, for example, given the number 12:
12 / 2 = 6 remainder 0
6 / 2 = 3 remainder 0
3 / 2 = 1 remainder 1
1 / 2 = 0 remainder 1
The number 12 in binary is 1100.
{:[ 0=x;
y;
.f(x:%2; (x!2),y)]}
:dyad
Here I've created a function of two arguments, the first is the dividend the second is a list intended to collect the remainder digits.
If (:[) x is equal to 0, we've finished our successive divisions and
can stop, returning the list of binary digits, y. If x is not equal
to zero, we are not done, so we recurse (.f is the "name" for
anonymous recursion, referring to the current function) using the
quotient as x and joining (,) the remainder onto the head of y.
It happens that the starting y-value for the recursive function is
always the empty list ([]), because there are initally no
digits. Instead of requiring the caller to pass the empty list every
time, I partially apply the empty list argument before defining the
function name, turning a function of two arguments into a function of
one argument:
{:[ 0=x;
y;
.f(x:%2; (x!2),y)]}(;[])
:monad
Now for a name, I think "binary" makes some amount of sense:
binary::{:[0=x; y; .f(x:%2; (x!2),y)]}(;[])
:monad
And to see it in action:
binary(21)
[1 0 1 0 1]
binary(12)
[1 1 0 0]
binary(3)
[1 1]
Similar to the last Klong program I wrote — I need to ensure that the arrays are of the same size before comparing. In the case of binary digits, there is no problem padding out leading zeroes, much in the same way I had to pad out zeroes in my Game of Life implementation for the board.
Previously I defined a function pad, to "join" (,) a number of
zeroes up to some length y onto a list x:
pad::{x,(#x)_(&y)}
This is almost correct, except I want to reverse the order and pad zeroes on the front, so I'll swap the order of the join.
{(#x)_(&y),x}
The goal is to compare two arrays, of the same size, to test for
whether the bitwise-AND of the two is equal to zero. With the binary
digits structured as arrays, this is as easy as invoking logical-AND
(&) between the two:
[1 0 1 0 0]&[0 1 0 1 1]
[0 0 0 0 0]
[1 0 1 0 1]&[1 1 0 1 1]
[1 0 0 0 1]
To answer the question "is this point filled or unfilled" I find (?)
the number (#) of binary digits equal to 1 in the result of invoking
logical-AND over the two padded binary digit arrays; returning truthy
if that number is equal to zero (0=).
fill::{[a b band len];
a::binary(x); b::binary(y);
len::(#a)|(#b)|1;
band::{(pad(x; len))&(pad(y; len))};
0=#band(a; b)?1}
With the ability to answer whether a pair of number satisfies the question "bitwise-AND equals zero?", all that is left is to produce data to check.
What I am imagining is something like:
4| (4,0) (4,1) (4,2) (4,3) (4,4)
3| (3,0) (3,1) (3,2) (3,3) (3,4)
2| (2,0) (2,1) (2,2) (2,3) (2,4)
1| (1,0) (1,1) (1,2) (1,3) (1,4)
0| (0,0) (0,1) (0,2) (0,3) (0,4)
+------------------------------
0 1 2 3 4
This is achievable with the "each-left" adverb, which takes the form
a f:\b and invokes f with a repeatedly for each b. This has been
combined with an "each" (') to fix the rows as columns are
enumerated:
{x {x,y}:\(!5)}'|!5
[[[4 0] [4 1] [4 2] [4 3] [4 4]]
[[3 0] [3 1] [3 2] [3 3] [3 4]]
[[2 0] [2 1] [2 2] [2 3] [2 4]]
[[1 0] [1 1] [1 2] [1 3] [1 4]]
[[0 0] [0 1] [0 2] [0 3] [0 4]]]
With a grid of row-column indexes per point, I just have to apply the
"fill" function to each set of pairs. I accomplish this using the
"index" (@) operator. This may be read as "fill each permutation"
(if we generalize a bit):
flats::{a::x; {fill(x@0; x@1)}',/{x {x,y}:\(!a)}'|!a}
serpienski::{(x, x):^flats(x)}
With the flattened array of data (flats) ready, the last touch is to
reshape (:^) the matrix into a square, based on the single function
argument for size.
serpienski(10)
1 0 1 0 1 0 1 0 0 0
1 1 1 1 1 1 1 1 0 0
1 0 0 0 0 0 0 0 1 0
1 1 0 0 0 0 0 0 1 1
1 0 1 0 0 0 0 0 1 0
1 1 1 1 0 0 0 0 1 1
1 0 0 0 1 0 0 0 1 0
1 1 0 0 1 1 0 0 1 1
1 0 1 0 1 0 1 0 1 0
1 1 1 1 1 1 1 1 1 1
Because a bunch of ones and zeroes are a little hard to stare at, it is worth cleaning up the look of the thing with one final touch. By amending the matrix before reshaping, I can replace the "negative space" with whitespace, leaving a much clearer picture of the triangle:
pretty::{m::(x:=" ",x?0); m:="*",m?1}
serpienski::{(x, x):^pretty(flats(x))}
serpienski(33)
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* * *
* * *
* * * * *
* * *
* * * * *
* * * * *
* * * * * * * * *
* * *
* * * * *
* * * * *
* * * * * * * * *
* * * * *
* * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * *
* * *
* * * * *
* * * * *
* * * * * * * * *
* * * * *
* * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * *
* * * * *
* * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
I happen to think it looks better at smaller font sizes with more iterations, such as this example, made with a grid of size 80:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Perhaps unsurprisingly, this too is a rather short program, described in many words.
binary::{:[0=x; y; .f(x:%2; (x!2),y)]}(;[])
pad::{(#x)_(&y),x}
fill::{[a b band len];
a::binary(x); b::binary(y);
len::(#a)|(#b)|1;
band::{(pad(x; len))&(pad(y; len))};
0=#band(a; b)?1}
flats::{a::x; {fill(x@0; x@1)}',/{x {x,y}:\(!a)}'|!a}
pretty::{m::(x:=" ",x?0); m:="*",m?1}
serpienski::{(x, x):^pretty(flats(x))}
Despite its warts, I have found Klong very intuitive so far. I was mulling over how to write the "binary" and "fill" functions during my commute and came to find, writing them later, that things worked as I imagined. That is, for a me, a refreshing change of pace coming from other languages.