first commit

perl/Examples/Chap5/binary-1

@@ -0,0 +1,17 @@
+
+
+###
+### binary1
+###
+
+## Chapter 5 section 4.2
+
+sub binary {
+  my ($n, $RETVAL) = @_;
+  $RETVAL = "" unless defined $RETVAL;
+  my $k = int($n/2);
+  my $b = $n % 2;
+  $RETVAL = "$b$RETVAL";
+  return $RETVAL if $n == 0 || $n == 1;
+  binary($k, $RETVAL);
+}

perl/Examples/Chap5/binary-2

@@ -0,0 +1,19 @@
+
+
+###
+### binary2
+###
+
+## Chapter 5 section 4.2
+
+sub binary {
+  my ($n, $RETVAL) = @_;
+  $RETVAL = "";
+  while (1) {
+    my $k = int($n/2);
+    my $b = $n % 2;
+    $RETVAL = "$b$RETVAL";
+    return $RETVAL if $n == 0 || $n == 1;
+    $n = $k;
+  }
+}

perl/Examples/Chap5/binary-3

@@ -0,0 +1,18 @@
+
+
+###
+### binary3
+###
+
+## Chapter 5 section 4.2
+
+sub binary {
+  my ($n, $RETVAL) = @_;
+  $RETVAL = "";
+  while (1) {
+    my $b = $n % 2;
+    $RETVAL = "$b$RETVAL";
+    return $RETVAL if $n == 0 || $n == 1;
+    $n = int($n/2);
+  }
+}

perl/Examples/Chap5/factorial-0

@@ -0,0 +1,13 @@
+
+
+###
+### factorial0
+###
+
+## Chapter 5 section 4.2
+
+sub factorial {
+  my ($n) = @_;
+  return 1 if $n == 0;
+  return factorial($n-1) * $n;
+}

perl/Examples/Chap5/factorial-1

@@ -0,0 +1,14 @@
+
+
+###
+### factorial1
+###
+
+## Chapter 5 section 4.2
+
+sub factorial {
+  my ($n, $product) = @_;
+  $product = 1 unless defined $product;
+  return $product if $n == 0;
+  return factorial($n-1, $n * $product);
+}

perl/Examples/Chap5/factorial-2

@@ -0,0 +1,17 @@
+
+
+###
+### factorial2
+###
+
+## Chapter 5 section 4.2
+
+sub factorial {
+  my ($n) = @_;
+  my $product = 1;
+  until ($n == 0) {
+    $product *= $n;
+    $n--;
+  }
+  return $product;
+}

perl/Examples/Chap5/fib-0

@@ -0,0 +1,13 @@
+
+
+###
+### fib0
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  if ($n < 2) { return $n }
+  fib($n-2) + fib($n-1);
+}

perl/Examples/Chap5/fib-1

@@ -0,0 +1,18 @@
+
+
+###
+### fib1
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  if ($n < 2) {
+    return $n;
+  } else {
+    my $s1 = fib($n-2);
+    my $s2 = fib($n-1);
+    return $s1 + $s2;
+  }
+}

perl/Examples/Chap5/fib-10

@@ -0,0 +1,35 @@
+
+
+###
+### fib10
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push (@STACK, [ $BRANCH, 0, $n ]), $n -= 2 while $n >= 2;
+        $return = $n;
+      } elsif ($BRANCH == 1) {
+        push @STACK, [ $BRANCH, $return, $n ];
+        $n -= 1;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $return += $s1;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $n) = @{pop @STACK};
+    $BRANCH++;
+  }
+}

perl/Examples/Chap5/fib-11

@@ -0,0 +1,35 @@
+
+
+###
+### fib11
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push (@STACK, [ $BRANCH, 0, $n ]), $n -= 1 while $n >= 2;
+        $return = $n;
+      } elsif ($BRANCH == 1) {
+        push @STACK, [ $BRANCH, $return, $n ];
+        $n -= 2;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $return += $s1;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $n) = @{pop @STACK};
+    $BRANCH++;
+  }
+}

