Sum to 100 at Rosetta Code

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];
[download]

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;
[download]

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.

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
[download]

Comment on Sum to 100 at Rosetta Code Select or Download Code

Replies are listed 'Best First'.

Re: Sum to 100 at Rosetta Code -- oneliner
by Discipulus (Canon) on Feb 18, 2018 at 14:30 UTC


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

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


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

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
[download]

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

[reply]
[d/l]
[select]

Re: Sum to 100 at Rosetta Code
by trippledubs (Deacon) on Feb 25, 2018 at 00:49 UTC

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,("$`$&+$'","$`$&-$'");
        }
}
[download]

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
[download]

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 =~ /[-+]$/ );
    }
}
[download]

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

[reply]
[d/l]
[select]

Re: Sum to 100 at Rosetta Code
by karlgoethebier (Abbot) on Feb 18, 2018 at 11:57 UTC

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.
[download]

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

�The Crux of the Biscuit is the Apostrophe�

perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

[reply]
[d/l]
[select]

Re^2: Sum to 100 at Rosetta Code

by Athanasius (Archbishop) on Feb 18, 2018 at 12:57 UTC

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
[download]

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
[download]

Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

Re^2: Sum to 100 at Rosetta Code

by LanX (Saint) on Feb 18, 2018 at 14:05 UTC

update

Cheers Rolf
_{(addicted to the Perl Programming Language and ☆☆☆☆ :)

Wikisyntax for the Monastery}

[reply]

Re: Sum to 100 at Rosetta Code
by trippledubs (Deacon) on Feb 06, 2019 at 16:53 UTC

#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use IPC::SysV qw/IPC_PRIVATE S_IRUSR S_IWUSR IPC_NOWAIT/;
use IPC::Msg;

# echo $((2**31-1)) > /proc/sys/kernel/msgmnb
my $q = IPC::Msg->new(IPC_PRIVATE,S_IRUSR|S_IWUSR);

sub quit { $q->remove; }
$SIG{INT} = \&quit;

my $string = '12345678912345';
$q->snd(1,$string) or die "$!";
$q->snd(1,"-$string") or die "$!";

my $parent = $$;

my $n_workers = shift // die;

die "128 workers max" if ($n_workers > 7);

fork // die $! for (1..$n_workers);

while ( $q->rcv(local $_,32,0,IPC_NOWAIT) ) {
    say if eval == 100;
    while (/\d+?/g) {
        next if ( !$' || index( $', '-' ) > -1 || index( $', '+' ) > -
+1 );
        $q->snd(1,"$`$&+$'",IPC_NOWAIT) or die $!;
        $q->snd(1,"$`$&-$'",IPC_NOWAIT) or die $!;
    }
}

END {
    1 until wait == -1;
    if ($$ == $parent) {
        quit;
    }
}
[download]

2x - 2m11s
4x - 55s
8x - 23s
16x - 12s
32x - 7s

[reply]
[d/l]


Pathologically Eclectic Rubbish Lister
	PerlMonks