[SPOILER] Solution to Perl Quiz of the Week #23

On Wed, Sep 01, 2004 at 12:50:14PM -0400, Mark Jason Dominus wrote:

>Write a program, 'parens', which gets a command line argument, n',
>which is an integer.  The program should print all the
>properly-balanced strings of parentheses of length 2n.

I've skimmed the other solutions posted so far, and while mine is
certainly in the "slowish majority" category I think it's still worth 
posting. (My test box is an Athlon750; I haven't tested other people's 
programs on it.)

The mathworld page made it clear that this was closely related to
tree-balancing and many other problems, but even the (-1, 1) approach
(that I see Xavier Noria managed to make work) didn't seem to offer
immediate useful results.

My principal breakthrough was a representational one. Make the left
parentheses fixed points. Then, after each left parenthesis, there will
be a number of right parentheses, which will be an integer between zero
and n inclusive.

Thus any given valid string can be represented by this series of
integers, about which one can say:

- the total of the series will be n

- any given integer will be no greater than its place in the sequence
(starting from 1 in the leftmost position - i.e. the number of left
parentheses seen so far), minus the total of integers to the left of it
in the sequence (the number of right parentheses seen so far).

In the n=3 case, the series are:

((()))   0, 0, 3
(()())   0, 1, 2
(())()   0, 2, 1
()(())   1, 0, 2
()()()   1, 1, 1

The generation of the series can be simplified further by generating
all possible values for the first n-1 terms of it, and setting the last
term to the only value it can take in each case.

The conversion of the number series to the desired output form is
trivial.

The program is simply an implementation of this algorithm; each entry in
the list consists of the series values, followed by their total. (A
version using hashes was about 30% slower.)

The pre-loader assumes n=2 at least, so a special case is used for lower
values.


#! /usr/bin/perl -w

use strict;
use integer;

foreach my $n (@ARGV) {
  if ($n==0) {
  } elsif ($n==1) {
    print "()\n";
  } else {
    my @t1;
    my @t2=(
      [0,0],
      [1,1]
    );
    foreach my $depth (2..$n-1) {
      @t1=@t2;
      undef @t2;
      foreach my $stub (@t1) {
        my @chain=@{$stub};
        my $total=pop @chain;
        foreach my $tn (0..$depth-$total) {
          push @t2,[@chain,$tn,$total+$tn];
        }
      }
    }
    foreach my $k (@t2) {
      my @c=@{$k};
      my $r=$n-pop @c;
      my $o=join('',map {'('.(')' x $_)} (@c,$r));
      print "$o\n";
    }
  }
}