Perl Quiz of the Week #23 [SPOILER]

I first built a looping solution, rather than a recursive one.

This first solution builds an array of strings, starting with an 
empty string. At each step it does the following (L is the number of 
"("s already in the string, R is the number of ")"s, and N is the 
length of the string, i.e., 2*n):

    - If (L-R) < (N-(L+R)), it's OK to add a "(". (And yes, I know 
that expression is equivalent to 2*L < N, but I'm only keeping track 
of L-R.)
    - If (L-R) > 0, it's OK to add a ")".

The size of the arrays grows rather quickly! On my 500 MHz G3 iBook, 
I get the following run times:
n = 00 took       0.07 seconds
n = 01 took       0.07 seconds
n = 02 took       0.17 seconds
n = 03 took       0.07 seconds
n = 04 took       0.12 seconds
n = 05 took       0.12 seconds
n = 06 took       0.08 seconds
n = 07 took       0.14 seconds
n = 08 took       0.27 seconds
n = 09 took       0.60 seconds
n = 10 took       1.71 seconds
n = 11 took       5.53 seconds
n = 12 took      19.42 seconds
n = 13 took      63.43 seconds
n = 14 took     264.16 seconds

Those times were done with the print commented out.

Something bugged me about this, though. It seemed to me that a 
solution could be based on a binary tree traversal, which used the 
formulas above to prune sections of the tree known not to represent 
valid strings. I thought about it for a while, and came up with the 
second solution below. The really cool thing is that since every node 
is identical, I need not even build the tree. Thus, it winds up being 
a sort of smart binary counter. It doesn't run much faster than the 
first solution:
n = 00 took       0.08 seconds
n = 01 took       0.06 seconds
n = 02 took       0.18 seconds
n = 03 took       0.06 seconds
n = 04 took       0.11 seconds
n = 05 took       0.10 seconds
n = 06 took       0.09 seconds
n = 07 took       0.15 seconds
n = 08 took       0.31 seconds
n = 09 took       0.57 seconds
n = 10 took       1.57 seconds
n = 11 took       6.04 seconds
n = 12 took      19.62 seconds
n = 13 took      64.13 seconds
n = 14 took     228.41 seconds

It does have two major virtues, however - it uses very little memory 
and starts printing out the strings immediately, even for large n. 
(Well, OK, for n=1000000, it takes about 30 seconds to print the 
first string. But with the first solution, the machine would crumble 
into dust before it started printing.)

Bill

-----------------------------------------------

#!/usr/bin/perl -w
#
#  First solution - this uses lots of memory for large n

use strict;

my $n;                      # 2n is the length of the strings to produce
my ($strings, $newStrings); # Refs to arrays containing the output strings
my ($sums,    $newSums   ); # For each string, # of "("s - # of ")"s

$n = shift;                 # Get $n from the command line
($n =~ /^\d+$/) or die "Please specify a numeric length!\n";

$strings = [""];
$sums    = [0];

foreach (0..2*$n-1)
     {
     # Init the new strings and sums arrays
     $newStrings = [];
     $newSums    = [];

     foreach (0..scalar(@$strings)-1)
         {
         # Check to see if we can add a ( to the string
         if ($$sums[$_] + length($$strings[$_]) < 2*$n)
             {
             push (@$newStrings, $$strings[$_]."(");
             push (@$newSums,    $$sums[$_]+1);
             }
         # Check to see if we can add a ) to the string
         if ($$sums[$_] > 0)
             {
             push (@$newStrings, $$strings[$_].")");
             push (@$newSums,    $$sums[$_]-1);
             }
         }
     $strings = $newStrings;
     $sums    = $newSums;
     }
foreach (@$strings)
     {
     print "$_\n";
     }
exit;


------------------------------------------------

#!/usr/bin/perl -w
#
# Second solution - uses very little memory

use strict;

my $n;                        # 2n is the length of the strings to produce
my (@triedLeft, @triedRight); # For each 'node', have we tried to add ( and )?
my (@curString);              # An array of the chars in the string
my ($sum);                    # For current string, # of '(' - # of ')'
my ($curPos);                 # Where in the string are we?

$n = shift;                   # Get $n from the command line
defined($n) and ($n =~ /^\d+$/) or die "Please specify a numeric length!\n";
$n or exit;

foreach (0..2*$n-1)
     {
     $triedLeft[$_]  = 0;
     $triedRight[$_] = 0;
     }

$curPos = 0;
$sum    = 0;

while (1)
     {
     # Check to see if we can add a ( to the string
     if (!$triedLeft[$curPos] and ($sum + $curPos) < 2*$n)
         {
         push (@curString,"(");
         $triedLeft[$curPos] = 1;
         $curPos++;
         $sum++;
         }
     # Check to see if we can add a ) to the string
     elsif (!$triedRight[$curPos] and $sum > 0)
         {
         push (@curString,")");
         $triedRight[$curPos] = 1;
         $curPos++;
         $sum--;
         }
     else # This node is done; reset it and pop up to its parent
         {
         $triedLeft[$curPos]  = 0;
         $triedRight[$curPos] = 0;
         $curPos--;
         (pop(@curString) eq "(") ? ($sum--) : ($sum++);
         }
     $curPos or last; # Once we've popped back to the top, we're done
     ($curPos > 2*$n-1) and print join('',@curString)."\n";
     }
exit;

-- 
+--------------------------------+-------------------------------------------+
| Bill Tucker                    | My life has a superb cast                 |
| [email protected] | but I can't figure out the plot.          |
| +855 (012) 654236              |            - Ashleigh Brilliant           |
+--------------------------------+-------------------------------------------+