Coming soon: Algorithm::Loops

Now you can write arbitrarilly-nested loops easily.

Today in the CB, artist proposed a "math"¹ 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

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

Comment on Coming soon: Algorithm::Loops Select or Download Code

Replies are listed 'Best First'.
Re: Coming soon: Algorithm::Loops by tall_man (Parson) on Apr 11, 2003 at 23:15 UTC
A couple of observations from number theory to reduce the search space. The number 2003 is congruent to 5 mod 9, and taking sums of base-ten digits reduces them mod 9. If three permutations of digits $x, $y, and $z could solve the puzzle, then: `(3($x+$y+$z) % 9) == 5` [download] But 3 has no inverse mod 9 because of the common factor, so it's impossible with 3 permutations. `if (4($x+$y+$z) % 9) == 5 then ($x+$y+$z) % 9 = 8 if (5($x+$y+$z) % 9) == 5 then ($x+$y+$z) % 9 = 1 if (7($x+$y+$z) % 9) == 5 then ($x+$y+$z) % 9 = 2` [download] 6 is impossible because of the common factor. For any given $x, $y you can calculate what $z would have to be (or eliminate it if it's a duplicate of the others). That should cut down your search space by a lot.	[reply] [d/l] [select]
Re^2: Coming soon: Algorithm::Loops (analysis) by tye (Sage) on Apr 12, 2003 at 06:50 UTC
I just wanted to mention that the code ran so fast (I didn't even notice how long it took, probably a couple of seconds) that I didn't get around to thinking at all about about analysis of the problem since I had no need to cut down the search space (and I got into the loop rewriting). And I also wanted to thank you for the analysis. Nicely done. (: - tye	[reply]
Re: Coming soon: Algorithm::Loops by Abigail-II (Bishop) on Apr 11, 2003 at 22:12 UTC
I found 301 years with a unique solution in the range 2000 till 3000. I used a different, IMO, simpler program than the one you describe. I think you are referring to 2001 and 2005 as candidates in the counter puzzle. Anyway, my program is after the readmore tag. Abigail Read more... (1520 Bytes)	[reply] [d/l]
Re^2: Coming soon: Algorithm::Loops (puzzle2) by tye (Sage) on Apr 12, 2003 at 07:06 UTC
I think you missed the hint in the code: `## $expr= "()" if @_ < 6;` [download] I noticed that there were only two numbers with unique solutions involving 6 terms. So we agreed that a number with only one solution would make the problem harder. I felt that more terms in that solution would also make it harder. But my statement of the puzzle was pretty vague. [ And sure you can simplify the code if you hard-code three loops and hard-code the permutations. It runs fast enough that it'd be interesting to look at 4-digit terms next... ;) ] - tye	[reply] [d/l]
Re: Coming soon: Algorithm::Loops (puzzle2) by Abigail-II (Bishop) on Apr 12, 2003 at 23:25 UTC
Sorry, I hadn't studied the code well enough that you intended to find years with a unique solution, and the solution requiring six terms. A modified version of my program finds 5106 and 5328. Also, my modified versions no longer has three digits hardcoded. You can now give the number of digits on the command line - you can also give the minimum number of terms in the unique solution, and the range of years to investigate. Unfortunally, doing it for 4 digits takes a long time. There are about 12 billion sums to consider, compared to about 14 thousand for 3 digits. Abigail Read more... (2 kB)	[reply] [d/l]
Re: Coming soon: Algorithm::Loops by artist (Parson) on Apr 12, 2003 at 01:38 UTC
Points: ++tye for introducing and working hard on the problem. ++abigail-ii for providing simple solution. ++tall_man for analyzing the solution as I did. Credits: I have enjoyed the math puzzles long before having a chance to see computer for the first time. This puzzle is mentiond on mathpuzzle.com. It is an interesting and fun site to visit with lots of links by Ed Pegg Jr who is also a great contributor on mathworld. Notes: I believe the original question doesn't put any limit on number of digits in the numbers. As tall_man mentiond it's impossible to have solution with 3 or 6 numbers. According to his analysis there is also the possibility of having only 2 numbers that can add to 2003. Approach: What I realy enjoyed is different pathway for thinking about solving the math problem. The problem can be tackled from restricted set of views and that makes it interesting to see if you can see the easy methodology and appreciate solution provided by others. I also enjoy ACM puzzles. They servce purpose to construct powerful computational logic. Future: Yes, tye I would like to see Alogrithm::Loop. I believe that, I can use it. artist	[reply]
Re^2: Coming soon: Algorithm::Loops (restrictions) by tye (Sage) on Apr 12, 2003 at 07:27 UTC
I believe the original question doesn't put any limit on number of digits in the numbers I mostly didn't assume any restrictions on the number of digits in the numbers being added. I derived the restrictions from my desire to have unique numbers and a non-trivial answer. If I picked two digits, then I'd only have two numbers to add up (XY and YX) and so I can't get a sum of even 200. If I picked four digits, then the number of combinations to search is quite small and might be a fun challange with paper and pencil but didn't seem interesting from the angle I was tackling things. Since I started out wanting to avoid leading zeros, the space to search would be so small that even with pencil and paper it wouldn't be very interesting. (: But with a quick change of a couple of characters, I see that adding up two 4-digit numbers (having the same digits in different orders) never gives us 2003. But of course it can't, because all such would be even modulo 9 while 2003 is odd modulo 9. Thanks for the vote in favor of Algo.::Loops. BTW, I have a much faster version of my code searching for optimal stamp denominations. Still not nearly as fast as I'd like (with one search still going after 120 hours of CPU). I'll post that code when I get some time. - tye	[reply]
Re: Re^2: Coming soon: Algorithm::Loops (restrictions) by hv (Prior) on Apr 14, 2003 at 15:31 UTC
But with a quick change of a couple of characters, I see that adding up two 4-digit numbers (having the same digits in different orders) never gives us 2003. But of course it can't, because all such would be even modulo 9 while 2003 is odd modulo 9. Careful now, 7 * 2 = 14 == 5 (modulo 9). In general (if I remember correctly), for any modulus q, if a does not share a factor with q there exists a b for every c such that *a b == c (modulo q)**. Hugo	[reply]
Re: Coming soon: Algorithm::Loops (another analysis of the puzzle) by Abigail-II (Bishop) on Apr 13, 2003 at 09:33 UTC
Actually, when a bit of analysis, it's really easy to come up with those numbers that have unique 6 terms solutions. A 6 term solution is of the form: `xyz + xzy + yxz + yzx + zxy + zyx` [download] But this can be rewritten as: `(x + y + z) * 222` [download] But this is equivalent with: `((x - k) + (y - l) + (z + k + l)) * 222` [download] So, all you need to find are `(x, y, z)` such that there is no `(k, l)` for which `((x - k), (y - l), (z + k + l))` has no duplicates, are less than 10, and 0 or more, and the sum is large enough that there are no solutions with less terms available. This leads to `(9, 8, 7)` and `(9, 8, 6)` as the solutions, and hence to `5328` and `5106` and the only numbers with unique, and six term, solutions. A simular argument shows that for the four digit problem, only 193314 and 199980 have unique, 24 term solutions. And for five digits, we have unique 120 term solutions for 9066576 and 9333240. Abigail	[reply] [d/l] [select]
Re^2: Coming soon: Algorithm::Loops (another analysis of the puzzle) by tye (Sage) on Apr 13, 2003 at 17:40 UTC
Update: sum is large enough that there are no solutions with less terms available. Missed that part. Never mind. - Emila Latella Not quite. You've come up with a way to find numbers that have exactly one six-term solution. The problem was to come up with numbers that have exactly one solution and that one solution has six terms (or as many terms as possible while still only having one solution). This analysis can find you good candidates, but you'd have to vet them by demonstrating that they also have no solutions involving fewer terms. - tye	[reply]
Re: Coming soon: Algorithm::Loops by tbone1 (Monsignor) on Apr 14, 2003 at 12:26 UTC
Now you can write arbitrarilly-nested loops easily. According to my last code review, I've been doing that inadvertently. -- tbone1 Ain't enough 'O's in 'stoopid' to describe that guy. - Dave "the King" Wilson	[reply]
Re: Coming soon: Algorithm::Loops by Madams (Pilgrim) on Apr 17, 2003 at 21:35 UTC
Hey y'all I once asked about "multiple nested for loops" and tilly responded with this:..nested_for() Hope this helps someone out... _________________ madams@scc.net `(__) (\/) /-------\/ / \| 666 \|\| * \|\|----\|\|` [download]	[reply] [d/l]


Welcome to the Monastery
	PerlMonks