perl/Examples/Chap5/fib-12

@@ -0,0 +1,34 @@
+
+
+###
+### fib12
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push (@STACK, [ 1, 0, $n ]), $n -= 1 while $n >= 2;
+        $return = $n;
+      } elsif ($BRANCH == 1) {
+        push @STACK, [ 2, $return, $n ];
+        $n -= 2;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $return += $s1;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $n) = @{pop @STACK};
+  }
+}

perl/Examples/Chap5/fib-2

@@ -0,0 +1,20 @@
+
+
+###
+### fib2
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  while (1) {
+    if ($n < 2) {
+      return $n;
+    } else {
+      my $s1 = fib($n-2);
+      my $s2 = fib($n-1);
+      return $s1 + $s2;
+    }
+  }
+}

perl/Examples/Chap5/fib-3

@@ -0,0 +1,27 @@
+
+
+###
+### fib3
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  while (1) {
+    if ($n < 2) {
+      return $n;
+    } else {
+      if ($BRANCH == 0) {
+        $return = fib($n-2);
+      } elsif ($BRANCH == 1) {
+        $s1 = $return;
+        $return = fib($n-1);
+      } elsif ($BRANCH == 2) {
+        $s2 = $return;
+        $return = $s1 + $s2;
+      }
+    }
+  }
+}

perl/Examples/Chap5/fib-4

@@ -0,0 +1,28 @@
+
+
+###
+### fib4
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  my $BRANCH = 0;
+  while (1) {
+    if ($n < 2) {
+      return $n;
+    } else {
+      if ($BRANCH == 0) {
+        $return = fib($n-2);
+      } elsif ($BRANCH == 1) {
+        $s1 = $return;
+        $return = fib($n-1);
+      } elsif ($BRANCH == 2) {
+        $s2 = $return;
+        $return = $s1 + $s2;
+      }
+    }
+  }
+}

perl/Examples/Chap5/fib-5

@@ -0,0 +1,27 @@
+
+
+###
+### fib5
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  my $BRANCH = 0;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        $return = fib($n-2);
+      } elsif ($BRANCH == 1) {
+        $s1 = $return;
+        $return = fib($n-1);
+      } elsif ($BRANCH == 2) {
+        $return = $s1 + $s2;
+      }
+    }
+  }
+}

perl/Examples/Chap5/fib-6

@@ -0,0 +1,35 @@
+
+
+###
+### fib6
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push @STACK, [ $BRANCH, $s1, $s2, $n ];
+        $n -= 2;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 1) {
+        $s1 = $return;
+        push @STACK, [ $BRANCH, $s1, $s2, $n ];
+        $n -= 1;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $s2 = $return;
+        $return = $s1 + $s2;
+      }
+    }
+  }
+}

perl/Examples/Chap5/fib-7

@@ -0,0 +1,39 @@
+
+
+###
+### fib7
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push @STACK, [ $BRANCH, $s1, $s2, $n ];
+        $n -= 2;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 1) {
+        $s1 = $return;
+        push @STACK, [ $BRANCH, $s1, $s2, $n ];
+        $n -= 1;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $s2 = $return;
+        $return = $s1 + $s2;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $s2, $n) = @{pop @STACK};
+    $BRANCH++;
+  }
+}

perl/Examples/Chap5/fib-8

@@ -0,0 +1,37 @@
+
+
+###
+### fib8
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $s2, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push @STACK, [ $BRANCH, 0, $s2, $n ];
+        $n -= 2;
+        next;
+      } elsif ($BRANCH == 1) {
+        push @STACK, [ $BRANCH, $return, $s2, $n ];
+        $n -= 1;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $s2 = $return;
+        $return = $s1 + $s2;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $s2, $n) = @{pop @STACK};
+    $BRANCH++;
+  }
+}

perl/Examples/Chap5/fib-9

