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.

Here’s the problem:

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; put "Thread {$*THREAD.id} handled $count candidates" } } } }; } 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 Thread 13 handled 55 candidates Thread 6 handled 57 candidates Thread 3 handled 656 candidates Total handled was 768

A digression of threading

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 Thread 4 handled 768 candidates 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 Thread 6 handled 50 candidates SOLUTION! 5/ 6+ 2* 6 = 17 Thread 4 handled 344 candidates Thread 3 handled 374 candidates 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 Thread 4 handled 768 candidates 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; put "Using $threads threads"; my @promises; for 0 ... ^$threads { @promises.push: start { react { whenever $channel -> $item { put "Thread {$*THREAD.id} handing $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 Using 1 threads Thread 3 handing 0 ... Thread 3 handing 34 Thread 3 handing 35 Thread 3 handing 36 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 Using 3 threads Thread 4 handing 0 Thread 3 handing 1 ... Thread 3 handing 33 Thread 3 handing 36 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] }