Continues from previous week.

Feel free to submit a merge request or open a ticket if you found any issues with this post. We highly appreciate and welcome your feedback. You can also contact me (Ryan) directly, with any feedback on this review.

For a quick overview, go through the original tasks and recap of the weekly challenge.

Additional feedback to our Perl Weekly Challenge’s Twitter account is much appreciated.

# Task #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.*

There are either eleven or twelve possible expressions that equal 100:

```
100 == +1+2+3-4+5+6+78+9 100 == +12+3-4+5+67+8+9
100 == +1+2+34-5+67-8+9 100 == +12-3-4+5-6+7+89
100 == +1+23-4+5+6+78-9 100 == +123+4-5+67-89
100 == +1+23-4+56+7+8+9 100 == +123-4-5-6-7+8-9
100 == -1+2-3+4+5+6+78+9 100 == +123+45-67+8-9
100 == +12+3+4+5-6-7+89 100 == +123-45-67+89
```

The description says, “in between digits,” though, so the canonical answer is probably eleven expressions. A few people (including me) probably knew this but opted to allow a leading negative anyway.

Some other solutions chose to allow for more operators than just + or -. This greatly expands the search space, but produces some interesting results.

Without further ado, here are the submissions:

## Adam Russell

Adam’s solution uses AI::Genetic to solve this problem with, yes, you read that right: a genetic algorithm (GA). `AI::Genetic`

is pure-perl with no non-core dependencies, so if you are looking for a way to dip your toe into GAs, this might be a place to start.

Here’s a look at Adam’s fitness function:

```
sub fitness{
my($genes) = @_;
my $s = NUMBERS;
my $total = 0;
my @operands = ($total);
for my $gene (@{$genes}){
if(my($i) = $gene->() =~ m/get_([1-4])/){
return (-1 * NUMBERS) if(@operands == 2);
return (-1 * NUMBERS) if(length($s) < $i);
push @operands, $gene->($s);
$s = substr($s, $i);
}
if($gene->() =~ m/add/){
return (-1 * NUMBERS) if(@operands != 2);
$total = add(@operands);
@operands = ($total);
}
if($gene->() =~ m/subtract/){
return (-1 * NUMBERS) if(@operands != 2);
$total = subtract(@operands);
@operands = ($total);
}
}
return 100 - $total if $total > 100;
return $total - 100;
}
```

Genetic algorithms are a very large topic inside the even larger topic of artificial intelligence, but essentially, this `fitness()`

function returns a number based on how close the expression comes to the target value, 100. The higher the value `fitness()`

returns, the more likely it is to reproduce and pass on some of its properties (genes).

