Perl: the Markov chain saw PerlMonks

### comment on

 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};
}
[download]```
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=...
[download]```
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
[download]```
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]";
}
}
}
}
}
}
[download]```
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 );
}
}
[download]```
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;
}
[download]```
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: & & < < > > [ [ ] ]
• 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?