laurent_r

These are some answers to the Week 44 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

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.

Only 100, Please, in Perl

For solving this task, we first use a recursive combine subroutine that generates all possible strings by inserting between the digits of the “123456789” string the + plus addition, the - subtraction operator, or the '' empty string (i.e. no operator). We then use the evaluate subroutine with each string to perform the various arithmetic operations and compute whether the total is 100.

use strict;
use warnings;
use feature "say";

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

sub evaluate {
    my $expr = shift;
    my $val = 0;
    $val += $_ for $expr =~ /([+-]?[0-9]+)/g;
    return $val;
}

my $source = reverse "123456789";
my $combined = chop $source;
combine ($combined, $source);

This program displays the following strings evaluating to 100:

$ perl only-100_1.pl
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

In fact, we don’t really need the evaluate subroutine, since the eval built-in function (in its so-called “string eval” form) can do it for us:

use strict;
use warnings;
use feature "say";

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);

This program displays the same output as before.

The glob built-in function can lead us one step further, since it can create the combinations for us. To understand how it works, consider the following one-liner copied in part from the glob documentation:

$ perl -E 'say for glob "({apple,tomato,cherry}-{green,yellow,red})";'
(apple-green)
(apple-yellow)
(apple-red)
(tomato-green)
(tomato-yellow)
(tomato-red)
(cherry-green)
(cherry-yellow)
(cherry-red)

(Don’t try to insert spaces between the words, as it would probably break everything. It is sometimes a bit difficult for me to understand how glob reacts, so I tend to avoid using it for such tasks. Here, I’ll do it for illustration purpose.)

We can use glob to generate all the combinations needed:

use strict;
use warnings;
use feature "say";

for my $expr (glob join "{+,-,}", 1..9) {
    say $expr if eval $expr == 100;
}

This displays the same output as before:

$ perl only-100_3.pl
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

At this point, the program is so short that we can even make it a simple one-liner:

$ perl -E 'say for grep { 100 == eval } glob join "{+,-,}", 1..9;'
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

Only 100, Please, in Raku

I was initially thinking that the Z and/or X operators might make it easy to generate all the digits/operators combinations, but that turned out to be more difficult that I expected for our specific task.

So, let’s try to port our first Perl implementation in Raku. Besides the usual minor differences between Perl and Raku, I encountered an unexpected difficulty: in Raku, the chop function returns the string with the last character chopped off, rather than, as in Perl, the character that has been removed. Rather than changing the algorithm, I decided to implement the my-chop subroutine to mimic the Perl chop behavior. Note that my very dear friend Liz Mattijsen wrote a P5chomp module that implements for Raku versions of chomp and chop with the Perl semantics. But, as usual, I don’t want to have external modules perform the work for me in the case of a programming challenge, so I wrote my own version.

use v6;

sub my-chop (Str $in is rw) {
    my $char = $in.substr(*-1);
    $in = $in.substr(0, $in.chars - 1);
    $char;
}

sub combine (Str $combined, Str $source is copy) {
    if $source eq "" {
        say $combined if evaluate($combined) == 100;
        return; 
    }
    my $operand = my-chop $source;
    for '+', '-', '' -> $op {
        my $str = "$combined$op$operand";
        combine($str, $source);
    }
}       

sub evaluate (Str $expr) {
    my $val = 0;
    $val += $_ for $expr ~~ m:g/(<[+-]>?\d+)/;
    return $val;
}

my $source = "123456789".flip;
my $combined = my-chop $source;
combine $combined, $source;

This program displays the following output:

$ perl6 only-100.p6
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

I must admit that this solution is more complicated than it ought to be. Using the chop function was useful in Perl because the same statement fulfilled two goals, getting one item from the list and removing it from the list. The fact that Raku doesn’t have the same behavior, which led me to write my own my-chop subroutine, makes this solution somewhat clunky. There are better ways to deal with this problem, but, due to some other personal commitments, I am unfortunately very late and don’t have time right now to develop them. And this situation is going to last for another 7 to 8 weeks. So, please don’t expect from me contributions to the level that I’m usually trying to achieve until about March 22 of this year. I’m sorry about that. Hopefully this will improve thereafter.

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.

Obviously, doubling your asset is a faster way to go high values than just adding 1. But, if you only double your asset, you get powers of 2, leading you to 128, and then you have to go all the way from 128 to 200, which is most probably not the fastest way to get to 200. In fact, if you first go to three (for example by adding 1 twice), then multiplying by 2 six times, you get to 192, which is much closer to 200. That’s 16 moves, which seems not bad at all. But there may be a yet faster way, let’s see.

Make is $200 in Perl

We try first to add 1 between 0 and 30 times (we don’t really need to go that far, since we’ve seen that there is a solution in 16 moves, but we don’t really go all the way to 30, since we end the loop as soon as we reach number of steps of the best solution found so far), then try to double the capital as many times as possible and then complete with new additions.

use strict;
use warnings;
use feature "say";
use constant { START_VAL => 1, TARGET => 200};
use constant HALF_TARGET => TARGET /2;

my $min_ops = TARGET;
my $best_so_far;
my %good_combinations;

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];
}
say "Best solution: @{$good_combinations{$best_so_far}}";

This prints out the following solution:

$ perl target200.pl
Best solution: 1 +1 +1 *2 *2 *2 *2 *2 *2 +1 +1 +1 +1 +1 +1 +1 +1

In theory, there could some more complex combinations, such as add 1 a number of times, multiply by 2 a few times, add again 1 a number of times, multiply again by 2 a few times, then again add 1 a few times, and so on. For some other targets, we might find a better solution this way, but for a target of 200, there isn’t going to be a better solution, since we get very quickly to 192, which is pretty close to 200.

Make is $200 in Raku

I don’t see any Raku feature that could make it simpler than in Perl, so I’ll simply port the Perl program to Raku:

use v6;

constant START-VAL = 1;
constant TARGET = 200;
constant HALF-TARGET = TARGET / 2;

my $min-ops = TARGET;
my $best-so-far;
my %good-combinations;

for 0..30 -> $incr {
    last if $incr > $min-ops;
    my $current-val = START-VAL;
    my @steps = ( START-VAL );
    for 1..$incr -> $add {
        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 = @steps.elems;
    next if $nb-steps >= $min-ops;
    $min-ops = $nb-steps;
    $best-so-far = $incr;
    %good-combinations{$incr} = [@steps];
}
say "Best solution: %good-combinations{$best-so-far}";

This program prints out ther same result as before:

$ perl6 target200.p6
Best solution: 1 +1 +1 *2 *2 *2 *2 *2 *2 +1 +1 +1 +1 +1 +1 +1 +1

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, February 2. And, please, also spread the word about the Perl Weekly Challenge if you can.