# The 24 Puzzle, in Perl 6, using Channels and Promises

Mark Jason Dominus solved the 24 Puzzle in Perl, then explicated some non-Perl solutions other people sent him. RJBS tried it in Forth. I’ve been meaning to try it in Perl 6. I bumbled around as I stubbornly tried to include language features I didn’t really need, but that’s part of the fun.

Given 6,6,5,2, make 17 using the operators +, -, *, and /.

The trick with these puzzles is to not read mjd’s solution before struggling with it yourself. Also, I wanted to do this with Perl 6 features that I wouldn’t be able to use in Perl or C. If the program looks the same in a different language, who cares? It’s done. A mere translation is not that interesting.

I started with the idea that I wanted to use the cross and hyper operations to make the lists of things I’d want to process, and I wanted to use a Channel to hold the list of candidate solutions that various Promises would try to solve. Something would fill the channel, and a set of promises running in other threads would grab candidates. Perl 6 has asynchronous support builtin and I wanted to play with that.

I want my program’s invocation to take a list of numbers where the last number was the goal:

```\$ perl6 24-problems.p6 [digits] [goal]
```

To solve this problem, I’d run it as:

```\$ perl6 24-problems.p6 6 6 5 2 17
```

Here’s my solution, which is still a bit messy. For any list of N digits, I need N – 1 operators to insert between the digits. I use the cross operator in the reduction operator, `[X]`, with a list of N – 1 copies of `@operations`. That `xx` operator is the list replication operator. That’s a lot of work for a single statement (and isn’t that great?).

Ignore the middle of `MAIN` for a moment. In that `for` loop I cross all the permutations of digits with all the combinations of the operators. These are all of the candidate solutions. I end up with a bunch of two element lists; the first element is the digits in some order and the second is the list of operators. Perl 6 maintains that structure, so I send a two element thing into the channel.

Now, back up. I have another `for` that creates a bunch of promises with `start`. These will run in separate threads in the background. The `whenever` in `react` grabs an item from the channel and does some work. An item in a channel is guaranteed to be handled only once so the promises do their work then fight it out to get another candidate to try.

So, this has the Perl 6 structure I want:

```sub MAIN (*@) {
my \$goal       = @*ARGS.pop;
my @numbers    = @*ARGS.clone.flat;
my @operations = < + - * / >;

# I need N - 1 operators, with repeats (so, + + + is fine)
my @cross = [X] @operations xx (@numbers.elems - 1);
my @perms = @numbers.permutations.unique( :with(&[eqv]) );

put "Total candidates: " ~ ( @cross.elems * @perms.elems );

my \$channel = Channel.new;

my @p;
my \$total = 0;
for 1 .. 1 {
@p.push: start {
react  {
whenever \$channel -> \$item {
state \$count = 0; \$count++;
my \$result = evaluate( \$item );
put "SOLUTION! \$result[*-1] = \$goal" if \$result[0] == \$goal;
LAST {
\$total += \$count;
}
}
}
};
}

my \$start = now;
put "Starting to send to channels";
for @perms X @cross -> \$i {
\$channel.send( \$i )
}
put "Done sending to channels: " ~ (now - \$start) ~ " seconds";

\$channel.close;

await |@p;

put "Total handled was \$total";
}

sub evaluate ( \$item ) {
my @digits  = \$item[0].flat;
my @ops     = \$item[1].flat;

my @ops2 = ( |@ops, '' );

my \$string = @digits >>~<< @ops2;

while @ops.elems > 0 {
splice(
@digits, 0, 2,
op( @ops.shift, |@digits[0,1] )
);
}

return [ @digits[0], \$string ];
}

multi op ( '+', \$m, \$n ) { \$m + \$n }
multi op ( '-', \$m, \$n ) { \$m - \$n }
multi op ( '/', \$m, \$n ) { \$m / \$n }
multi op ( '*', \$m, \$n ) { \$m * \$n }
```

I struggled for a bit to figure out what I wanted to do in `evaluate`. For a long time I tried to force a situation where I’d use the zip meta operator, `Z`, to merge the digits and the operators. If I could do that, I could stringify and EVAL that. Yeah, that’s disgusting and requires a secret pragma, but I got stuck on that idea. The problem was the ugliness of operator list having one less item than the digits list. The `Z` wants to use the same number of elements from both sides and will cycle back to the beginning of the shorter list. For awhile I’d mutate the operator list to add the empty string at the end. I never liked this and it made everything harder than it needed to be.