Thus, without needing to come up with any problem-specific algorithm, Adam’s GA code will slowly, over many generations, inch its way toward a solution. By “slowly,” I mean it took 45 seconds and 1,050,000 total individuals considered, to find one solution. It’s certainly an interesting way to solve this particular problem! I like Adam’s outside-the-box thinking on this one (and challenge #2).

**Adam’s Blog** › Evolving more code with AI::Genetic

## Alicia Bielsa

Alicia’s solution takes a constructive approach, iteratively adding to an `@aResults`

array containing numbers and operators (+ or -). Once that is done, she loops through again to calculate the result and print it, if it equals 100:

```
foreach my $matchIndex ( 0..$#aMatches ){
my $match = $aMatches[$matchIndex];
if ($match eq '+'){
$previousFlagSum = $currentFlagSum;
$currentFlagSum = 1;
} elsif ($match eq '-'){
$previousFlagSum = $currentFlagSum;
$currentFlagSum = 0;
} else {
$currentNumber .= $match ;
unless ($matchIndex == $#aMatches ){
next;
}
}
$previousNumber = $currentNumber ;
$currentNumber = 0;
next unless (defined $previousFlagSum );
if ( $previousFlagSum ){
$total += $previousNumber;
} else {
$total -= $previousNumber;
}
```

## Andrezgz

Andrezgz’s solution searches all 3⁸ possible ways to insert +, -, or the empty string between each digit, in a unique way:

```
my @digits = split //, '123456789';
my $initial = shift @digits;
my @values = ( '' , ' + ' , ' - ' );
foreach my $n (0 .. (3**8)-1) {
my $equation = $initial;
my @combination = split //, sprintf "%08d", to_base3($n);
$equation .= $values[ $combination[$_] ] . $digits[$_] for (0 .. @digits - 1);
print "$equation\n" if (eval $equation == 100);
}
```

Note that `@combination`

is a base 3 number, and the `$equation`

is built up by inserting a value from `@digits = ('', '+', '-')`

:

It’s a clever way to think about the problem.

## Cheok-Yin Fung

**New member** Cheok-Yin Fung’s solution uses a variant of the base-3 method, using some interesting modulo arithmetic to set each “digit”:

```
my @poweroft = (6561,2187, 729, 243, 81, 27, 9, 3, 1);
for my $i (1..6560) {
my @ooo = (0,0,0,0,0,0,0,0); # 0 -> conjuction , 1 -> plus , 2 -> minus
for my $j (0..7) {
$ooo[$j] = int($i % $poweroft[$j]) / int($poweroft[$j+1]) ;
}
...
}
```

The `int($i % $poweroft[$j]) / int($poweroft[$j+1])`

expression ensures that each digit of `@ooo`

will be in the range 0..2. Then, Cheok-Yin Fung assembles the result, conjoining objects when necessary:

```
my @objects = (1,0,0,0,0,0,0,0,0);
my $objectindex = 0;
for my $j (0..7) {
if ($ooo[$j] == 0) {
$objects[$objectindex] = $objects[$objectindex]*10 + $digits[$j+1];
} else {$objectindex++; $objects[$objectindex] = $digits[$j+1];}
}
my $result = $objects[0];
$objectindex = 0;
for my $j (0..7) {
if ($ooo[$j] == 1) {$objectindex++; $result += $objects[$objectindex]; }
if ($ooo[$j] == 2) {$objectindex++; $result -= $objects[$objectindex]; }
}
```

From here, they need only check if `$result == 100`

and print out the expression if so. The program finds all solutions.

Please join me in welcoming **Cheok-Yin Fung** to our team! If this week is any indication, they are sure to send some interesting solutions going forward.

## Colin Crain

Colin’s solution builds up the expressions in a novel way:

```
my @list = ( 1..9 );
my @equations = shift @list;
my $idx = 0;
for my $new ( @list ){
while (my $target = splice @equations, $idx, 1){
for (' + ', ' - ', ''){
splice @equations, $idx, 0, $target . $_ . $new;
$idx++;
}
}
$idx = 0;
}
```

The top-level loop `$new`

essentially adds new digits to the expression. The middle `while`

loop removes the `$idx`

-th equation from `@equation`

, and the inner `for`

loop replaces that with three more equations, for each of the three operations: addition, subtraction, and concatenation.

After this loop, `@equations`

contains all 3⁸ = 6,561 possible equations, and from there it is a simple matter of `eval`

-ing each one and printing out the ones that equal 100.

## Daniel Mantovani

Daniel’s solution does something very similar to Andrezgz’s. His version of the `to_base3()`

sub is named `ter()`

, which returns a list of digits:

```
sub ter {
my @m;
my $n = shift;
while ($n) {
push @m, $n % 3;
$n = int($n/3);
}
return @m;
}
```

The core logic is the `modify_string()`

function:

```
sub modify_string {
my ($in, $mod) = @_;
my @mods = ter($mod);
# if @m vector has more than needed elements, return undef
return undef if length($in) < @mods + 1;
my $result = '';
for my $d (split '', $in) {
# undefs at the end mean empty inter-digit appends
my $m = (shift @mods) // 0;
# just peek what to insert according to $m
$result .= $d . ('', ' + ', ' - ')[$m];
}
return $result;
}
```

Daniel’s extensive internal documentation reads very much like a blog, so his solution is worth a look if you would like to know more.

## Darren Bottin

Darren’s solution is another that considers a leading negative sign to be acceptable, and thus produces twelve solutions.

Darren iterates over combinations using a `@combination`

array that counts up in base-3, where each element maps to `@symbols`

, to get the various groupings of characters, as well as handle the addition and subtraction:

```
my @symbols =( ",", '', ",-"); # Split, Join, Negate
my @combination = ( 1,(0) x 8); # Skip over the join option for the first digit
my $solutions_found=0;
while(1) {
my $blend='';
for my $blend_dig (0..8) {
$blend .= $symbols[$combination[$blend_dig]].$numarray[$blend_dig];
}
...
}
```

The `@symbols`

correspond to:

`$symbols[0]`

› Split here, numbers will be added.`$symbols[1]`

› Do not split here.`$symbols[2]`

› Split here, second number will be subtracted.

The `next_combination()`

sub demonstrates how to write your own incrementer:

```
sub next_combination() {
# warn "NEXT COMB";
my $digit =8;
my $dval = $combination[$digit]++;
while ( $digit>=0 and $dval >= 2 ) { # carry left
$combination[$digit]=0;
$digit--;
$dval = $combination[$digit]++;
}
return $digit;
}
```

### Prolog

Darren also submitted a second solution in Prolog, shown here in part:

```
perm_sum( X, [X], ['+',X]). % Running total, Item, Backtrace
perm_sum(-X, [X], ['-',X]).
perm_sum(XS, [X|L],['+',X|BT]) :- perm_sum(LS,L,BT), XS is LS+X.
perm_sum(XS, [X|L],['-',X|BT]) :- perm_sum(LS,L,BT), XS is LS-X.
bond_comb([],X,X).
bond_comb([X|XL],Y,[X|Z]) :- bond_comb(XL,Y,Z). % single
bond_comb([X1,X2|XL],Y,Z) :- X12 is X1*10 + X2,
bond_comb([X12|XL],Y,Z). % combine digits
```

Darren considers a leading - to be allowed, so his script outputs twelve cases. The `perm_sum`

and `bond_comb`

clauses are what do most of the work. Clauses for both `+`

and `-`

ensure that the implicit recursion will branch for both values. Similarly, the `bond_comb`

clauses handle the combining of digits into larger numbers, or not.

## Dave Jacoby

Dave’s solution is implemented with a 9-nested loop, which considers every permutation of splits and operators. He uses string `eval`

to obtain the result of each expression. I will omit some of the middle loops, here:

```
my @vals = ('',' + ',' - ');
for my $i (@vals) {
for my $j (@vals) {
for my $k (@vals)
...
for my $q (@vals) {
my $string = join '','1',$i,'2',$j,'3',$l,'4',$m,'5',$n,'6',$o,'7',$p,'8',$q,'9';
my $resp = eval $string;
next unless $resp == 100;
say qq{$resp = $string};
}
...
}
}
}
```

Each loop variable `$i`

.. `$q`

will be one of `@vals`

, to either join, add, or subtract.

There’s a funny little bug: Dave’s script actually outputs each correct solution three times. Can you spot why? Hint (ROT13): gur svk jbhyq znxr gur cebtenz zber rssvpvrag. Answer: x vf abg hfrq.

## Dave Jacoby #2

Dave submitted a second, revised solution, which I found worthy of highlighting on its own. Here, Dave uses recursion to perform a search of all possible expressions:

```
my $vals->@* = ( ' + ', ' - ', '' );
my $source->@* = ( 1, '', 2, '', 3, '', 4, '', 5, '', 6, '', 7, '', 8, '', 9 );
sub challenge ( $source, $vals, $index ) {
# check to see if this is correct
if ( $index >= scalar $source->@* ) {
my $string = join '', $source->@*;
my $result = eval $string;
say qq{ $result = $string } if $result == 100;
return;
}
# recursively add to the array
my $next->@* = map { $_ } $source->@*;
for my $v ( $vals->@* ) {
$next->[$index] = $v;
challenge( $next, $vals, $index + 2 );
}
return;
}
```

## Duane Powell

Duane’s solution uses Math::BaseCalc to convert numbers between bases, and by now I bet you can guess why.

Duane iterates from 0..3⁸-1, converting that to a base-3 number, which he then uses to interleave operators (or the empty string) between each digit. Actually, his code is easily configurable to use different operators, and different target sum and input number, so these are just the defaults.

```
my %operator = (
0 => '',
1 => '+',
2 => '-',
);
my $comb = 3 ** ((scalar @n) -1); # 6561 combinations for 123456789
my $calc = new Math::BaseCalc(digits => [0,1,2]);
foreach (0 .. $comb-1) { # zero indexed
my @op = split(//,sprintf "%08d", $calc->to_base($_));
my $e;
# zipper together the two arrays (@n and @op) building str $e, for example 1+2+3+4+5+6+7+8+9
foreach my $n (@n) {
if (scalar @op) {
my $op = pop @op;
$e .= $n . $operator{$op};
}
else {
$e .= $n;
}
}
my $s = eval $e;
say "$e = $sum" if ( $s == $sum );
}
```

## Duncan C. White

Duncan’s solution is recursive, too. He uses Function::Parameters instead of the experimental `signatures`

feature, but they both produce very similar looking code:

```
fun mutate( $str, $ip, $nleft, $goal )
{
foreach my $a (@ch) # @ch = ('', '+', '-')
{
my $s2 = $str;
substr( $s2, $ip, 0, $a );
my $ip2 = $ip+1+length($a);
if( $nleft>1 )
{
mutate( $s2, $ip2, $nleft-1, $goal );
}
if( $nleft==1 )
{
my $n = eval $s2;
say "FOUND $s2" if $n==$goal;
}
}
}
```

Here, `$ip`

is short for “insertion point”. The `mutate()`

function inserts an operator at each possible position, in every possible permutation.

## E. Choroba

Choroba’s solution this week combines a few short subroutines. The top-level `while (1) { ... }`

loop sums up the intention nicely:

```
while (1) {
my $expression = apply(\@mask);
say $expression if 100 == evaluate($expression);
last unless grep $_ != MINUS, @mask;
increment(\@mask);
}
```

`@mask`

corresponds to the base-3 number we’ve seen in other solutions. The `increment()`

sub, which computes the next `@mask`

, is particularly elegant:

```
sub increment {
my ($mask) = @_;
my $i = $#$mask;
$mask->[$i--] = NOTHING while $mask->[$i] == MINUS;
++$mask->[$i];
}
```

The `apply()`

sub then takes that `@mask`

and interleaves the operators with the digits accordingly:

```
sub apply {
my ($mask) = @_;
return $digits[0]
. join "",
map $op{ $mask->[$_-1] } . $digits[$_],
1 .. $#digits
}
```

And finally `evaluate()`

uses a regex to split the expression into its terms and then simply sums them up:

```
sub evaluate {
my ($expression) = @_;
my @terms = $expression =~ /[-+]?[0-9]+/g;
return sum(@terms)
}
```

**Choroba’s Blog** › One Hundred, Two Hundred

## Fabrizio Poggi

Fabrizio’s solution seems to be a stochastic algorithm, iterating randomly to hopefully find a solution sooner. The following generates a random symbol:

```
sub ex {
my $sign = int(rand(3));
if($sign == 0) {
my $sym = "+";
return $sym;
} else {
if ($sign == 1) {
my $sym = "-";
return $sym;
} else {
if ($sign == 2) {
my $sym = "";
return $sym;
}
}
}
}
```

I might have replaced the above with something like `sub ex { ('', '-', '+')[rand 3] }`

, but the above works just as well.

Fabrizio then loops until a random expression equals 100:

```
while (1) {
$sum = 1 . ex() . 2 . ex() . 3 . ex() . 4 . ex() . 5
. ex() . 6 . ex() . 7 . ex() . 8 . ex() . 9;
$val = eval ($sum);
last if ($val == 100);
}
```

I love stochastic algorithms. Under the right circumstances, they can move an intractable problem right off the critical execution path. They can give you better best- and average-case performance. The tradeoff, though, is that the worst-case performance is unbounded, due to the loss of determinism.

To illustrate this, I ran Fabrizio’s code 10,000 times. The average case took 600 iterations, the minimum took just a *single* lucky iteration, while the worst case was 7,353.

## Javier Luque

Javier’s solution is recursive:

```
sub check_numbers {
my ($n, $nums, $goal) = @_;
if ($nums) {
my ($n2, $new_numbers) = split('', $nums, 2);
check_numbers($n . '+' . $n2, $new_numbers, $goal);
check_numbers($n . '-' . $n2, $new_numbers, $goal);
check_numbers($n . $n2, $new_numbers, $goal);
} else {
my $total = eval $n;
say $n if ($total == $goal)
}
}
```

`$nums`

is the string containing the remaining digits. Javier uses `split`

with a limit (3rd argument) to partition `$nums`

into `$n2`

and `$new_numbers`

. Thus, he is paring off one digit at a time, and then recursing once for each operation: addition, subtraction, and concatenation.

When `$nums`

is empty (boolean false), the base case is triggered, and a simple check of whether `eval $n`

is equal to the `$goal`

amount determines whether the equation is printed or not.

**Blog** › Perl Weekly Challenge – 044

## Laurent Rosenfeld

Laurent submitted four solutions to challenge #1 this week, covering two fundamentally different approaches. I will look at the “final forms” of each:

### Recursive

Laurent’s 1a solution is defined recursively, building up expressions by `chop`

ping off the last digit and recursing on each possible operation: addition, subtraction, or concatenation:

```
sub combine {
my ($combined, $source) = @_;
if ($source eq "") {
say $combined if eval $combined == 100;
return;
}
my $operand = chop $source;
for my $op ('+', '-', '') {
combine ("$combined$op$operand", $source);
}
}
my $source = reverse "123456789";
my $combined = chop $source;
combine ($combined, $source);
```

### Glob

Laurent then had the insight that he could solve this problem with `glob`

. His 1c solution is an impressive one-liner:

```
say for grep { 100 == eval } glob join "{+,-,}", 1..9;
```

Notice that the `join`

inserts the string `{+,-,}`

between each digit, so `glob`

can then generate all 3⁸ expressions. That’s all there is to see. After that, it’s a trivial matter of printing the expressions that `eval`

to 100. I’m a huge fan of this solution.

**Laurent’s Blog** › Only 100, Please and Make it 200

## Peter Scott

Peter’s solution is another that iterates through all base-3 numbers and maps those to operators. Where Peter’s solution differs, is in his use of List::MoreUtils’ `mesh()`

:

```
while ( 1 )
{
my @ops = ternary( $n );
my @interleave = ( map { $operators[$_] } @ops, 0 ); # Mesh wants same sizes
my @formula = mesh @digits, @interleave;
my $expr = join '', @formula;
my $res = eval $expr;
say "$expr = $res" and exit if $res == 100;
$n++;
}
```

While Peter’s code exits after finding the first solution, it will output all eleven if one simply removes the `and exit`

from the penultimate line in the above block.

`mesh`

helps Peter produce some clean, easily understood code. I like it.

## Roger Bell West

Roger’s solution is another that iterates in base-3, in the `@si`

array in this case:

```
my @base=(1..9);
my @sv=('','-','+');
my $maxdepth=8;
my @si=(0) x $maxdepth;
while (1) {
my $str=join('',map {$base[$_].$sv[$si[$_]]} (0..$maxdepth-1)).$base[$maxdepth];
my $tot=eval($str);
if ($tot == 100) {
print "$str\n";
}
my $i=0;
while ($i < $maxdepth) {
$si[$i]++;
if ($si[$i] <= $#sv) {
last;
}
$si[$i]=0;
$i++;
}
if ($i >= $maxdepth) {
last;
}
}
```

Roger’s code is easily understood. The `while`

loop does everything. The expression is composed by pairing a digit with an operator (`@sv`

), and incrementing in base-3 to set up the next iteration.

## Ruben Westerberg

Ruben’s solution is still another take on base-3 iteration, with his own `baseToDec()`

and `decToBase()`

subs, which he was able to re-use from last week’s challenge. Here is his main loop:

```
while ($i<$limit) {
my $num=sprintf "%08s0",decToBase(3,$i++);
my @ops=map {tr/120/+-/d;$_} split "",$num;
my $exp= join "",map {$digits[$_],$ops[$_]} 0..8;
my $sum=eval $exp;
print "sum: $sum from: $exp\n" if $sum==100;
}
```

I like the use of `tr//d`

to replace the base-3 numbers with their corresponding operators. Ruben uses string `eval`

to get the result, which is safe, because the
string is entirely composed by his program, and could be proven to be safe if so desired.

## Ryan Thompson

My solution is recursive, but divides up the recursive step a little differently:

```
sub sum_split {
my %o = @_;
if (0 == length $o{num}) {
my $sum = eval $o{exp} // return;
say "$sum == $o{exp}" if $sum == $o{sum};
return
}
# Partition $num and recurse
for (1..length $o{num}) {
my ($l, $r) = unpack "A$_ A*", $o{num};
my @cur_ops = length($o{exp}) > 0 ? @ops : @prefix_ops;
sum_split(%o, num => $r, exp => "$o{exp}$_$l") for @cur_ops;
}
}
```

Instead of essentially writing a base-3 counter as many did, my recursion step recurses on every 2-partition of the remaining string, using `unpack`

. For example, 123 => (1:23, 12:3, 123:). From there, I then insert every operator. The base case uses string `eval`

to get the result and outputs it if it equals the target.

`@cur_ops`

was necessary because I chose to allow the negative prefix. Allowing the negative prefix also means my program needed to check more solutions. I wanted to generalize the problem a bit, but I could have saved some complexity by sticking with the literal problem description.

I also did some experimentation with more operators, including the outrageous set `@ops = qw( + - * / % >> << & | )`

. That took a few minutes to run, since the number of permutations jumps to a few hundred million. There were 22,675 solutions (573KiB), like the following:

```
100 = +1 + 2 + 3 / 4 << 5 | 6 & 78 - 9
```

Can you place parentheses in that expression and have it still `eval`

to 100? I may have spent over an hour trying that with various examples from the output.

**My Blog** › Only 100, Please

## Saif Ahmed

Saif’s solution is another recursive one. Saif uses the replacement form of `substr`

to insert the operator into the string:

```
sub tryInsert{
my ($str,$target,$marker)=@_;
$marker //=1; # $marker identifies the first insertion point
# further attempts ar from this point to the
# postion before the last character in the string
foreach my $pos ($marker..((length $str)-1)){
foreach my $operator(qw{+ -}){
my $temp=$str; # put in a temporary string
substr $temp,$pos,0,$operator; # insert the operator
print $temp."\n" # print the reulting string
if eval ("$temp")==$target; # only if the result is our $target
tryInsert($temp,$target,$pos+2); # recurse with new insertion point
}
}
}
```

Saif’s solution is concise, and efficient. Nice.

## wanderdoc

wanderdoc’s solution goes back to the iterative approach we’ve seen, with the help of two CPAN modules:

- Algorithm::Combinatorics ›
`variations_with_repetition()`

- List::MoreUtils ›
`zip()`

The core module Scalar::Util is also used, for the `looks_like_number()`

function. Now let’s see how wanderdoc puts it all together:

```
my @operators = ('+', '-', '');
my $string = "123456789";
my @array = split(//,$string);
my $iter = variations_with_repetition( [@operators], $#array);
my %uniq;
while ( my $c = $iter->next ) {
my @z = zip(@array, @$c);
pop @z; # undef.
my $formula = join('',@z);
$uniq{ $formula }++;
next if $uniq{ $formula } > 1;
my $sum = eval $formula;
unless ( looks_like_number($sum) ) {
print $@, $/;
die "Sum is ${sum}: Something went wrong.";
}
next unless 100 == $sum;
print "${formula} = ${sum}$/";
}
```

`$iter`

is an iterator that now spits out a `$string`

length - 1 sized array of operators, like so:

```
+ + + + + + + +
+ + + + + + + -
+ + + + + + +
+ + + + + + - +
+ + + + + + - -
+ + + + + + -
(etc.)
```

All that needs to be done is to `zip()`

them together to interleave the operators into the `@array`

of digits, and then string-`eval`

the result.

# Task #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.*

This week’s second challenge in some respects was easier than the first, since there is an extremely elegant and efficient greedy algorithm to find the optimal path: instead of starting with $1, we start with $200 and work our way backwards. Whenever we have an even number, divide by 2, otherwise, subtract 1. This guarantees we will find the shortest path, which can simply be returned in reverse order. See my blog for some informal discussion on why this works.

While many people did implement the above algorithm, there were some excellent alternative solutions as well. For instance, many people simply brute-forced the small search space.

## Adam Russell

Adam’s solution again uses `AI::Genetic`

. See my discussion of his challenge #1 solution for a bit more background, or check out Adam’s blog. Here’s the fitness function:

```
sub fitness{
my($genes) = @_;
my $total = 1;
my $count_no_op = 1;
for my $gene (@{$genes}){
$total = $gene->($total);
$count_no_op++ if $gene->() =~ m/no/;
}
return 200 - $total if $total >= 200;
return ($total - 200) * $count_no_op;
}
```

The fitness function is much simpler this time. Here, it just returns the negative distance from 200, but multiplied by a count of the no-ops, to penalize individuals with genes turned off. While the challenge #1 GA took around 45 seconds to run on my system, this one took just 600ms.

The way Adam’s program produces an *optimal* solution bears some explanation: Adam sets up 9 genes which can each take on either `no_op`

, `add_one`

, or `double`

:

```
my $genes = [];
for (0 .. 8){
push @{$genes}, [\&add_one, \&double, \&no_op],
}
```

This means his program will, regardless of how much evolution takes place, never consider solutions with more than 9 operations. And we know that the optimal solution takes exactly 9 operations.

**Adam’s Blog** › Evolving code with AI::Genetic

## Alicia Bielsa

Alicia’s solution uses the greedy algorithm to make short work of the problem:

```
my $objective = 200;
while ($objective > 1 ) {
if ($objective % 2 == 0){
push (@aMoves, 'double');
$objective = $objective / 2;
} else {
push (@aMoves, 'add 1');
$objective = $objective - 1;
}
}
```

She then works through `reverse(@aMoves)`

to pretty-print the results:

```
my $amountMoney = 1;
foreach my $move (reverse(@aMoves)){
if ($move eq 'double'){
print "Double $amountMoney ";
$amountMoney = $amountMoney * 2 ;
print "= $amountMoney\n";
} else {
print "Add 1 to $amountMoney ";
$amountMoney = $amountMoney + 1 ;
print "= $amountMoney\n";
}
}
```

## Andrezgz

Andrezgz’s solution works through the search space by looping through every 10-bit number, mapping the 0s and 1s to `+ 1`

and `* 2`

, and finally string-`eval`

-ing each operation. With that, Andrezgz then returns the first set of `@ops`

that evaluates to 200.

```
use constant MOVES_LIMIT => 10; # upper bound of moves to check
foreach my $n ( 0 .. (2 ** MOVES_LIMIT)-1 ) {
my @ops = map { $_ ? '+ 1' : '* 2'} split //, sprintf("%b", $n);
my $value = 1;
$value = eval($value . $_) for (@ops);
if ($value == 200) {
@solution = @ops;
last;
}
}
```

This does find the shortest path, partly due to the choice of `MOVES_LIMIT => 10`

, which is very close to the optimal solution length of 9.

## Cheok-Yin Fung

Cheok-Yin Fung’s solution loops from 3..200, storing previous results in `@t`

. For each number, they consider whether dividing by 2 or subtracting 1 would lead to a shorter sequence, by looking at the previous term in the sequence.

```
my @t = (0, 0, 1);
for my $k (3..200) {
if ($k % 2 == 0) {$t[$k] = 1+ &min( $t[$k/2] , $t[$k-1])}
else {$t[$k] = $t[$k-1]+1;}
}
print $t[200], "\n";
```

This solution outputs the optimal number of operations. With a little bit of bookkeeping, it could output the sequence itself as well.

Both this solution and Cheok-Yin Fung’s solution for challenge #1 strike me as being quite analytical, which I appreciate.

## Colin Crain

Colin’s solution uses the greedy approach, succinctly:

```
while ( $value != 1) {
if ($value % 2 == 0){
$value /= 2;
}
else {
$value -= 1;
}
unshift @steps, $value; ## we build the array of steps from back to front
## so there is no need to reverse it later
}
```

Colin’s extended comments contain a lot of interesting analysis on his own journey toward proving that the greedy solution produces optimal results.

## Cristina Heredia

Cristina’s solution uses the greedy method, but splits the problem into two subs, which call each other to reduce `$number`

as quickly as possible. The code to output the solution is also included in the `remove()`

sub:

```
sub divide {
while (($number %2 )==0) {
$number = $number / 2;
unshift @moves, 'double ';
}
remove();
}
sub remove {
$number --;
unshift @moves, '+1$ ';
if ($number == 1 or $number == 0) {
print "The moves that you have to do are: \n";
$total = @moves;
print "$total\n";
print 'And they are: ';
foreach (my $i = 0; $i < @moves; $i++) {
print "@moves[$i]";
}
}
else {
divide();
}
}
```

Cristina is one of a few people who take advantage of `unshift`

to insert the moves at the beginning of the array, which saves having to do a `reverse`

later. Efficiency-wise, it’s not going to make any real difference here, but it does make for slightly cleaner code.

## Daniel Mantovani

Daniel’s solution takes the greedy approach, appending a plain-English sentence to `@steps`

for each operation:

```
while ($target > 1) {
if ($target % 2) {
push @steps, sprintf('Add $1 to $%i (new total $%i)', $target-1, $target);
$target--;
} else {
push @steps, sprintf('Multiply $%i by 2 (new total $%i)', $target / 2, $target);
$target /= 2;
}
}
```

Daniel then outputs `@steps`

:

```
for my $i (1..@steps) {
say "Step #$i: ", pop @steps;
}
```

## Dave Jacoby

Dave’s solution sets up a queue in `@array`

to do a breadth-first search (BFS) of the search space:

```
my @array = (1);
for my $i (@array) {
my $check = decode($i);
if ( $check == 200 ) {
say join "\t", $check, $i, scalar @array;
exit;
}
if ( $check > 200 ) {
next;
}
push @array, $i . 'p';
push @array, $i . 'd';
}
```

The `decode()`

sub takes a string like `1dppd`

and returns 8, since (((1 * 2) + 1) + 1) * 2 = 8:

```
sub decode ( $sample ) {
my ( $i, @list ) = split m//, $sample;
for my $l (@list) {
$i += 1 if $l eq 'p';
$i *= 2 if $l eq 'd';
}
return $i;
}
```

While you might be aware that adding or removing elements within the loop body is expressly discouraged in the Perl documentation for hopefully obvious reasons, the full truth is a bit more nuanced. Since Dave is only ever appending to the end of `@array`

, ahead of the current index, Perl never has any reason to get confused, so this works as a sort of sneaky queue.

## Duane Powell

Duane’s solution is another greedy implementation:

```
my @solution;
my $goal = 200;
push @solution, $goal;
while ($goal > 1) {
# if odd number deduct 1 making it even, otherwise divide by 2
$goal = ($goal % 2) ? $goal-1 : $goal/2;
# push this step into the solution set
push @solution, $goal;
}
say join(',',reverse(@solution));
```

Duane’s solution is concise, and outputs a minimalistic array of intermediate numbers (1,2,3,6,12,24,25,50,100,200), since anyone looking at that list can easily see whether each number is doubled or incremented.

## Duncan C. White

Duncan C. White’s solution exhaustively searches by maintaining a list of all possible sequences, which he builds up one character at a time, ensuring the shortest solution will be found first:

```
fun search( $initial, $goal ) {
my $seq = "";
my @todo = ( [$initial, ""] );
for(;;) {
# Build a new list of todo pairs, twice as long as the old one.
# stopping if we hit $goal
my @newtodo;
foreach my $pair (@todo) {
my( $currvalue, $currseq ) = @$pair;
return $currseq if $currvalue == $goal;
push @newtodo, [ 2 * $currvalue, $currseq."d" ];
push @newtodo, [ $currvalue + 1, $currseq."i" ];
}
@todo = @newtodo;
}
}
```

It’s an interesting way to iterate.

## E. Choroba

Choroba’s solution searches with the help of a `%possibilities`

hash to map seen values to the sequences of numbers:

```
my %possibilities = (1 => []);
while (! exists $possibilities{200}) {
for my $p (keys %possibilities) {
$possibilities{ $_ } ||= [ @{ $possibilities{$p} }, $p ]
for $p + 1, $p * 2;
}
}
my @moves = @{ $possibilities{200} };
say scalar @moves, ": @moves";
```

Starting from the degenerate case of `1 => []`

, Choroba expands on that by looping over all known solutions and adding 1 and multiplying by 2, and adding those results to `%possibilities`

. As soon as `$possibilities{200}`

exists, that expression must be the shortest, since it was checked for on every move.

**Choroba’s Blog** › One Hundred, Two Hundred

## Fabrizio Poggi

Fabrizio’s solution is another greedy implementation:

```
push @array, $number;
do {
if ($number % 2) {
$result = $number-1;
push @array, $result;
$number = $result/2;
push @array, $number;
} else {
$number = $number/2;
push @array, $number;
}
} while($number > 1);
@array = reverse@array;
print "@array\n";
```

This code conveys its intentions well, and does the task it was designed to do.

## Javier Luque

Javier’s solution recursively explores all sequences of incrementing or doubling, up to an arbitrarily defined maximum length:

```
sub add_or_double {
my ($cash, $steps, $solution) = @_;
$steps++;
return undef if $steps > 15; # Let's not recurse past 15
if ($cash == 200) {
if ($min_steps > $steps) {
$min_steps = $steps;
$min_solution = $solution;
}
}
add_or_double($cash * 2, $steps, $solution . 'd') if $cash * 2 <= 200;
add_or_double($cash + 1, $steps, $solution . 'a') if $cash + 1 <= 200;
}
```

The base case (`$cash == 200`

) looks at whether the current solution is shorter than the previous best solution, and replaces the best solution if so.

The recursive step simply calls `add_or_double()`

with the cash either doubled or incremented, with a bit of housekeeping to manage the sequence, and to avoid going over the goal amount.

**Blog** › Perl Weekly Challenge – 044

## Laurent Rosenfeld

Laurent’s solution works by starting at $1, attempting to increment between 0 and 30 times, greedily multiplying by 2 until it exceeds half the target, and then incrementing the rest of the way:

```
for my $incr (0..30) {
last if $incr > $min_ops;
my $current_val = START_VAL;
my @steps = ( START_VAL );
for my $add (1..$incr) {
push @steps, "+1";
$current_val++;
}
while ($current_val <= HALF_TARGET) {
push @steps, "*2";
$current_val *= 2;
}
while ($current_val < TARGET) {
push @steps, "+1";
$current_val++;
}
my $nb_steps = scalar @steps;
next if $nb_steps >= $min_ops;
$min_ops = $nb_steps;
$best_so_far = $incr;
$good_combinations{$incr} = [@steps];
}
```

This leads to a solution with 16 steps: `1 +1 +1 *2 *2 *2 *2 *2 *2 +1 +1 +1 +1 +1 +1 +1 +1`

, which is higher than the optimal 9-step solution. Had Laurent kept going, I’m certain he would have quickly found an optimal algorithm.

**Laurent’s Blog** › Only 100, Please and Make it 200

## Roger Bell West

Roger’s solution uses a queue to implement a breadth-first search:

```
my @seq=([1,[]]);
my $goal=200;
while (1) {
my $s=shift @seq;
if ($s->[0] == $goal) {
print join(', ',map {['double','add 1']->[$_]} @{$s->[1]}),"\n";
last;
}
push @seq,[$s->[0]*2,[@{$s->[1]},0]];
push @seq,[$s->[0]+1,[@{$s->[1]},1]];
}
```

Roger uses the familiar `while`

/`shift`

approach to implementing the queue, and uses an array of arrays to do some housekeeping, storing both the sequence and its value in each queue element, which avoids the need to do any parsing or extra computation later.

## Ruben Westerberg

Ruben’s solution uses the greedy method, building up the reversed sequence in `@moves`

:

```
my $target=200;
my @moves;
my $d=$target;
while ($d!=1) {
if ($d%2==0) {
push @moves, "Double";
$d/=2;
}
else {
push @moves, "Add 1";
$d-=1;
}
}
```

The results are then pretty-printed with the following code:

```
my $t=1;
printf "Start: \t\t%3d\n",$t;
for (reverse @moves) {
$t+=1 if /^A/;
$t*=2 if /^D/;
printf "Move:\t%s:\t%3d\n",$_, $t;
}
```

```
Start: 1
Move: Double: 2
Move: Add 1: 3
Move: Double: 6
Move: Double: 12
Move: Double: 24
Move: Add 1: 25
Move: Double: 50
Move: Double: 100
Move: Double: 200
```

## Ryan Thompson

My solution uses the greedy method, but then I also wrote a recursive method, to search all possible solutions of *n* moves or less. First, here’s the greedy one:

```
sub double_or_plus( $start, $end ) {
my @path = $end;
while ($end != $start) {
$end = $end % 2 ? $end - 1 : $end / 2;
unshift @path, $end;
}
@path;
}
```

And here’s the exhaustive recursive one (both of these use the `signatures`

feature, and `exhaustive()`

uses `current_sub`

as well):

```
sub exhaustive( $start, $end, $max_path ) {
my @shortest = (0) x ($max_path + 1);
sub ( $start, $end, @path ) {
push @path, $start;
return if @path > @shortest or $start > $end;
@shortest = @path and return if $start == $end;
__SUB__->($start + 1, $end, @path);
__SUB__->($start * 2, $end, @path);
}->($start, $end);
@shortest;
}
```

My blog has an informal justification for why the greedy method will always be optimal. I wrote the exhaustive one mainly for fun, but also so I could say I validated the greedy results for every value past `$end = 100_000`

.

**My Blog** › Make it 200

## Saif Ahmed

Saif’s solution traverses the search space iteratively, effectively doubling the length of `@options`

each time:

```
sub doubleOrAdd{ # this routine takes starting value and final target
my ($start,$target)=@_;
return print "Number out of bounds\n" # too big takes too long and
if $target>100000 or $target<$start; # can't be smaller than $target
my @options=("$start"); # initialise list of operations,
my $found=($start==$target); # do we already have goal?
while (! $found){
@options = map {("($_+1)","($_*2)")} @options; # add the two possible ops
foreach my $answer ( @options ) { # test each of the sequences
if ( eval("$answer")==$target) { # against our target
# number of moves is count of open brackets,remove these.
print $answer=~s/\(//g," moves required\n";
$answer=~s/^(\d+)/Start with \$$1,\n/; # the starting number is 1st number
$answer=~s/\+1\)/ add 1,\n/g; # make the result human
$answer=~s/\*2\)/ double it,\n/g; # readable:
print $answer;
$found=1;last; # stop looking
};
};
}
print " Now you have \$$target!"; # declare discovery
}
```

What I find most interesting is the way Saif builds up the pretty-printed output. When an answer is found, Saif will have a string like `(((((((((1+1)+1)*2)*2)*2)+1)*2)*2)*2)`

, which the three substitution regexes pull apart and turn into plain English.

## Wanderdoc

Wanderdoc’s solution is another greedy implementation, kept nice and straightforward:

```
while ( $START >= 1 )
{
push @steps, [$START, $GOAL];
if ( $START % 2 == 0 )
{
$START /= 2;
}
else
{
$START -= 1;
}
}
```

wanderdoc’s output step iterates over `reverse @steps`

and prints a 3-column output of the step number, current value, and goal (always 200):

```
my $counter = 0;
for my $step ( reverse @steps )
{
print join("\t", $counter, @$step[0,1] ), $/;
$counter++;
}
```

## SEE ALSO

### Blogs this week:

(1) **Adam Russell** › Challenge 1 | Challenge 2

(2) **E. Choroba** › One Hundred, Two Hundred

(3) **Javier Luque** › Perl Weekly Challenge - 044

(4) **Laurent Rosenfeld** › Only 100, Please, and Make it $200

(5) **Ryan Thompson** › Only 100 please | Make it 200