@@ -0,0 +1,36 @@
+
+
+###
+### fib9
+###
+
+## Chapter 5 section 4.3.1
+
+sub fib {
+  my $n = shift;
+  my ($s1, $return);
+  my $BRANCH = 0;
+  my @STACK;
+  while (1) {
+    if ($n < 2) {
+      $return = $n;
+    } else {
+      if ($BRANCH == 0) {
+        push @STACK, [ $BRANCH, 0, $n ];
+        $n -= 2;
+        next;
+      } elsif ($BRANCH == 1) {
+        push @STACK, [ $BRANCH, $return, $n ];
+        $n -= 1;
+        $BRANCH = 0;
+        next;
+      } elsif ($BRANCH == 2) {
+        $return += $s1;
+      }
+    }
+
+    return $return unless @STACK;
+    ($BRANCH, $s1, $n) = @{pop @STACK};
+    $BRANCH++;
+  }
+}

perl/Examples/Chap5/make-dfs

@@ -0,0 +1,24 @@
+
+
+###
+### make-dfs-search
+###
+
+## Chapter 5 section 3
+
+use Iterator_Utils 'Iterator';
+
+sub make_dfs_search {
+  my ($root, $children, $is_interesting) = @_;
+  my @agenda = $root;
+  return Iterator {
+    while (@agenda) {
+      my $node = pop @agenda;
+      push @agenda, $children->($node);
+      return $node if !$is_interesting || $is_interesting->($node);
+    }
+    return;
+  };
+}       
+
+1;

perl/Examples/Chap5/make-dfs-simple

@@ -0,0 +1,20 @@
+
+
+###
+### make-dfs-search-simple
+###
+
+## Chapter 5 section 3
+
+use Iterator_Utils 'Iterator';
+
+sub make_dfs_search {
+  my ($root, $children) = @_;
+  my @agenda = $root;
+  return Iterator {
+    return unless @agenda;
+    my $node = pop @agenda;
+    push @agenda, $children->($node);
+    return $node;
+  };
+}       

perl/Examples/Chap5/make-dfs-value

@@ -0,0 +1,29 @@
+
+
+###
+### make-value-search
+###
+
+## Chapter 5 section 3
+
+sub make_dfs_value_search {
+  my ($root, $children, $is_interesting, $evaluate) = @_;
+  $evaluate = memoize($evaluate);
+  my @agenda = $root;
+  return Iterator {
+    while (@agenda) {
+      my $best_node_so_far = 0;
+      my $best_node_value = $evaluate->($agenda[0]);
+      for (0 .. $#agenda) {
+        my $val = $evaluate->($agenda[$_]);
+        next unless $val > $best_node_value;
+        $best_node_value = $val;
+        $best_node_so_far = $_;
+      }
+      my $node = splice @agenda, $best_node_so_far, 1;
+      push @agenda, $children->($node);
+      return $node if !$is_interesting || $is_interesting->($node);
+    }
+    return;
+  };
+}       

perl/Examples/Chap5/make-part-dfs-1

@@ -0,0 +1,19 @@
+
+
+###
+### make_partition_dfs
+###
+
+## Chapter 5 section 3
+
+sub make_partition {
+  my $n = shift;
+  my $root = [$n];
+  my $children = sub {
+    my ($largest, @rest) = @{shift()};
+    my $min = $rest[0] || 1;
+    my $max  = int($largest/2);
+    map [$largest-$_, $_, @rest], ($min .. $max);
+  };
+  make_dfs_search($root, $children);
+}

perl/Examples/Chap5/make-part-dfs-2

@@ -0,0 +1,24 @@
+
+
+###
+### make_partition_dfs_search
+###
+
+## Chapter 5 section 3
+
+require 'make-dfs-search';
+
+sub make_partition {
+  my $n = shift;
+  my $root = [$n, 1, []];
+  my $children = sub {
+    my ($n, $min, $parts) = @{shift()};
+    map [$n-$_, $_, [@$parts, $_]], ($min .. $n);
+  };
+  my $is_complete = sub {
+    my ($n) = @{shift()};
+    $n == 0;
+  };
+   imap { $_->[2] }
+    make_dfs_search($root, $children, $is_complete);
+}

