#!/usr/bin/perl -w
#
#  "Loop Abstraction Via Recursion"
#
#   060111 by liverpole
#

# Strict
use strict;
use warnings;


# User-defined
my @list    = qw( 1 2 3 4 5 );

# Prototypes
sub abstract_loop($$$);
sub arbitrary_N_loops($;$$);
sub show_results($$$);


# Globals
my $N;                  # The number of loops (which we want to abstra
+ct)
my $total;              # Total match attempts
my $pvals = [ ];        # The list of values
my $nmatch = 0;         # Total matches


# Subroutines
sub match(@) {
    my ($plist) = @_;
    my $sum = 0;
    my $prod = 1;
    map { $prod *= $_; $sum += $_ } @$plist;
    my $div = ($prod / $sum);
    ($div == int($div));
}


sub show_results($$$) {
    my ($nloops, $nmatch, $total) = @_;
    my $pct = ($total)? int(1000 * $nmatch / $total) / 10: 0;
    my $s = (1 == $nloops)? " ": "s";
    printf "[%3d loop$s]  ", $nloops;
    printf "Matches:  %8d / %9d ", $nmatch, $total;
    printf "(%5.1f%%)\n", $pct;
}


# Main program

# One loop
$N = 1;
$nmatch = $total = 0;
foreach (@list) {
    push @$pvals, $_;               # Add a new value to the list
    match($pvals) and ++$nmatch;    # Check if it matches the criteria
    ++$total;                       # Add 1 to the total count
    pop @$pvals;                    # Remove the value at the end
}
show_results($N, $nmatch, $total);
[download]

It's important to note the match() subroutine could serve just about any purpose.  I didn't put any time into picking something particularly relevant; all that it does is calculate whether the sum of a list of number divides the product of the same set.

At this point, there is a single loop "foreach (@list)", and therefore only a one-element list being generated each time through the loop.  So it's no surprise when all "sums" divide all "products", and the result is:

[  1 loop ]  Matches:         5 /         5 (100.0%)
[download]

Here's what happens when a second loop is nested into the first (and added after the single-loop example at the end of the program):

# Two loops
$N = 2;
$nmatch = $total = 0;
foreach (@list) {
    push @$pvals, $_;
    foreach (@list) {
        push @$pvals, $_;
        match($pvals) and ++$nmatch;
        ++$total;
        pop @$pvals;
    }
    pop @$pvals;
}
show_results($N, $nmatch, $total)
[download]

Now we're creating 2-element lists each time, and calling it a "match" when (A*B)/(A+B) is an integer value.  Here are the more interesting results for 1 and 2 loops together:

[  1 loop ]  Matches:         5 /         5 (100.0%)
[  2 loops]  Matches:         2 /        25 (  8.0%)
[download]

Likewise, here's the code for 3 nested loops, which starts to get quite unwieldy:

# Three loops
$N = 3;
$nmatch = $total = 0;
foreach (@list) {
    push @$pvals, $_;
    foreach (@list) {
        push @$pvals, $_;
        foreach (@list) {
            push @$pvals, $_;
            match($pvals) and ++$nmatch;
            ++$total;
            pop @$pvals;
        }
        pop @$pvals;
    }
    pop @$pvals;
}
show_results($N, $nmatch, $total);
[download]

... and 4 loops (which is as far as I got doing it by hand), where I actually did have some "cut-and-paste" errors in the original code because of the growing complexity:

# Four loops
$N = 4;
$nmatch = $total = 0;
foreach (@list) {
    push @$pvals, $_;
    foreach (@list) {
        push @$pvals, $_;
        foreach (@list) {
            push @$pvals, $_;
            foreach (@list) {
                push @$pvals, $_;
                match($pvals) and ++$nmatch;
                ++$total;
                pop @$pvals;
            }
            pop @$pvals;
        }
        pop @$pvals;
    }
    pop @$pvals;
}
show_results($N, $nmatch, $total);
[download]

And the results for 1 through 4 levels of loops are:

