Strangely Consistent

Musings about programming, Perl 6, and programming Perl 6

Boxes and pebbles

As I was riding to the airport the other day to pick up a friend, I stumbled across this math problem tweet:

Let <em>n</em> be a positive integer. We have <em>n</em> boxes where each box contains a
nonnegative number of pebbles. In each move we are allowed to take two pebbles
from a box we choose, throw away one of the pebbles, and put the other pebble
in another box we choose. An initial configuration of pebbles is called
solvable if it is possible to reach a configuration with no empty box, in a
finite (possibly zero) number of moves. Determine all initial configurations of
pebbles which are not solvable, but become solvable when an additional pebble
is added to a box, no matter which box is

I started out drawing stuff in my notebook to solve it, but at some point I decided to bring in Perl 6. The solution turned out to be quite illustrative, so I decided to share it.

Below, I reproduce the problem specification, piece by piece, and interleave it with REPL interaction.

The problem

Let n be a positive integer. We have n boxes where each box contains a nonnegative number of pebbles.

$ perl6
> class Conf { has @.boxes where *.all >= 0; method gist { "[$.boxes]" } }
> sub conf(@boxes) { }; Nil
> sub n(Conf $c) { $c.boxes.elems }; Nil

I was a bit saddened to learn that the where clause on the attribute isn't enforced in Rakudo. There's now an RT ticket about that.

The Nil at the end of some lines is to quiet inconsequential or repetitive output from the REPL.

Let's take as our running concrete example the starting configuration [2, 0]. That is, two boxes, one with two pebbles and one empty. As we will see, this is one of the smallest answers to the problem.

> n(conf [2, 0])

In each move we are allowed to take two pebbles from a box we choose, throw away one of the pebbles, and put the other pebble in another box we choose.

> sub but(@list, &act) { my @new = @list; &act(@new); @new }; Nil
> sub add($c, $to, $count) { conf $c.boxes.&but(*.[$to] += $count) }; Nil
> sub remove($c, $from, $count) { conf $c.boxes.&but(*.[$from] -= $count) }; Nil
> sub move($c, $from, $to) { $c.&remove($from, 2).&add($to, 1) }; Nil
> sub moves-from($c, $from) { (move($c, $from, $_) for ^n($c)) }; Nil
> sub moves($c) { (moves-from($c, $_) if $c.boxes[$_] >= 2 for ^n($c)) }; Nil
> moves(conf [2, 0])
[1 0] [0 1]

The condition if $c.boxes[$_] >= 2 ensures that we don't make a move when there aren't enough pebbles in a box.

An initial configuration of pebbles is called solvable if it is possible to reach a configuration with no empty box, in a finite (possibly zero) number of moves.

> sub has-empty-box($c) { so any($c.boxes) == 0 }; Nil
> has-empty-box(conf [2, 2, 2, 0])
> has-empty-box(conf [2, 2, 2, 1])

> sub is-solvable($c) { !has-empty-box($c) || so is-solvable any moves $c }; Nil
> is-solvable(conf [2, 0])
> is-solvable(conf [3, 0])

The definition of is-solvable is the first case where I feel that Perl 6 shines in this problem. That one-liner lets us perform a search using all possible moves for any configuration that has no empty boxes.

For example, if we did this:

> is-solvable(conf [4, 0, 0])

Then the tree search that happens in the background is this:

[4 0 0]
    [3 0 0]
        [2 0 0]
            [1 0 0]
            [0 1 0]
            [0 0 1]
        [1 1 0]
        [1 0 1]
    [2 1 0]
        [1 1 0]
        [0 2 0]
            [1 0 0]
            [0 1 0]
            [0 0 1]
        [0 1 1]
    [2 0 1]
        [1 0 1]
        [0 1 1]
        [0 0 2]
            [1 0 0]
            [0 1 0]
            [0 0 1]

...and is-solvable concludes that no matter how it moves the pebbles, it always ends up with a zero somewhere, so this configuration isn't solvable, and so the result is False.

By the way, we know that any search like this is finite, because every move reduces the net amount of pebbles.

Determine all initial configurations of pebbles which are not solvable, but become solvable when an additional pebble is added to a box, no matter which box is chosen.