While I was goofing around with that, I had the idea that I could zip the lists myself. As long as there was something in `@ops`, take one item from that list and two items from `@digits` and push them onto a new array:

```@temp-array.push: @digits[0], @ops[0], @digits[1];
```

It took me much longer that it should have to realize that I didn’t need the temporary array. I’ll grab the same elements, figure out the result, and replace those two numbers with the single number I just computed. When `@ops` was empty, I should have the answer in `@digits`. Boom. But, I still did the zip thing to make a string that represented the operation so I know how I got it.

To compute the intermediate results I created some `multi` subs with similar signatures, but I used a literal string as the first thing in the signature. This is how I’d translate the strings representing the operators into actual operations. I could have done the same thing with `given`, but I didn’t:

```my \$result = do {
given \$o {
when '+' { \$m + \$n }
when '-' { \$m - \$n }
when '*' { \$m * \$n }
when '/' { \$m / \$n }
}
};
```

When I run this, I get output like this:

```Total candidates: 768
Starting to send to channels
SOLUTION! 5/ 6+ 2* 6 = 17
Done sending to channels: 1.5209437 seconds
Total handled was 768
```

Notice that one of the threads handled many more candidates. This isn’t true for every run. More often, all threads handle close to the same number of candidates. But, whenever that happened the program was much slower by about half a second. That probably means I’m using too many threads. If I changed the code to create only one promise, it’s very fast:

```Total candidates: 768
Starting to send to channels
Done sending to channels: 0.24503289 seconds
SOLUTION! 5/ 6+ 2* 6 = 17
Total handled was 768
```

This sniffs of a synchronization problem. If threads compete for the same physical processor, they have to cooperate (and something has to help them do that). I wasn’t concerned about making this fast because I wanted to play with the features, but its something to think about for production programming.

Here’s the overall timing for three promises. Notice the user time is about two times the real time because multiple threads are working at the same time:

```\$ time perl6 pick-* 6 6 5 2 17
Total candidates: 768
Starting to send to channels
Done sending to channels: 2.0787578 seconds
SOLUTION! 5/ 6+ 2* 6 = 17
Total handled was 768

real	0m3.294s
user	0m7.836s
sys	0m0.843s
```

And for one promise, the user time and real time are about the same, and both are lower than using three threads:

```\$ time perl6 pick-* 6 6 5 2 17
Total candidates: 768
Starting to send to channels
Done sending to channels: 0.2340613 seconds
SOLUTION! 5/ 6+ 2* 6 = 17
Total handled was 768

real	0m2.088s
user	0m2.148s
sys	0m0.276s
```

If there’s a lot of lag in the processing (like fetching a resource or waiting), slicing operations into threads can have them wait together. Since those threads don’t need to use the processor to wait, they aren’t competing and getting in each other’s way.

Here’s a stripped down version of my previous program where most of the processing of each item isn’t actual work:

```my \$channel = Channel.new;

my \$threads = @*ARGS[0] // 1;

my @promises;
@promises.push: start {
react  {
whenever \$channel -> \$item {
sleep \$item % 3
}
}
};
}

for ^37 {
\$channel.send( \$_ )
}

\$channel.close;

await |@promises;
```

With one thread, it takes about 37 seconds on the wallclock, but notice the user time is really low:

```\$ time perl6 wait.p6
...

real	0m36.359s
user	0m0.278s
sys	0m0.067s
```

Three threads can sleep simultaneously and can be much faster. The user time is about the same, but the wallclock time is less than half what it was before:

```\$ time perl6 wait.p6 3
...

real	0m15.637s
user	0m0.281s
sys	0m0.112s
```

### A slight digression on EVAL

As part of my initial idea, I tried to create a string version of the solution and `EVAL` the whole thing. That’s expedient if not prudent, but sometimes you want the answer any way you can get it and don’t care about the purity or cleverness. I can easily make a list of all of the combinations of three operators (one less than the number of digits):

```\$ perl6
> my @a = < + - / * >

> [X] @a xx 3
((+ + +) (+ + -) (+ + /) (+ + *) (+ - +) (+ - -) (+ - /) (+ - *) (+ / +) (+ / -) (+ / /) (+ / *) (+ * +) (+ * -) (+ * /) (+ * *) (- + +) (- + -) (- + /) (- + *) (- - +) (- - -) (- - /) (- - *) (- / +) (- / -) (- / /) (- / *) (- * +) (- * -) (- * /) (- * *) (/ + +) (/ + -) (/ + /) (/ + *) (/ - +) (/ - -) (/ - /) (/ - *) (/ / +) (/ / -) (/ / /) (/ / *) (/ * +) (/ * -) (/ * /) (/ * *) (* + +) (* + -) (* + /) (* + *) (* - +) (* - -) (* - /) (* - *) (* / +) (* / -) (* / /) (* / *) (* * +) (* * -) (* * /) (* * *))
```