perl/Examples/Chap5/make-part-sorted

@@ -0,0 +1,24 @@
+
+
+###
+### make_partition_partitions
+###
+
+## Chapter 5 section 2
+
+sub make_partition {
+  my $n = shift;
+  my @agenda = [$n];
+  return Iterator {
+    return unless @agenda;
+    my $item = pop @agenda;
+    my ($largest, @rest) = @$item;
+    my $min = $rest[0] || 1;
+    my $max  = int($largest/2);
+    for ($min .. $max) {
+      push @agenda, [$largest-$_, $_, @rest];
+    } 
+    @agenda = sort partitions @agenda;
+    return $item;
+  };
+}

perl/Examples/Chap5/make-partition-1

@@ -0,0 +1,25 @@
+
+
+###
+### make_partition
+###
+
+## Chapter 5 section 2
+
+sub make_partition {
+  my $n = shift;
+  my @agenda = [$n];
+  return Iterator {
+    while (@agenda) {
+      my $item = pop @agenda;
+      my ($largest, @rest) = @$item;
+      my $min = $rest[0] || 1;
+      my $max  = int($largest/2);
+      for ($min .. $max) {
+        push @agenda, [$largest-$_, $_, @rest];
+      }
+      return $item;
+    }
+    return;
+  };
+}

perl/Examples/Chap5/make-partition-2

@@ -0,0 +1,23 @@
+
+
+###
+### make_partition_cleaner
+###
+
+## Chapter 5 section 2
+
+sub make_partition {
+  my $n = shift;
+  my @agenda = [$n];
+  return Iterator {
+    return unless @agenda;
+    my $item = pop @agenda;
+    my ($largest, @rest) = @$item;
+    my $min = $rest[0] || 1;
+    my $max  = int($largest/2);
+    for ($min .. $max) {
+      push @agenda, [$largest-$_, $_, @rest];
+    }
+    return $item;
+  };
+}

perl/Examples/Chap5/partition

@@ -0,0 +1,17 @@
+
+
+###
+### partition
+###
+
+## Chapter 5 section 2
+
+sub partition {
+  print "@_\n";
+  my ($largest, @rest) = @_;
+  my $min = $rest[0] || 1;
+  my $max  = int($largest/2);
+  for ($min .. $max) {
+    partition($largest-$_, $_, @rest);
+  }
+}

perl/Examples/Chap5/partition-all

@@ -0,0 +1,18 @@
+
+
+###
+### partition-all
+###
+
+## Chapter 5 section 1.1
+
+sub partition {
+  my ($target, $treasures) = @_;
+  return [] if $target == 0;
+  return () if $target < 0 || @$treasures == 0;
+
+  my ($first, @rest) = @$treasures;
+  my @solutions = partition($target-$first, \@rest);
+  return ((map {[$first, @$_]} @solutions), 
+          partition($target, \@rest));
+}

perl/Examples/Chap5/partition-it

@@ -0,0 +1,24 @@
+
+
+###
+### partition-it
+###
+
+## Chapter 5 section 1.1
+
+sub make_partitioner {
+  my ($n, $treasures) = @_;
+  my @todo = [$n, $treasures, []];
+  sub { 
+    while (@todo) {
+      my $cur = pop @todo;
+      my ($target, $pool, $share) = @$cur;
+      if ($target == 0) { return $share }
+      next if $target < 0 || @$pool == 0;
+      my ($first, @rest) = @$pool;        
+      push @todo, [$target-$first, \@rest, [@$share, $first]],
+                  [$target       , \@rest,   $share         ];
+    }
+    return undef;
+  } # end of anonymous iterator function       
+} # end of make_partitioner

perl/Examples/Chap5/partition-iterator-2

