Perl Weekly Challenge: Week 44
Challenge 1:
Only 100, please.
You are given a string "123456789". Write a script that would insert "+" or "-" in between digits so that when you evaluate, the result should be 100.
This was an intriguing problem and I had to think hard about how to solve it. We have nine fixed positions (the digits) and eight spaces to fill in between. Although the problem only specifies + and -, if you think about it, there is a third possibility—an empty space. E.g. the number 45 can be represented as 4 (empty space) 5. So eight spaces with one of three possible values in them makes a total of 38 or 6,561 combinations to apply to the digits. This is a substantial number but small enough to search for by brute force. Knowing that it has some features that will be useful, I started with Raku.
These arrays are my digits and operations. The spaces around + and - are only so they'll look good when I print out the answer.
my @digits = 1 .. 9;
my @ops = (' + ', ' - ', q{});
You can find all the combinations of two arrays with the X operator. For example,
@ops X @ops will produce an array of nine arrays:
(' + ', ' + ')
(' + ', ' - ')
(' + ', q{})
(' - ', ' + ')
(' - ', ' - ')
(' - ', q{})
(q{}, ' + ')
(q{}, ' - ')
(q{}, q{})
To get our 6561 combinations, we can do:
(@ops X @ops X @ops X @ops X @ops X @ops X @ops X @ops)
This works but it rather ungainly and unscalable. What if we had nine spaces?
Or seventeen? Searching the Raku docs, I discovered there is an xx operator that
repeats a list a number of times. (Like x does for strings.) And I remembered
that you can use X as a metaoperator like this [X] to operate on a list of lists.
Put it altogether and you can replace the mess above with:
([X] @ops xx 8)
Much better looking don't you think? Each second-level array in this array will
have eight elements but as we shall soon see, we need them to have nine to match
the number of digits. This is easily acheived by doing another X, this time with
q{} which has the effect of adding another element with the value of empty string
to the end of each of our 6561 combinations. The array in its final form looks like
this:
(([X] @ops xx 8) X q{})
The next step is to insert each combination into the array of digits and convert the result into a string.
==> map({ (@digits Z~ @_).join; })
The feed operator ==> takes an array and "feeds" it into a function that an array
as input, map() in this case without requiring a temporary variable. I usually
achieve the same effect with an arrays .map method but this is more legible I think.
I must remember to use it more often. The map combines the combination array and
the array of digits with the Z~ operator. Z requires both arrays be of equal length
which is why we extended the combinations array earlier. The resulting eighteen
element array is .joined into a string and returned.
Now we have 6561 strings representing sums. How do we determine if they equal one hundred?
Coming from a C/C++ background originally, I was slow to realize this but one of
the most powerful features of higher-order languages like Perl is the ability
to evaluate arbitrary code on the fly within a program. Perl does this via the
aptly named eval() function. I was surprised to learn that Raku does not
implement eval(). It does however have the similar EVAL(). The difference is
that EVAL() is not enabled by default. You have to specify the amusingly named
MONKEY-SEE-NO-EVAL pragma to use it. So the next step is to use the feed operator
once again to run the sums through grep() and return the ones which EVAL() to
the right answer.
==> grep({ EVAL($_) == 100; });
The Perl version was more difficult because we don't have all these nifty operators so my first task was to provide my own. (Or I could have used CPAN modules which provide the missing functionality but I like to avoid extra modules when doing these challenges.)
This is my cross-product function. One problem is that Perl "flattens" arrays so to have a function that operates on two or more arrays, you have to pass array references instead.
sub X {
my @a = @{ $_[0] };
my @b = @{ $_[1] };
A map of maps is used to make the array of combinations. There's an added
complication because we want to support the case of appending a scalar value to an
array (as in X q{} above.) This means we have to check whether the elements of
the first argument are array references or scalars which can be done with ref().
return map {
my $first = $_;
map {
[ ref $first eq 'ARRAY' ? @{$first} : $first, $_ ];
} @b;
} @a;
}
Emulating Z~ (which is not a valid identifier in Perl hence the name change to
Ztilde) is much easier. We just go through the arrays one by one taking one value
from each and assembling them into a new array.
sub Ztilde {
my @a = @{ $_[0] };
my @b = @{ $_[1] };
my @result;
for my $i (0 .. scalar @b - 1) {
push @result, $a[$i], $b[$i];
}
return @result;
}
I suppose I should have implemented equivalents for [X] and xx but I chickened
out and just used a for loop instead.
my @output = @ops;
for (1 .. 7) {
@output = X(\@output, \@ops);
}
@output = X(\@output, [q{}]);
The last part is the same as in Raku albeit much less elegantly laid out.
grep { eval $_ == 100 } map { join q{}, Ztilde(\@digits, $_); } @output;
Despite all the extra code, Perl is substantially faster than Raku. My Raku script took about 35 seconds to complete. Not too bad but Perl did it in less than 1 second.
In case you are wondering, these are the possible answers.
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
1 + 2 + 34 - 5 + 67 - 8 + 9 = 100
1 + 23 - 4 + 5 + 6 + 78 - 9 = 100
1 + 23 - 4 + 56 + 7 + 8 + 9 = 100
12 + 3 + 4 + 5 - 6 - 7 + 89 = 100
12 + 3 - 4 + 5 + 67 + 8 + 9 = 100
12 - 3 - 4 + 5 - 6 + 7 + 89 = 100
123 + 4 - 5 + 67 - 89 = 100
123 + 45 - 67 + 8 - 9 = 100
123 - 4 - 5 - 6 - 7 + 8 - 9 = 100
123 - 45 - 67 + 89 = 100
Challenge 2:
Make it $200
You have only $1 left at the start of the week. You have been given an opportunity to make it $200. The rule is simple with every move you can either double what you have or add another $1. Write a script to help you get $200 with the smallest number of moves.
I decided to solve this via the depth-first search of a binary tree. It's a data structure which starts with a root node which has a value and two child nodes, each of which has a value and two child nodes and so on until you reach some boundary condition. In this case, the root node will have a value of $1. The child nodes will represents the two choices, adding $1 or doubling the value. So one child node (let's say the left one) will have the value $2 and coincidentally the other will also have the value $2. In the next generation, there will be four nodes. The left grandchild of the 1st generation left child will be $3 and the right grandchild will be $4. Same for the left and right grandchildren of the right child.
At this point you may have noticed a huge inefficiency in the number of nodes being created but at this point I didn't. I'll come back to this issue soon.
Anyway my program recursively keeps making nodes like this until the value is greater than $200 in which case it stops or if the value is exactly $200. I haven't mentioned that my nodes also include a link to the parent which created them (except for the root node whose parent is empty.) With this it is simple to backtrack up the tree upto the root. My nodes also have a "label"—either "double" or "add one". I can make a list of these (actually a stack as otherwise they will be in reverse.) and print it out as the answer.
The problem with this algorithm as described is that it will give you every possible correct answer. 205,658 of them to be precise. Most of them will be unnecessarily long such as adding one 199 times etc. when we only want the shortest answer. To deal with this, I keep track of the "depth" of the tree and use it only keep the shortest current solution list and only generate nodes if their depth is less than that of the solution list.
I originally coded this in C++ as that is the language I am most comfortable with for data structure/algorithm type things. I won't show it here but you can find the full C++ source on Github.
This is my Raku translation:
First we have the Node structure itself.
class Node {
has Node $.parent;
has Node $.left is rw;
has Node $.right is rw;
has Str $.label;
has Int $.amount;
}
Class members are read-only unless specifically marked read-write as $.left and
$.right are here. Raku takes care of synthesizing constructors, getters,
setters etc.
The traverse() function is called recursively starting from the root node like
this:
my @results;
my $root = Node.new(parent => Nil, label => q{}, amount => 1);
my $maxDepth = ∞;
traverse($root, @results, $maxDepth, 0);
It looks like this and has three modes.
sub traverse(Node $node, @bestBranch, $maxDepth is rw, $depth) {
If the amount in the current node is less than $200 and the depth of the tree is
less than the depth of the current best branch, two child nodes are created and
traverse()ed in turn.
if $depth < $maxDepth && $node.amount < 200 {
$node.left = Node.new(parent => $node, amount => $node.amount * 2,
label => 'double');
$node.right = Node.new(parent => $node, amount => $node.amount + 1,
label => 'add one');
traverse($node.left(), @bestBranch, $maxDepth, $depth + 1);
traverse($node.right(), @bestBranch, $maxDepth, $depth + 1);
If the amount in the current node is exactly $200 and the depth of the tree is less than the depth of the current best branch, a new best branch is created by following the chain of parent nodes all the way up to the root.
} elsif $node.amount == 200 && $depth < $maxDepth {
$maxDepth = $depth;
my @branch;
my $current = $node;
while ($current.parent()) {
@branch.unshift($current.label());
$current = $current.parent();
}
@bestBranch = @branch;
}
If the amount in the current node is greater than $200 or we have gone deeper than the depth of the best tree, nothing is done.
}
By the time the tree has been fully traverse()ed we will have the shortest path
through it to reach $200. It completes in about a second on my machine. In fact
I was surprised Raku could be this fast.
So I was feeling pretty proud of myself when I talked to a colleague. He pointed out that because the first two child nodes both have the amount $2, the entire right half of the binary tree is just a mirror of the left half so we are searching atleast twice as many nodes as is necessary. And anyway the entire algorithm is more complicated than it needs to be. He said it is simpler to start at $200 and work backwards. If the current amount is even, half it (and add "double" to the result stack.) If the current amount is odd, subtract one (and add "add one" to the result stack.) Stop when the amount gets to $1. Brilliant! This is what it looks like in Raku:
multi sub MAIN {
my @result;
my $n = 200;
while ($n != 1) {
if ($n %% 2) {
@result.unshift('double');
$n /= 2;
} else {
@result.unshift('add one');
$n--;
}
}
@result.join(q{, }).say;
}
And this is Perl:
my @result;
my $n = 200;
while ($n != 1) {
if ($n % 2 == 0) {
unshift @result, 'double';
$n /= 2;
} else {
unshift @result, 'add one';
$n--;
}
}
say join q{, }, @result;
And again, if you are wondering what the answer is; all four of my programs come up with this nine step solution:
double, add one, double, double, double, add one, double, double, double