If I wanted to make a string like `6+6+5-2` with the `Z` operator, I’d need something at the end to come after the `2`. It can’t be another operator though. I wanted something like this:

```my @digits = 6, 6, 5, 2;
my @ops    = < + - / * >;
my @perms  = @digits.permutations.unique( :with(&[eqv]) );

my @cross = [X] @ops xx ( @digits.elems - 1 );

my @results = ( @perms X @cross )
.map(  { my @d= (|.[1], ''); .[0] >>~>> @d } )
.map(  { say "\$_ = " ~ EVAL ~\$_; \$_  } )
.grep( { 17 == EVAL \$_ } )
```

Even when I solved that, another problem came up. When I `EVAL` the statement, Perl 6 has a particular order of operations where the problem actually goes from left to right without precedence. That’s not explicitly stated in the problem, but it’s part of the problem. It took me a bit to figure out why I wasn’t seeing any solutions this way.

Besides, I was trying to avoid the combinatorial explosion and the time to create the giant list only to go through it to tear it apart when I can do it in fewer steps.

I’d later discover that although I’d found a candidate for the the `6 6 5 2` situation, I hadn’t actually solved the puzzle correctly. Besides the combinations of digits and operators, there was a third set of permutations. I needed all the orders of operations. But, let’s think about Mark Jason’s solution now.

### Back to Mark Jason’s solution

After I’d figured out what I wanted to do, I looked back to see what Mark Jason had done. I won’t re-explicate his approach, but I do want to see how similar we were.

He also used a queue. I had mine in a channel and he maintained a list. I’d say that was about the same idea with different phenotypes.

He created a way to process two numbers at a time and replace them with their result. His added to a history string each time whereas I made the history string ahead of time. His solution was different because each combination of digits and operators represented a tree of solutions. You can do the first pair of digits first, or the last pair first, or the middle pair first. Then, you go through that for what’s left. I’d accidentally found a solution to the particular digits because those worked in left to right order. But, I couldn’t find a solution to `8 8 3 3 == 24` because there isn’t one that evaluates left to right. I hadn’t handled the situation where I do the operations in other orders, like this:

```8 ÷ (3 - (8÷3)) = 24
```

There are actually six paths through the possible combinations of four digits and three operators. There were various ways that I could handle this. I could make all of those candidates and add them to the channel, or I could have the thing that takes the existing candidates generate sub problems and add those to the channel. This would mess up my tidy and apparently unclever solution to getting the history.

And, here’s a good place to back up for a moment. Had I thought about this problem more and paid attention to his note about `8 8 3 3 == 24`, I would have made a test case for that and noticed I couldn’t solve it. I do that when I’m doing production programming and am very careful about the specification, but I wasn’t fastidious here. I think my hubris got in the way. However, I did notice my omission as I was double-checking my work. It’s a bit heart stopping to realize such a thing right before you were about to push to master though. 😉

After playing with this much longer than I should have, I came up with something close to what Mark Jason did. I took longer because I was trying quite hard to avoid his solution and I was trying to be clever in Perl 6. He created nodes for each computation (with the starting trivial case of the result being the starting digit). As he carried those along, he combined two nodes to create a new node with the new result but also a new string version of the combined history of those two nodes. While I was trying to avoid this, I was doing the same idea with a differen’t implementation. I didn’t have a fresh idea (other that creating an RPN calculator class, until I realized that it was still the same idea).

I’ve adjusted a few things from my previous program and explained some
of the trickier accounting to get the history. There’s plenty more I don’t like about my implementation, but it’s good enough that I can move on to other problems:

```sub MAIN (*@) {
my \$goal       = @*ARGS.pop;
my @numbers    = @*ARGS.clone.flat;
my @operations = < + - * / >;

my @cross = [X] @operations xx (@numbers.elems - 1);
my @perms = @numbers.permutations.unique( :with(&[eqv]) );
my @orders = ( 0 .. (@numbers.elems - 2) ).permutations;

put "Total candidates: " ~
( @cross.elems * @perms.elems * @orders.elems );

my \$channel = Channel.new;

my @promises;
my \$total = 0;
#`(
probably need to make fewer threads since this is
computation heavy, but here's where you can adjust
that.
)
my \$max_promises = 1;  # 1 seems to be the right number
for 1 ..  \$max_promises {
@promises.push: start {
react  {
whenever \$channel -> \$item {
state \$count = 0; \$count++;
my \$result = evaluate( \$item );
next unless defined \$result[0];
put "SOLUTION! \$result[1] = \$goal"
if \$result[0] == \$goal;
}
}
};
}

my \$start = now;
put "Starting to send to channels";
#`(
Don't really need the double X here, but it saves a
hardcoded series of next loops. With 4 digits, the
maximum list size is under 10,000. The nested loop
version ran in about the same time
)
for @perms X @cross X @orders -> \$i {
\$channel.send( \$i )
}
put "Done sending to channels: "
~ (now - \$start) ~ " seconds";

\$channel.close;

await |@promises;

put "Total handled was \$total";
}

sub evaluate ( \$item ) {
#`(
Each entry in digits is a tuple that represents a
sub computation. The first item in there is a number
and the second is a string that represents the
history of the prior computations. At the start, the
history is simply the digit for that tuple
)
my @digits  = |\$item[0].map: { [ \$_, \$_ ] };
#`(
Ops is a list of mathematical operators, and should
have one fewer elements that @digits since every
operator needs two operands
)
my @ops     = |\$item[1];
#`(
The orders represents the order of operations. Think
of this as implementing implied parens around
operations. With this, you aren't stuck with issues
of precedence or left-to-right evaluation.
)
my @orders  = |\$item[2];
#`(
@orders_offset tracks and adjusts positions in the
operation. It's important with you want to do the
3rd operation last, for instance, but doing the 1st
and 2nd operations has removed elements from
@digits. Later operations need to adjust their
offsets when they look for operands in @digits.

The indices in @orders_offset correspond to the
values @orders. Use the value from @orders as the
index into @orders_offset to get the offset.
)
my @orders_offset = 0 xx @orders.elems;

#`(
Go through all the values in @orders, which
correspond to the index to look up the operation in
@ops and the index for the offsets in @digits (which
reduces as we do work).
)

for ^@orders {
my ( \$real_order ) = @orders[\$_];
my ( \$order )      = \$real_order -
@orders_offset[\$real_order];
my ( \$op )         = @ops[\$real_order];

my \$result = op( \$op, @digits[\$order], @digits[\$order+1] );
return [ NaN, Str ] unless defined \$result;

my \$string =
"({@digits[\$order][1]} \$op {@digits[\$order+1][1]})";

# splice is slurpy, so do extra work to maintain the tuple
@digits.splice: \$order, 2, [ \$[ \$result, \$string ] ];

#`(
if this step combined elements, adjust offsets for
later operations. That is, when the list shrinks,
increase offsets after that point so the offsets
still refer to the same items.
)
for ^@orders_offset {@orders_offset[\$_]++ if \$order < \$_ }
}

return @digits[0];
}

# all of these get a tuple from @digits
multi op ( '+', \$m, \$n ) { \$m[0] + \$n[0] }
multi op ( '-', \$m, \$n ) { \$m[0] - \$n[0] }
multi op ( '/', \$m, \$n ) { \$n[0] == 0 ?? fail() !! \$m[0] / \$n[0] }
multi op ( '*', \$m, \$n ) { \$m[0] * \$n[0] }
```

1. FWIW: .unique’s `:with` has complexity of something around O(n²/2) and you should try to avoid it whenever you can and use `:as` arg instead. In this case, since all lists have the same number of elements, `:as(*.Str)` can be used:

m: my @p = 1..2000; @ = @p.unique: :with(&[eqv]); say now – INIT now
rakudo-moar 6f3de6: OUTPUT: «7.468134␤»
m: my @p = 1..2000; @ = @p.unique: :as(*.Str); say now – INIT now
rakudo-moar 6f3de6: OUTPUT: «0.00771542␤»

1. brian d foy says:

When stringifying lists, you can get the same string from lists with different elements. That would potentially discard some lists that should be kept.

2. No matter what I do, it always get handled by a single thread. This is perl6 2018.13:

perl6 puzzle.p6 6 6 5 2 17
Total candidates: 768
Starting to send to channels
Done sending to channels: 0.057440 seconds
SOLUTION! 5/ 6+ 2* 6 = 17