[MacPerl] 'valoti's algorithm (or intuitive approach to the development of anumerical algorithm)

["Aiken, Greg" <Greg@tradesvc.com>]

In response to 'valoti's need to find a numerical algorithm he can use to   
solve
his numeric minimization problem.  The real core problem he described
(sorry, I lost the original email) can be restated as 'select all unique
subsets (Note: this is a set theory problem, not a permutation problem)
containing x elements from a larger population set containing y elements.

I first tried this manually on a small sample set to see if a pattern
could be seen.  For this example, suppose that you wish to find all   
unique
subsets containing 3 elements from a larger population containing 6   
elements.
The following unique sets can be made.

1 2 3 = (1 3 2 )=(2 1 3)=(2 3 1)=(3 1 2)=(3 2 1), all the same SET
1 2 4          Ditto
1 2 5            "
1 2 6
1 3 4
1 3 5
1 3 6
1 4 5
1 4 6
1 5 6
2 3 4
2 3 5
2 3 6
2 4 5
2 4 6
2 5 6
3 4 5
3 4 6
3 5 6
4 5 6

I noticed a pattern in this data.  It would be too verbose for me to try
to explain this in text.  Suffice it to say, that this looked to be a
recursive behaviour where each new recursive 'instance' was aware of the
previous levels current counter value.  In addition, I noticed a special
behaviour about the 'increasing' nature of counter values on each new
recursive depth.  As well, the maximum allowable counter value for a
given recursion depth level seemed to follow a pattern.  The following
block of code was my first attempt to efficiently mimic this behaviour.
This method works, but requires one hardcoded for loop for each position
in the set (ie; give me all unique SETS of three elements from a larger
6 element list - requires three 'for' loops.  As well as the three [+1]   
scalars
used to hold the values to be printed (one scaler for each levels' for   
loop
[$a, $b... $d]).

@array    = (1, 2, 3, 4, 5, 6);   #the total agregate list - the full   
popluation sample
$set_size = 3;                       #the user desired subset length
$level    = 1;
$a = 0;
for ($b = $a + 1; $b <= @array - $set_size + $level; $b++) {
   $level++;
#  print("level = $level\n");  #debug info
   for ($c = $b + 1; $c <= @array - $set_size + $level; $c++) {
      $level++;
#     print("level = $level\n");  #debug info
      for ($d = $c + 1; $d <= @array - $set_size + $level; $d++) {
         $level++;
#        print("level = $level\n");   #debug info
         print("$b, $c, $d\n");
         $level--;
      }
      $level--;
   }
   $level--;
}

the following code improvement replaced the hardcoded scalars (ie; $a,   
$b...)
in the lowest level 'print' command with a dynamic $length array, where
each new levels' for loop 'pushes' a new value onto the end of the array
as it enters the for loop, and 'pops' it off the end of the array before
it exits the for loop.  The main point of this improvement is to make
the core code within each loop to be more 'identical' (this moves us
closer to a recursive implementation).

@array    = (1, 2, 3, 4, 5, 6);
@dynamic_array = ();
$set_size = 3;
$level    = 1;
$a = 0;
for ($b = $a + 1; $b <= @array - $set_size + $level; $b++) {
   $level++;
   push(@dynamic_array, $b);
#  print("level = $level\n");   #debug info
   for ($c = $b + 1; $c <= @array - $set_size + $level; $c++) {
      $level++;
      push(@dynamic_array, $c);
#     print("level = $level\n");   #debug info
      for ($d = $c + 1; $d <= @array - $set_size + $level; $d++) {
         $level++;
         push(@dynamic_array, $d);
#        print("level = $level\n");   #debug info
         print("@dynamic_array\n");
         pop(@dynamic_array);
         $level--;
      }
      pop(@dynamic_array);
      $level--;
   }
   pop(@dynamic_array);
   $level--;
}


the final refinement completely removes any hardcoded scalars
relative to any recursion level depth (previously required in the
innermost loops print statement) and does away with the hardcoded
nesting of the 'for' control loops.  By making a recursive subroutine,
which is the true code optimization desired.  By using this method,
arrays of any length can be processed independant of any hardcoded
algorithm.

Note to list subscribers (this is an open question...): I'm not sure   
about
the possible limitation on Perls allowable recursion depth which may
limit the true functionality of this method for large lists.  Sorry my   
in-line
comments may 'wrap' in this email.

@array    = (1, 2, 3, 4, 5, 6);
@dynamic_array = ();
$set_size = 3;
$level    = 0;

&setpermutations(0);   #because each call is identical, must initially   
call with 0

sub setpermutations {  #pass in: prev_levels_maximum_counter_value
                       #initial version returns nothing, and only prints   
to screen
                       #next version, pass in: ctr, desired subset size,   
array to process

   $prev_level_ctr = @_[0];
   my ($curr_level_ctr);                         #this must be lexically   
scoped to continue after return from inner for loops
   $level++;                                     #increase the recursive   
depth level counter before each new iteration
   for ($curr_level_ctr  = $prev_level_ctr + 1;  #initial value is 1   
greater than used at the previous level
        $curr_level_ctr <= @array - $set_size + $level;  #this constrains   
any levels maximum value
        $curr_level_ctr++) {
      push(@dynamic_array, $curr_level_ctr);     #push the current   
counter level onto end of the dynamic array
      if ($level < $set_size) {                  #this controls the   
recursion depth
          &setpermutations($curr_level_ctr);
      } else {                                   #level == set_size, time   
to output the unique subset we've found
          print("@dynamic_array\n");             #valoti - this is what   
you'd replace with your |Avg(set1) - Avg(set2)| function
      }
      pop(@dynamic_array);                       #remove the last element   
from the dynamic array
   }
   $level--;                                     #decrement the recursive   
depth level counter (perhaps theres some type of built in Perl function   
to implicitely manage this, but I'm not aware of it)
}


'Valoti' - The way you would use this routine for your particular
problem, is that you'd replace my 'print("@dynamic_array\n");'
line with the function that you wish to minimize:

          |Avg(set1) - Avg(set2)|

At that point in the code my routine tells you the unique set (in terms
of array positions - actually perl arrays start with 0 - my algorithm   
reports
them starting at 1 - that shouldn't be too big if a hurdle for you to   
deal with)
out of your total combined list to try.  For example, if the total list   
is;
(1.0, 0.5, 3, 4.5, 0.1, 6.8); my routine will identify the first
unique subset (of length 3) to be '1 2 3' = this would map to the
element positions within your combined list.  You would then assign
set1 to be the first three elements in the list (1.0, 0.5, 3), set2
would be all thats left over (4.5, 0.1, 6.8).  You then perform the
averages on the two sets, the subtraction, then the absolute value
of the result.

         |Avg (1.0, 0.5, 3) - Avg (4.5, 0.1, 6.8)|

You'd want to add a new print statement to my code there to output
both the current set1 positions and the result of your function
evaluation, to a file (or just assign to a global variable, retaining
the lesser of the two, the currently assigned value, relative to
the newly calculated value).  In either case, my algorithm will insure
that all unique set combinations will be evaluated in your aggregate
function.  When done, you'll have your answer.

For those bored by above, I apologize.  I thought that the process of
developing such a numerical algorithm from scratch was a unique
learning process for myself, that might also be of use to others.
I'm not a math genius by any stretch, I only got up to college calculus.  


***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch