Sum to 100 at Rosetta Code

[choroba]

After a long time, I checked the list of tasks not implemented in Perl on RosettaCode. One of them was "Sum to 100", kind of similar to mjd's Simple but difficult arithmetic puzzle:

In the string 123456789, you can prepend + or - before any digit to form an expression. You should

• list all the possible expressions that evaluate to 100
• show the number that is a result of the maximal number of expressions
• show the lowest positive number that can't be expressed
• show the ten highest numbers that can be expressed

Here's my solution:

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $string = '123456789';
my $length = length $string;
my @possible_ops = ("" , '+', '-');

{
    my @ops;
    sub Next {
        return @ops = (0) x ($length) unless @ops;

        my $i = 0;
        while ($i < $length) {
            if ($ops[$i]++ > $#possible_ops - 1) {
                $ops[$i++] = 0;
                next
            }
            # + before the first number
            next if 0 == $i && '+' eq $possible_ops[ $ops[0] ];

            return @ops
        }
        return
    }
}

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

my %count = ( my $max_count = 0 => 0 );

say 'Show all solutions that sum to 100';

while (my @ops = Next()) {
    my $expression = "";
    for my $i (0 .. $length - 1) {
        $expression .= $possible_ops[ $ops[$i] ];
        $expression .= substr $string, $i, 1;
    }
    my $sum = evaluate($expression);
    ++$count{$sum};
    $max_count = $sum if $count{$sum} > $count{$max_count};
    say $expression if 100 == $sum;
}

say 'Show the sum that has the maximum number of solutions';
say "sum: $max_count; solutions: $count{$max_count}";

my $n = 1;
++$n until ! exists $count{$n};
say "Show the lowest positive sum that can't be expressed";
say $n;

say 'Show the ten highest numbers that can be expressed';
say for (sort { $b <=> $a } keys %count)[0 .. 9];

I tried to avoid eval to evaluate the expressions, at the same time, I didn't want to implement the traditional full math expression parser as there were only two operations of the same precedence in use.

$sum += $_ for $expression =~ /([-+]?[0-9]+)/g;

Feel free to comment on perlishness, effectiveness, golfness, or beauty of the solution, or propose your own.

Note: Those interested in Perl 6 can read the solution just below mine.

[Discipulus]

just the first quest..

 perl -E "say for grep{eval $_ == 100} glob join '{+,-,}',1..9"

PS sorry missed: -1+2-3+4+5+6+78+9

 perl -E "say for grep{eval $_ == 100} glob '{-,}'.join '{+,-,}',1..9"

L*

UPDATE Feb 21 2018, just for my own pleasure:

1. Show all solutions that sum to 100
2. Show the sum that has the maximum number of solutions (from zero to infinity*)
3. Show the lowest positive sum that can't be expressed (has no solutions), using the rules for this task
4. Show the ten highest numbers that can be expressed using the rules for this task (extra credit)


perl -MList::Util="first" -E "@c[0..10**6]=(0..10**6);say for grep{$e=
+eval;$c[$e]=undef if $e>=0;$h{$e}++;eval $_==100}glob'{-,}'.join'{+,-
+,}',1..9;END{say for(sort{$h{$b}<=>$h{$a}}grep{$_>=0}keys %h)[0],firs
+t{defined $_}@c;say for(sort{$b<=>$a}grep{$_>0}keys %h)[0..9]}"

-1+2-3+4+5+6+78+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
9
211
123456789
23456790
23456788
12345687
12345669
3456801
3456792
3456790
3456788
3456786

[karlgoethebier]

But this code doesn't compile...

karls-mac-mini:playground karl$ perl -c ./choroba.pl
Global symbol "$max_count" requires explicit package name (did you for
+get to declare "my $max_count"?) at ./choroba.pl line 14.
Global symbol "$sum" requires explicit package name (did you forget to
+ declare "my $sum"?) at ./choroba.pl line 14.
Global symbol "%count" requires explicit package name (did you forget 
+to declare "my %count"?) at ./choroba.pl line 14.
Global symbol "$sum" requires explicit package name (did you forget to
+ declare "my $sum"?) at ./choroba.pl line 14.
Global symbol "%count" requires explicit package name (did you forget 
+to declare "my %count"?) at ./choroba.pl line 14.
Global symbol "$max_count" requires explicit package name (did you for
+get to declare "my $max_count"?) at ./choroba.pl line 14.
Global symbol "$expression" requires explicit package name (did you fo
+rget to declare "my $expression"?) at ./choroba.pl line 16.
Global symbol "$sum" requires explicit package name (did you forget to
+ declare "my $sum"?) at ./choroba.pl line 16.
Unmatched right curly bracket at ./choroba.pl line 17, at end of line
syntax error at ./choroba.pl line 17, near "}"
./choroba.pl has too many errors.

Update: It compiles. I copied the code from the download link into an emacs buffer as i did it many thousand times before. For some unknown reason the result was broken. I never observed this before. I'm very sorry. And to be honest: I couldn't hardly imagine that choroba should have posted something that doesn't compile.

Best regards, Karl

[Athanasius]

Strange. It compiles and runs for me under Windows 8.1, 64-bit:

22:52 >perl 1870_Med.pl
Show all solutions that sum to 100
123-45-67+89
12-3-4+5-6+7+89
12+3+4+5-6-7+89
123+4-5+67-89
-1+2-3+4+5+6+78+9
1+2+3-4+5+6+78+9
12+3-4+5+67+8+9
1+23-4+56+7+8+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
123+45-67+8-9
123-4-5-6-7+8-9
Show the sum that has the maximum number of solutions
sum: 9; solutions: 46
Show the lowest positive sum that can't be expressed
211
Show the ten highest numbers that can be expressed
123456789
23456790
23456788
12345687
12345669
3456801
3456792
3456790
3456788
3456786

22:52 >perl -v

This is perl 5, version 26, subversion 0 (v5.26.0) built for MSWin32-x
+64-multi-thread-ld

Have you double-checked the contents of your choroba.pl file?

Update: FWIW, I get the same result under Cygwin:

$ perl -v

This is perl 5, version 22, subversion 4 (v5.22.4) built for cygwin-th
+read-multi

[LanX]

Does your Perl version support "say" ?

update

This looks like a runaway error in the first 4 lines.

[trippledubs]

For summing to 100, I got all but one with this

#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';

my @queue = '123456789';

while (@queue) {
        $_ = shift @queue;
        say if eval == 100;
        while ( /\d+?/g) {
                next if (!$' || $' =~ /\+|\-/);
                push @queue,("$`$&+$'","$`$&-$'");
        }
}

123-45-67+89
123+4-5+67-89
123+45-67+8-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-6-7+8-9
1+2+3-4+5+6+78+9

Eventually resorted to this to get the last one

#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';

my @queue = '123456789';

my %seen;

while (@queue) {
    local $_ = shift @queue;
    next if (exists $seen{$_});
    $seen{$_}++;
    say if eval == 100;
    while (/\d+?/g) {
        my ($pre,$match,$post) = ($`,$&,$');
        push @queue, "$pre$match+$post" unless (!$post || $post =~ /[+
+-]/);
        push @queue, "$pre-$match$post" unless ($pre =~ /[-+]$/ );
    }
}

I think a better regex solution exists, this re-evaluates too many times. I used structure from tybalt89's Re: Parks Puzzle.

With '1234567891234' 1222 solutions

• choroba 13.459s
• Discipulus 19.835s
• tripledubs 38.762s

With '12345678912345' 3080 solutions

• choroba 42.444s
• Discipulus 1m 30s
• tripledubs 2m 4s