@@ -0,0 +1,31 @@
+
+
+###
+### partition-iterator-clumsy
+###
+
+## Chapter 5 section 2
+
+sub make_partition {
+  my $n = shift;
+  my @agenda = ([$n,            # $largest
+                 [],            # \@rest
+                 1,             # $min
+                 int($n/2),     # $max
+                ]);
+  return Iterator {
+    while (@agenda) {
+      my $item = pop @agenda;
+      my ($largest, $rest, $min, $max) = @$item;
+      for ($min .. $max) {
+        push @agenda, [$largest - $_,          # $largest
+                       [$_, @$rest],           # \@rest
+                       $_,                     # $min
+                       int(($largest - $_)/2), # $max
+                      ];
+      }
+      return [$largest, @$rest];
+    }
+    return;
+  };
+}

perl/Examples/Chap5/partition-repeats

@@ -0,0 +1,15 @@
+
+
+###
+### partition-repeats
+###
+
+## Chapter 5 section 2
+
+sub partition {
+  print "@_\n";
+  my ($n, @parts) = @_;
+  for (1 .. $n-1) {
+    partition($n-$_, $_, @parts);
+  }
+}

perl/Examples/Chap5/partitions

@@ -0,0 +1,15 @@
+
+
+###
+### partitions
+###
+
+## Chapter 5 section 2
+
+# Compare two partitions for preferred order
+sub partitions {
+  for my $i (0 .. $#$a) {
+    my $cmp = $b->[$i] <=> $a->[$i];
+    return $cmp if $cmp;
+  }
+}

perl/Examples/Chap5/powerset-0

@@ -0,0 +1,47 @@
+
+
+###
+### powerset_recurse0
+###
+
+## Chapter 5 section 4.1.1
+
+sub powerset_recurse ($;@) {
+    my ( $set, $powerset, $keys, $values, $n, $i ) = @_;
+
+    if ( @_ == 1 ) { # Initialize.
+        my $null   = { };
+        $powerset  = { $null, $null };
+        $keys      = [ keys   %{ $set } ];
+        $values    = [ values %{ $set } ];
+        $nmembers  = keys %{ $set };    # This many rounds.
+        $i         = 0;                 # The current round.
+    }
+
+    # Ready?
+    return $powerset if $i == $nmembers;
+
+    # Remap.
+
+    my @powerkeys   = keys   %{ $powerset };
+    my @powervalues = values %{ $powerset };
+    my $powern      = @powerkeys;
+    my $j;
+
+    for ( $j = 0; $j < $powern; $j++ ) {
+        my %subset = ( );
+
+        # Copy the old set to the subset.
+        @subset{keys   %{ $powerset->{ $powerkeys  [ $j ] } }} =
+                values %{ $powerset->{ $powervalues[ $j ] } };
+
+        # Add the new member to the subset.
+        $subset{$keys->[ $i ]} = $values->[ $i ];
+
+        # Add the new subset to the powerset.
+        $powerset->{ \%subset } = \%subset;
+    }
+
+    # Recurse.
+    powerset_recurse( $set, $powerset, $keys, $values, $nmembers, $i+1 );
+}

perl/Examples/Chap5/powerset-1

@@ -0,0 +1,46 @@
+
+
+###
+### powerset_recurse1
+###
+
+## Chapter 5 section 4.1.1
+
+sub powerset_recurse ($) {
+    my ( $set ) = @_;
+    my $null = { };
+    my $powerset  = { $null, $null };
+    my $keys      = [ keys   %{ $set } ];
+    my $values    = [ values %{ $set } ];
+    my $nmembers  = keys %{ $set };    # This many rounds.
+    my $i         = 0;                 # The current round.
+
+    until ($i == $nmembers) {
+
+      # Remap.
+
+      my @powerkeys   = keys   %{ $powerset };
+      my @powervalues = values %{ $powerset };
+      my $powern      = @powerkeys;
+      my $j;
+
+      for ( $j = 0; $j < $powern; $j++ ) {
+          my %subset = ( );
+
+          # Copy the old set to the subset.
+          @subset{keys   %{ $powerset->{ $powerkeys  [ $j ] } }} =
+                  values %{ $powerset->{ $powervalues[ $j ] } };
+
+          # Add the new member to the subset.
+          $subset{$keys->[ $i ]} = $values->[ $i ];
+
+          # Add the new subset to the powerset.
+          $powerset->{ \%subset } = \%subset;
+      }
+
+      $i++;        
+
+    }
+
+    return $powerset;
+}