> sub add-pebble($c, $to) { conf $c.boxes.&but(*.[$to] += 1) }; Nil
> sub add-pebble-anywhere($c) { (add-pebble($c, $_) for ^n($c)) }; Nil
> add-pebble-anywhere(conf [2, 0])
[3 0] [2 1]

> sub is-answer($c) { !is-solvable($c) && so is-solvable all add-pebble-anywhere($c) }; Nil
> is-answer(conf [2, 0])
> is-answer(conf [4, 0, 0])

So as we see, our example configuration [2, 0] is a possible answer, because it is not in itself solvable, but adding a pebble in any of the two boxes makes it solvable. Similarly, the [4, 0, 0] that we tree-searched above isn't solvable, but becomes solvable with a pebble added anywhere.

Hostages, heroes and civilians

Having specified the problem thus far, I started to use to make it clearer in my mind by introducing idiosyncratic terminology. I started thinking of the empty boxes as hostages, because they need saving before the end of the day.

> sub hostages($c) { +$c.boxes.grep(0) }; Nil
> hostages(conf [2, 0])
> hostages(conf [3, 0, 0])

Likewise, some pairs of pebbles are heroes... but not all of them. First off, the two pebbles have to be in the same box to make up a hero.

Secondly, the bottom pebble is effectively fixed and cannot contribute to a hero. (Because if we removed it, there would be no pebbles left, and we'd have created another hostage.)

In other words, if we take the pebbles in a box, subtract one, divide by two, and round down, we get the number of heroes in that box.

> sub heroes($c) { [+] ($c.boxes »-» 1) »div» 2 »max» 0 }; Nil
> heroes(conf [2, 0])
> heroes(conf [3, 3, 0])

Heroes live to save hostages. In fact, any move which doesn't use a hero to save a hostage will just end up wasting a pebble. We can use this knowledge to define a better moves-from sub, restricting it to moves that save hostages:

> sub moves-from($c, $from) { (move($c, $from, $_) if $c.boxes[$_] == 0 for ^n($c)) }; Nil

The search moves faster with this condition. For example, the search tree from above gets trimmed to this:

[4, 0, 0]
    [2, 1, 0]
        [0, 1, 1]
    [2, 0, 1]
        [0, 1, 1]

Changing the literal 2 to 3 in the function moves (in recognition of the fact that the bottom pebble never figures in a viable move) cuts the tree down even further:

[4, 0, 0]
    [2, 1, 0]
    [2, 0, 1]

I noticed the pattern that any possible answer configuration I could come up with had the property that there was exactly one more hostage than there were heroes.

> sub one-more-hostage-than-heroes($c) { hostages($c) == heroes($c) + 1 }; Nil
> one-more-hostage-than-heroes(conf [2, 0])
> one-more-hostage-than-heroes(conf [3, 1, 0])

This makes intuitive sense: a configuration that is an answer needs to be not solvable (less than one hero per hostage), but it also needs to be just barely not solvable. That is, there has to be just one hostage too many.

Does this fully describe a solution, though? It turns out it doesn't, but in order to see it, let's bring in a testing tool.

Proving stuff with QuickCheck

We'll want to generate thousands of random configurations for this, so I defined the following two routines. The configuration space is infinite, and it was hard to know how to choose configurations randomly. In the end I favored an approach with small finite configurations with relatively few pebbles, hoping it would catch all relevant cases.

sub random-box { Bool.pick ?? 0 !! (1..5).pick }

sub random-conf {
    my $n = (0..5).pick;
    conf [random-box() xx $n];

Next up, a function that tests a certain property on a lot of random configurations. It's not a total guarantee of correctness, but once you've tested something against 1000 random inputs, you can have a fairly high confidence that no exception has slipped through. Think of it as a kind of probabilistic proof.

sub quickcheck(&prop, $N = 1000) {
    for ^$N {
        print "." if $_ %% 20;
        my $c = random-conf;
        return "Counterexample: $c.gist()" unless &prop($c);
    return "All $N cases passed.";

First up, let's test the statement that if some configuration is a solution, then it has one more hostage than it has heroes.

Because these properties end up talking a lot in terms of if-then relationships, let's create a operator for logical implication.

sub infix:«⇒»($premise, $conclusion) { !$premise || $conclusion }

sub if-answer-then-one-more-hostage($c) {
    is-answer($c) ⇒ one-more-hostage-than-heroes($c);

> quickcheck &if-answer-then-one-more-hostage
..................................................All 1000 cases passed.

Ok, that turns out to be true. How about in the other direction?

sub if-one-more-hostage-then-answer($c) {
    one-more-hostage-than-heroes($c) ⇒ is-answer($c);

> quickcheck &if-one-more-hostage-then-answer
.Counterexample: [0 1]

This is why QuickCheck-based testing is great; it not just tells us that something fails, it also gives us a counterexample by which we can see clearly how and why it fails. In this case, that 1 in there is not enough to save the hostage. Nor is it enough if that box gets another pebble.

Clearly there is some factor at work here besides hostages and heroes.

We've accounted for that bottom pebble, the useless one that we can never do anything with. On top of it are zero or more pairs of pebbles; our heroes. But on top of that can be yet another pebble; let's define a lone pebble like that to be an everyday hero, because all it takes is a small push (one more pebble) to create a hero out of an everyday hero.

The bottom pebble + pairs of pebbles for heroes + everyday hero pebble = a positive even number of pebbles. So the easiest way to state "this box is either a hostage or an everyday hero" is to say "there's an even number of pebbles in this box".

Let's see if adding that condition is enough to predict answers.

sub all-hostages-or-everyday-heroes($c) { so $c.boxes.all %% 2 }
sub if-one-more-hostage-and-all-hostages-or-everyday-heroes-then-answer($c) {
        && all-hostages-or-everyday-heroes($c))
        ⇒ is-answer($c)

> quickcheck &if-one-more-hostage-and-all-hostages-or-everyday-heroes-then-answer
..................................................All 1000 cases passed.

It is enough! Now that we know if it's a sufficient condition, let's find out if it's also a necessary one.

sub one-more-hostage-and-all-hostages-or-everyday-heroes-means-answer($c) {
        && all-hostages-or-everyday-heroes($c))
        == is-answer($c)

> quickcheck &one-more-hostage-and-all-hostages-or-everyday-heroes-means-answer
..................................................All 1000 cases passed.

Ooh, and it is! Lovely.

Notice how much of a simplification this brings about. The two conditions we just defined (one-more-hostage-than-heroes and all-hostages-or-everyday-heroes) just check surface properties of a configuration, whereas is-answer has to perform a possibly large tree search. But quickcheck tells us that the combination of the two conditions is completely equivalent to the whole tree search.


Just to bring that point home, let's drop all the cute terminology, and just write it in terms of the mathematical properties we need to check:

sub pebbles-are-twice-boxes-minus-two-and-all-boxes-even-means-answer($c) {
    ([+]($c.boxes) == 2 * n($c) - 2 && so($c.boxes.all %% 2))
        == is-answer($c)

> quickcheck &pebbles-are-twice-boxes-minus-two-and-all-boxes-even-means-answer
..................................................All 1000 cases passed.

And that's the answer.

(You can also read the solution here, problem 5.)

Enumerating all answers

We might consider ourselves having solved the problem completely, but it feels a bit weird to leave it at that. Can't we get a list of all the answers too?

I started writing a custom recursive solution, but ended up recognizing what I was doing from the output I was getting. (And from the fact that the number of answers of each size led me to this OEIS sequence.)

What we're looking for is really a kind of integer partitions. That makes sense; we have a fixed number of pebbles, and we want to distribute them among the boxes in all possible ways.

As one does nowadays, I went out on Stack Overflow to look for a suitable algorithm to compute integer partitions. Found this elegant Python solution. This is my Perl 6 rendering of it:

sub partitions($n) {
    uniq :as(*.Str), gather {
        take [$n];
        for 1..^$n -> $x {
            take ([($x, .list).sort] for partitions($n - $x));

Of course, once we have the partitions, we need to massage them a little bit. To be exact, we reverse the partition (because I like reading them in descending order), double the numbers (to get only even numbers), and we pad with zeroes at the end.

sub double(@list) { @list »*» 2 }
sub pad(@list, $size) { [@list, 0 xx ($size - @list.elems)] }
sub all-answers($n) { (.reverse.&double.&pad($n) for partitions($n - 1)) }

Note by the way that these answers are "symmetry broken". For each solution, the order of the boxes is immaterial to the problem, so all permutations of boxes are also viable answers. So picking a canonical order and sticking with it makes the output a lot smaller without missing anything essential.

Finally, we print the answers. Sorting is not necessary, just esthetic.

sub array-cmp(@xs, @ys) { [||] @xs Z<=> @ys }

for 1..* -> $n {
    my @answers = all-answers($n).sort(&array-cmp);
    say "{@answers.elems} answers of size $n:";
    say "  ", .&conf for @answers;

This is how they look. These are just the first seven iterations; it goes on for a while.

1 answers of size 1:
1 answers of size 2:
  [2 0]
2 answers of size 3:
  [2 2 0]
  [4 0 0]
3 answers of size 4:
  [2 2 2 0]
  [4 2 0 0]
  [6 0 0 0]
5 answers of size 5:
  [2 2 2 2 0]
  [4 2 2 0 0]
  [4 4 0 0 0]
  [6 2 0 0 0]
  [8 0 0 0 0]
7 answers of size 6:
  [2 2 2 2 2 0]
  [4 2 2 2 0 0]
  [4 4 2 0 0 0]
  [6 2 2 0 0 0]
  [6 4 0 0 0 0]
  [8 2 0 0 0 0]
  [10 0 0 0 0 0]

So, it has come to this

I put all the code from this blog post in a gist if anyone wants to play with it.

This problem is now officially flushed out of my system. I like how Perl 6 rose to the challenge of helping me solve it. I'm also positively surprised by the "feel" of doing QuickCheck testing. Gotta do more of that.

I worked under a self-imposed restriction that things written in the REPL ought to fit on one line. It made me reach for ways to chunk ideas into functions, which I think ended up bringing out the intent of each step a bit better.

Finally, although I knew it from before, junctions and hyperops and ranges and list comprehensions and functions and metaoperators and custom operators and lazy lists... they all conspire to make problem solving and exploratory programming like this a really pleasant experience.

t4: Rain in a world of cubes

<flussence> as a minecraft player I figured out what t4 was asking pretty much instantly :)

This is me trying to emerge from the big strange writer's block that has inexplicably formed around the t4 blog post. Here goes.

The t4 task was my clear favorite this year. It has a certain William Gibson quality to it, with virtual rain falling inside a three-dimensional world where everything is made of cubes which mostly just hang there, suspended, in mid-air.

## Simulate rain in a world of cubes

Write a program that calculates the volume of rain water collected in the cube
world described below.

The cube world &mdash; given as input &mdash; consists of a finite set of cubes
on integer coordinates `(x, y, z)`. The positive `y` coordinate means "up".

An infinite amount of rain then falls from an infinite height. Both of these
infinities are taken to really mean "large enough as to make no difference".
As it lands on cubes, the water will follow predictable rules:

* Rain falls everywhere.

* Water falling will land on the first cube below it. It does not fall through

* Water will collect on levels where walls on all sides will keep it in.

* Water will produce vertical waterfalls where such walls are missing.

* Cubes are packed tightly enough that gaps between cubes sharing an edge will
  not let water through. However, the same gaps will readily let air through if
  water needs to displace air for some reason.

Waterfalls work in the simplest way imaginable: if water "escapes" from a      
structure of cubes, it will fall straight down along the first available
"chute" of cube-formed empty cells until it hits a cube. (Which it may not
necessarily do. A waterfall may go on to infinite depth.) As a waterfall hits a
cube, it behaves just like other kinds of water: it may spread, collect, and
form new waterfalls as needed.

People had different ideas how to solve this one:

I had fun guessing what solutions people would come up with. I correctly guessed the first two, but not the last one. I guess it's a bit too mutable for my FP brain to come up with these days.

Anyway, the mistakes! Oh, the mistakes. Not just one or two contestants for this one; all of them. Turns out simulating rain on cubes is hard!

Here follows a choice list of assumptions broken by the contestants, that make their programs return odd results.

Assuming that rain can reach where it can't


Let me explain the above picture. In order to test the four entrants against odd cases, I wrote a small program that builds a cube world from the above syntax. It only describes a cross-section; and so walls in the depth direction are automatically added. In other words, the above depicts a sealed box with no way in.

It should contain no rainwater, of course. One of the programs returns that it's full of water.

Oh, and by the way, the script that produces coordinates from pictures like the above turned out quite cute and simple, so let me share it:

my %coords =
    ' ' => [         ],
    'X' => [-1, 0, +1],
    '.' => [-1,    +1],
    '~' => [-1,    +1],

for lines.kv -> $y, $line {
    for $line.comb.kv -> $x, $char {
        for %coords{$char}.list -> $z {
            say "($x, {-$y}, $z)";

Assuming that the water can rise higher than its lowest outlet


It's for cases like this that I felt a need in the problem description to talk about gaps between cubes that "will readily let air through if water needs to displace air". In other words, if the above is a kind of barometer, then it's a completely useless one, because it leaks air and water find an equilibrium based only on itself.

...which means that the correct answer above is 7. That's the number of waterfilled cubes when the water level is the same "inside" the barometer and at its mouth.

One of the programs got 9, assuming that the barometer fills up completely. Two programs got 0, assuming no water can even enter.

Speaking of which...

Assuming that some vessels are unable to contain water


Two programs had trouble with this one. I don't know if it's because of the banana shape or the cover over one of the ends. But they got 0 cells of rainwater collecting in it, when the correct answer is that it fills up all 9 internal cells.

Underestimating the size of a vessel


A small vessel sitting in a bigger vessel. A naive program might reach the brim of the small vessel, figure "oh, ok, we're done here", and then not fill up the bigger vessel with water.

This happened with one of the programs.

Concreteness and TDD

I've mentioned it in previous posts, but the way I pick problems for the contest is I find problems where I myself go "oh, that's easy, I'll just..." and then a while later, I go "...oh wait." Problems that look easy on the surface, but then turn out to have hidden depths. (A bit like these vessels holding water can have hidden depts, tunnels, nooks and crannies.) One of my favorite feelings when I design something is having the model "break" for a certain case. It's like the floor falling out from under me, and I have to re-orient myself inside the solution space to accomodate the new rules.

All the failures above emphasize the need for having actual test cases to run the program against. The base tests I send with the problems are (intentionally) inadequate for this purpose. The contestant is meant to think up their own tests, consider edge cases, special cases, and pathological cases.

To me, that's where unit testing shines. Development suddenly becomes a back-and-forth discussion between you and the programming substrate over something very tangible: concrete cases.

Only one champion still standing

Only one of the programs passes all of the above tests with flying colors. Well, I do want to stress that all four contestants made brave efforts. But for one reason or another, one of the four programs ended up especially correct.

Check out the reviews for details., wait

Hm. What about this case?


Should be able to hold 19 cells of water, right? Well, wouldn't you know. Our so-far unblemished program fails this one, with the cryptic error message Merging non-balanced water masses. (Two other programs get the correct 19, and the last one gets 0.)

So I take it back. None of the programs are correct. Pity. But my points about deep model thinking and representative test cases still stands. Correctness is hard!

Next up: distributing weights evenly in bags.

Parsing indented text

"How can I parse indented text with a grammar?" has turned into a frequently-asked question recently. People want to parse Python and CoffeScript.

My fix is double. First, here's Text::Indented, a module that does it.

Secondly, I'll now recreate my steps in creating this module. Each section will have a description of what needs to be done, a failing test, and then the appropriate implementation code to pass the test.

Quite a simple indent

We want to be able to handle indentation at all.

    my $input = q:to/EOF/;
    Level 1
        Level 2

    parses_correctly($input, 'single indent');

Well, that's easy. This grammar will do that:

regex TOP { .* }

(Kent Beck told me I can cheat, so I cheat!)

Too much indent for our own good

But there are some indent jumps that we're not allowed to make. Anything that indents more than one step at a time, basically. Let's check for that.

    my $input = q:to/EOF/;
    Level 1
            Level 3!

    fails_with($input, Text::Indented::TooMuchIndent);

This takes a little more code to fix. We declare an exception, start parsing lines, and separate each line into indent, extra whitespace, and the rest of the line. Finally we check the line's indent against the current indent — mediated by the contextual variable @*SUITES. You'll see where I'm going with this in a minute.

class TooMuchIndent is Exception {}

constant TABSTOP = 4;

regex TOP {
    :my @*SUITES = "root";


sub indent { @*SUITES.end }

regex line {
    ^^ (<{ "\\x20" x TABSTOP }>*) (\h*) (\N*) $$ \n?

        my $new_indent = $0.chars div TABSTOP;

            if $new_indent > indent() + 1;

(The <{ "\\x20" x TABSTOP }> is a bit of a workaround. In Wonderful Perl 6 we would be able to write just [\x20 ** {TABSTOP}].)

Actual content

Having laid the groundworks, let's get our hands dirty. We want the content to end up, line by line, on the right scoping level.

    my $input = q:to/EOF/;
    Level 1
        Level 2

    my $root = parse($input);

    isa_ok $root, Text::Indented::Suite;
    is $root.items.elems, 2, 'two things were parsed:';
    isa_ok $root.items[0], Str, 'a string';
    isa_ok $root.items[1], Text::Indented::Suite, 'and a suite';

We need a Suite (term borrowed from Python) to contain the indented lines:

class Suite {
    has @.items;

This requires a slight amending of TOP:

regex TOP {
    :my @*SUITES =;


    { make root_suite }

The logic in line to create new suites with new indents:

# ^^ (<{ "\\x20" x TABSTOP }>*) (\h*) (\N*) $$ \n?

my $line = ~$2;

if $new_indent > indent() {
    my $new_suite =;


For all this, I had to define some convenience routines:

sub root_suite { @*SUITES[0] }
sub current_suite { @*SUITES[indent] }
sub add_to_current_suite($item) { current_suite.items.push($item) }
sub increase_indent($new_suite) { @*SUITES.push($new_suite) }

But what about de-indenting?

We've handled indenting and creating new suites nicely, but what about de-indenting?

    my $input = q:to/EOF/;
    Level 1
        Level 2
    Level 1 again

    my $root = parse($input);

    is $root.items.elems, 3, 'three things were parsed:';
    isa_ok $root.items[0], Str, 'a string';
    isa_ok $root.items[1], Text::Indented::Suite, 'a suite';
    isa_ok $root.items[2], Str, 'and a string';

Easily fixed with an elsif case in our line regex:

elsif $new_indent < indent() {

And a convenience routine:

sub decrease_indent { pop @*SUITES }

Hah, you missed multi-step de-indents!

Indenting multiple steps at a time isn't allowed... but de-indenting multiple steps is. (This may actually be the strongest point of this kind of syntax. It corresponds to the } } } or end end end case of languages with explicit block delimiters, and is arguably neater.)

    my $input = q:to/EOF/;
    Level 1
        Level 2
            Level 3
            Level 3
    Level 1 again

    my $root = parse($input);

    is $root.items.elems, 3, 'three things on the top level';
    is $root.items[1].items[1].items.elems, 2, 'two lines on indent level 3';

Oh, but we only need to change one line in the implementation to support this:

decrease_indent until indent() == $new_indent;

And a half!

Now for some random sins. You're not supposed to indent partially, a non-multiple of the indent size.

    my $input = q:to/EOF/;
    Level 1
          Level 2 and a half!

    fails_with($input, Text::Indented::PartialIndent);

So we introduce a new exception.

class PartialIndent is Exception {}

And a condition that checks for this:

# ^^ (<{ "\\x20" x TABSTOP }>*) (\h*) (\N*) $$ \n?

my $partial_indent = ~$1;

    if $partial_indent;

What do you mean, "jumped the gun"?

Secondly, you're not meant to indent the first line; it has to be at indentation level 0.

    my $input = q:to/EOF/;
        Level 2 already on the first line!

    fails_with($input, Text::Indented::InitialIndent);

We introduce another exception for that.

class InitialIndent is Exception {}

And a condition that matches our test case.

    if !root_suite.items && $new_indent > 0;

The importance of handles

As a final clean-up refactor, let's change @.items in Suite to this:

class Suite {
    has @.items handles <push at_pos Numeric Bool>;

It makes Suite more Array-like. Piece by piece:

Somehow I liked doing this refactor last, after all the dust around the implementation had settled. It makes the API much more enjoyable to use, and hides a bunch of unnecessary steps along the way. I really like the way handles saves a bunch of boring code.


Anyway, that's parsing of indented code. Not as tricky as I thought.

Now I fear I've damned myself to contribute this solution to arnsholt++'s budding py3k implementation. 哈哈