Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Sum to 100 at Rosetta Code

by choroba (Bishop)
on Feb 17, 2018 at 17:52 UTC ( #1209392=perlmeditation: print w/replies, xml ) 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 +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

      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 (Chaplain) 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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://1209392]
Approved by Albannach
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2018-10-19 11:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    When I need money for a bigger acquisition, I usually ...














    Results (107 votes). Check out past polls.

    Notices?