perl/Examples/Chap5/powerset-2

@@ -0,0 +1,42 @@
+
+
+###
+### powerset_recurse2
+###
+
+## Chapter 5 section 4.1.1
+
+sub powerset_recurse ($) {
+    my ( $set ) = @_;
+    my $null = { };
+    my $powerset  = { $null, $null };
+    my $keys      = [ keys   %{ $set } ];
+    my $values    = [ values %{ $set } ];
+    my $nmembers  = keys %{ $set };    # This many rounds.
+
+    for my $i (0 .. $nmembers-1) {
+
+      # Remap.
+
+      my @powerkeys   = keys   %{ $powerset };
+      my @powervalues = values %{ $powerset };
+      my $powern      = @powerkeys;
+      my $j;
+
+      for ( $j = 0; $j < $powern; $j++ ) {
+          my %subset = ( );
+
+          # Copy the old set to the subset.
+          @subset{keys   %{ $powerset->{ $powerkeys  [ $j ] } }} =
+                  values %{ $powerset->{ $powervalues[ $j ] } };
+
+          # Add the new member to the subset.
+          $subset{$keys->[ $i ]} = $values->[ $i ];
+
+          # Add the new subset to the powerset.
+          $powerset->{ \%subset } = \%subset;
+      }
+    }
+
+    return $powerset;
+}

perl/Examples/Chap5/powerset-3

@@ -0,0 +1,39 @@
+
+
+###
+### powerset_recurse3
+###
+
+## Chapter 5 section 4.1.1
+
+sub powerset_recurse ($) {
+    my ( $set ) = @_;
+    my $null = { };
+    my $powerset  = { $null, $null };
+
+    while (my ($key, $value) = each %$set) {
+
+      # Remap.
+
+      my @powerkeys   = keys   %{ $powerset };
+      my @powervalues = values %{ $powerset };
+      my $powern      = @powerkeys;
+      my $j;
+
+      for ( $j = 0; $j < $powern; $j++ ) {
+          my %subset = ( );
+
+          # Copy the old set to the subset.
+          @subset{keys   %{ $powerset->{ $powerkeys  [ $j ] } }} =
+                  values %{ $powerset->{ $powervalues[ $j ] } };
+
+          # Add the new member to the subset.
+          $subset{$key} = $value;
+
+          # Add the new subset to the powerset.
+          $powerset->{ \%subset } = \%subset;
+      }
+    }
+
+    return $powerset;
+}

perl/Examples/Chap5/powerset-4

@@ -0,0 +1,37 @@
+
+
+###
+### powerset_recurse4
+###
+
+## Chapter 5 section 4.1.1
+
+sub powerset_recurse ($) {
+    my ( $set ) = @_;
+    my $null = { };
+    my $powerset  = { $null, $null };
+
+    while (my ($key, $value) = each %$set) {
+
+      my @newitems;
+
+      while (my ($powerkey, $powervalue) = each %$powerset) {
+          my %subset = ( );
+
+          # Copy the old set to the subset.
+          @subset{keys   %{ $powerset->{$powerkey} } } =
+                  values %{ $powerset->{$powervalue} };
+
+          # Add the new member to the subset.
+          $subset{$key} = $value;
+
+          # Prepare to add the new subset to the powerset.
+          push @newitems, \%subset;
+      }
+
+      $powerset->{ $_ } = $_ for @newitems;
+
+    }
+
+    return $powerset;
+}