Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

Now you can write arbitrarilly-nested loops easily.

Today in the CB, artist proposed a "math"1 puzzle (heavily paraphrased by me): Find a set of numbers where each is composed of the exact same set of digits just in different orders, such that the numbers sum to 2003. For example, if I had asked about 2070, you would tell me 2070 = 198+891+981.

I fairly quickly threw together some code to search for a solution. I decided that adding 1 together 2003 times was not interesting and neither was adding 2003 up once. I didn't want to allow leading zeros nor repeated digits and I wanted the digit orders to be different for each number so I knew I only had to worry about picking 3 digits:

my %h; for my $x ( 1..9 ) { for my $y ( $x+1..9 ) { for my $z ( $y+1..9 ) { my @a= ( $x, $y, $z ); my @p; do { push @p, join "", @a; } while( nextPermute(@a) ); for my $i ( 0..$#p ) { for my $j ( $i+1..$#p ) { for my $k ( $j+1..$#p ) { $h{$p[$i]+$p[$j]+$p[$k]} .= "=$p[$i]+$p[$j]+$p[$k]"; } } } } } } for my $k ( 1990 .. 2010 ) { print "$k=$h{$k}\n" if exists $h{$k}; }
which I combined with Permuting with duplicates and no memory to produce:
1998=189+891+918=198+819+981=279+792+927=... 2004=149+914+941=617+671+716=527+725+752 2007=198+891+918=387+783+837=459+594+954=...
So, no "good" solution for 2003. So I started widening the search by allowing zeros, repeated digits, repeated orderings (by simply changing "0" to "1" and dropping a few "+1"s). Still no solution.

So, since I was allowing repeated orderings, maybe I should add up more than 3 numbers. So I changed the code to add up 4 numbers and found:

2003=089+098+908+908=368+386+386+863=485+485+485+548
And then I went D'Oh!. I should have been allowing up to 6 numbers and not allowing duplicates. So the inner loops got rather complicated:
for my $i ( 0..$#p ) { for my $j ( $i+1..$#p ) { $h{$p[$i]+$p[$j]} .= "=$p[$i]+$p[$j]"; for my $k ( $j+1..$#p ) { $h{$p[$i]+$p[$j]+$p[$k]} .= "=$p[$i]+$p[$j]+$p[$k]"; for my $l ( $k+1..$#p ) { $h{$p[$i]+$p[$j]+$p[$k]+$p[$l]} .= "=$p[$i]+$p[$j]+$p[$k]+$p[$l]"; for my $m ( $l+1..$#p ) { $h{$p[$i]+$p[$j]+$p[$k]+$p[$l]+$p[$m]} .= "=$p[$i]+$p[$j]+$p[$k]+$p[$l]+$p[$m]"; for my $n ( $m+1..$#p ) { $h{$p[$i]+$p[$j]+$p[$k]+$p[$l]+$p[$m]+$p[$n]} .= "=$p[$i]+$p[$j]+$p[$k]+$p[$l]+$p[$m]+$p[$n]"; } } } } } }
and so I thought I'd turn it into a iterator similar to how I do things like (tye)Re: getting my neighbours in an N-dimensional space so that I could play with 4-digit numbers etc. without having to change the code, adding more loops and more $z, $w, $v, etc. variables.

But this one-off code had just been so easy to write. Making an iterator was going to be a bit tricky... I should write something to make writing the iterator nearly as easy as the one-off code...

This resulted in what I think is perhaps the neatest 30-odd lines of Perl code that I've ever written (but the blush will surely come off the rose after a bit of time passes).

This code lets you write arbitrarilly nested loops so that you can switch between having loops nested 6 deep or nested 4 deep without modifying any code. I think I'll upload it to CPAN as Algorithm::Loops (or Algorithm::NestedLoops) before long.

sub nestedLoops { my( $loops, $params )= @_; my $code= $params && $params->{Code}; my @list; my $when= $params && $params->{OnlyWhen} || sub { @_ == @$loops }; my $i= -1; my @idx; my @vals= @$loops; my $iter= sub { while( 1 ) { # Prepare to append one more value: if( $i < $#$loops ) { $idx[++$i]= -1; $vals[$i]= $loops->[$i]->(@list) if 'CODE' eq ref $loops->[$i]; } # Increment furthest value, chopping if done there: while( @{$vals[$i]} <= ++$idx[$i] ) { # Return if all done: return if --$i < 0; pop @list; } $list[$i]= $vals[$i][$idx[$i]]; if( ! ref $when || $when->( @list ) ) { return @list; } } }; return $iter if ! $code; while( $iter->() ) { $code->( @list ); } }
and you use it like so (showing both how to use it to get an iterator and how to use it with a call-back):
my $digs= 3; my $fact= 1; $fact *= $_ for 2..$digs; my %h; my $getDigits= nestedLoops( [ [0..9], ##[1..9], ( sub { [ $_[-1] .. 9 ] } ) x ($digs-1), ##( sub { [ $_[-1]+1 .. 9 ] } ) x ($digs-1), ] ); my @list; while( @list= $getDigits->() ) { my @p; do { push @p, join "", @list; } while( nextPermute( @list ) ); nestedLoops( [ [0..$#p], ( sub { [ $_[-1]+1 .. $#p ] } ) x ($fact-1), ], { OnlyWhen => 1, Code => sub { my $expr= join "+", @p[@_]; my $noOct= $expr; $noOct =~ s/(?<!\d)0+(\d)/$1/g; ## $expr= "()" if @_ < 6; $h{eval $noOct} .= "=$expr"; }, }, ); } ##for my $k ( sort { length($h{$a}) <=> length($h{$b}) ## || $a <=> $b } keys %h ) { for my $k ( sort { $a <=> $b } keys %h ) { print "$k$h{$k}\n" if 1990 < $k and $k < 2010; ##if $h{$k} =~ /\d/ && index($h{$k},"()") < 0; }
with parts of the code that you might want to swap in (to find "interesting" things) commented with "##".

And, yes, I did find exactly one "good" solution for 2003. With the code provided, you can too.

I think artist should go back to the person who provided this puzzle and offer a counter puzzle: I wanted to give you this puzzle using a number other than 2003 but make it as hard as possible while still only using 3-digit numbers in the solution. I came up with exactly two candidates to replace 2003. What were they? (:

                - tye

1 I've had math teachers get mildly annoyed when "math" is used when "arithmatic" is more appropriate, hence the quotes.


In reply to Coming soon: Algorithm::Loops by tye

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (4)
    As of 2021-04-13 23:09 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?