Re: [SPOILER] Simple but slow recursive solution to QOTW #23

On Sat, 04 Sep 2004 01:01:29 -0400, Daniel Martin <martin-+m399P62/[email protected]> wrote:
> I'll just note in addition to this solution that another way to
> calculate Catalan numbers (aside from what I posted before) is given
> by
> 
>   sub catalan {
>     my $n=shift;
>     my $ret=0;
>     for my $i (1..$n) {
>       $ret += catalan($i-1) * catalan($n-$i);
>     }
>     return $ret;
>   }
> 
> It should be obvious without running it that the program below
> therefore produces at the very least the correct number of lines.
> (well, when the kernel doesn't kill it for sucking up too much memory)
> 
> #! /usr/bin/perl
> 
> use warnings;
> use strict;
> 
> # A string of balanced parentheses is either the empty string
> # or a string of the form "($a)$b", where $a and $b are strings
> # of balanced parentheses.
> #
> # That statement is essentially my program - the rest is accounting
> # and perl syntax.
> 
> sub parensList {
>   # Given n, return a list of all possible balanced paren strings
>   # with that many pairs of parentheses.
>   my $n = shift;
> 
>   if (0 == $n) { return (""); }
> 
>   my @ret = ();
>   for my $i (1..$n) {
>     my @a = parensList($i - 1);
>     my @b = parensList($n - $i);
>     for my $a (@a) {
>       for my $b (@b) {
>         push @ret, "($a)$b";
>       }
>     }
>   }
>   return @ret;
> }
> 
> # Only starts to make a visible difference for n > 10
> use Memoize;
> memoize('parensList');
> 
> die "Usage: parens.pl number" if 1 != @ARGV;
> 
> my $ngiven = shift() + 0;
> 
> die "Very funny" if $ngiven < 0;
> 
> print "$_\n" for parensList($ngiven);
> 
> __END__

Essentially my solution.  Except that I wrote out Memoize (sorry,
MJD), and then converted it be iterative.  This approach must compute
all strings of lengths <N anyway, so why not just store them in-order?

Note that the final iteration (for N) should be rewritten to print out
the strings immediately, rather than first store them into the array;
this yields the second version (which could again be made faster by
avoiding the coderef nastiness).


............................................
#!/usr/bin/perl -w
use strict;

# Iterative version

# To produce all strings of $n paren pairs, decide how many paren
# pairs go into the first paren pair and how many go outside it, and
# do the cartesian multiple.

my $n = shift;

my @parens = (['']);

for my $m (1..$n) {
  # Generate $parens[$m]
  for my $i (0..$m-1) {
    # Generate '(' x $parens[$m-1-$i] x ')' x $parens[$i]
    for my $in (@{$parens[$m-$i-1]}) {
      for my $out (@{$parens[$i]}) {
	push @{$parens[$m]}, "($in)$out";
      }
    }
  }
}

print "$_\n" for (@{$parens[$n]});

............................................
#!/usr/bin/perl -w
use strict;

# Iterative version

# To produce all strings of $n paren pairs, decide how many paren
# pairs go into the first paren pair and how many go outside it, and
# do the cartesian multiple.

my $n = shift;

my @parens = (['']);

# Run a code ref on all elements of a cartesian product
sub cartesian {
  my ($a, $b, $code) = @_;
  for my $in (@$a) {
    for my $out (@$b) {
      $code->("($in)$out");
    }
  }
}

for my $m (1..$n) {
  # Generate $parens[$m]
  my $code;
  if ($m < $n) {
    # In product, push onto $parens[$m]
    $code = sub { push @{$parens[$m]}, @_ };
  }
  else {
    # Last iteration - just print
    $code = sub { print "@_\n" };
  }
  for my $i (0..$m-1) {
    # Generate '(' x $parens[$m-1-$i] x ')' x $parens[$i]
    cartesian($parens[$m-$i-1], $parens[$i], $code);
  }
}