[  1 loop ]  Matches:         5 /         5 (100.0%)
[  2 loops]  Matches:         2 /        25 (  8.0%)
[  3 loops]  Matches:        28 /       125 ( 22.4%)
[  4 loops]  Matches:       110 /       625 ( 17.6%)
[download]

In order to now abstract the concept of a loop so that an arbitrary number of "loops" can be called, one of the more simple (and thus elegant) approaches is to use recursion:

sub abstract_loop($$$) {
    my ($N, $plevel, $pvals) = @_;
    foreach (@list) {
        push @$pvals, $_;
        arbitrary_N_loops($N, $plevel, $pvals);
        pop @$pvals;
    }
}


sub arbitrary_N_loops($;$$) {
    my ($N, $plevel, $pvals) = @_;

    # Check level
    my $level = (!defined($plevel))? 1: $$plevel + 1;
    
    # Initialization (Called once at the beginning of all loops)
    if (1 == $level) {
        $pvals = [ ];
        $nmatch = $total = 0;
    }

    # Call loop N times
    if ($level <= $N) {
        &abstract_loop($N, \$level, $pvals);
    } else {
        # This block only happens within the innermost loop
        match($pvals) and ++$nmatch;
        ++$total;
    }

    # Finalization (Called once at the end of all loops)
    if (0 == --$level) {
        show_results($N, $nmatch, $total);
    }
}

arbitrary_N_loops(1);
arbitrary_N_loops(2);
arbitrary_N_loops(3);
arbitrary_N_loops(4);
arbitrary_N_loops(5);
arbitrary_N_loops(6);
arbitrary_N_loops(7);
arbitrary_N_loops(8);
[download]

This above pair of subroutines have a mutually symbiotic relationship.  One calls the other, which in turn calls the first, and so on until the final level of recursion is reached, and the match subroutine is finally called.  Here is a description of how they work together ...

First, arbitrary_N_loops is called, with the desired number of loops.  If the second variable $plevel is undefined, this is the top-level call to the subroutine, so some initialization is done, including setting the reference $pvals to an empty list (which will be passed through all levels of recursion), and setting the globals $nmatch and $total to zero.

Then, if the maximum depth (level) has not yet been reached, the subroutine abstract_loop is called, to effectively invoke another loop.  Its function is to push each value from the list onto the current list, descend one level further down by calling its partner arbitray_N_loops yet again, and later (maybe much later), popping the value off of the stack.

Each time arbitrary_N_loops is called, the working level is increased by 1, and compared to N.  The bottom level of the set of "loops" is only reached when the value reference by $plevel is greater than N, at which time the criteria matching subroutine match is called, and $nmatch incremented if the match occurred.

At the end of the arbitrary_N_loops subroutine, if the decremented level is back down to zero, the subroutine is finished recursing, and the final call to show_results tells us the answer we've been waiting for.

Here is the final run, showing the original "by-hand" loops (for comparison), followed by the recursively generated loops:

[  1 loop ]  Matches:         5 /         5 (100.0%)
[  2 loops]  Matches:         2 /        25 (  8.0%)
[  3 loops]  Matches:        28 /       125 ( 22.4%)
[  4 loops]  Matches:       110 /       625 ( 17.6%)
----------------------------------------------------------------------
+---------

[  1 loop ]  Matches:         5 /         5 (100.0%)
[  2 loops]  Matches:         2 /        25 (  8.0%)
[  3 loops]  Matches:        28 /       125 ( 22.4%)
[  4 loops]  Matches:       110 /       625 ( 17.6%)
[  5 loops]  Matches:       681 /      3125 ( 21.7%)
[  6 loops]  Matches:      3615 /     15625 ( 23.1%)
[  7 loops]  Matches:     18550 /     78125 ( 23.7%)
[  8 loops]  Matches:     92598 /    390625 ( 23.7%)
[download]

[A final note]  I had originally intended to publish the chess "attack" problem here as well.  However, it ultimately grew fairly involved, and contains several other interesting intricacies (besides "loop abstraction") which would take too long to explain here.  I will therefore publish the attack program in the near future, along with several related files, and a description of some of the elements which make it unique in its own right.

Update:  I finished working on the writeup of the attack program, which was my original impetus for this meditation.