Sum to 100 at Rosetta Code

by choroba (Bishop)
 on Feb 17, 2018 at 17:52 UTC Need Help??

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.

```(\$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,

Replies are listed 'Best First'.
Re: Sum to 100 at Rosetta Code -- oneliner
by Discipulus (Monsignor) on Feb 18, 2018 at 14:30 UTC
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

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.
Re: Sum to 100 at Rosetta Code
by karlgoethebier (Monsignor) 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.

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

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

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

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

Does your Perl version support "say" ?

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

Cheers Rolf
(addicted to the Perl Programming Language and ☆☆☆☆ :)
Wikisyntax for the Monastery

Re: Sum to 100 at Rosetta Code
by trippledubs (Hermit) 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,("\$`\$&+\$'","\$`\$&-\$'");
}
}
```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

With '12345678912345' 3080 solutions

Create A New User
Node Status?
node history
Node Type: perlmeditation [id://1209392]
Approved by Albannach
Front-paged by haukex
help
Chatterbox?
 [Corion]: Meh. Once again I find that SQLite doesn't support window functions and I want to use those nowadays :-) [erix]: [Corion]: Hmm - actually, I don't need them, even though they'd be nice. I just want the (say) 10 latest images, and that's easily done with a limit 10 offset 0 clause, as I don't need all top 10 images for all users. [Corion]: erix: Sure, but this is for a really-lightweight application and I'm replacing a CSV file / JSON file for user configuration with SQLite (and optionally, Pg) :) [erix]: isn't a texty format handier for configs? [Corion]: So far, I've avoided having even a user database by storing the user information in a (signed) cookie that the browser keeps for me, but as I want to be able to lock users, I need a second storage option :)

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (12)
As of 2018-03-20 14:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When I think of a mole I think of:

Results (253 votes). Check out past polls.

Notices?