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

On Sep 1, 2004, at 18:50, 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 wrote a couple of solutions, one recursive, and one iterative.

To easily keep track of the balance at any given point of the search 
the strings are represented as arrays of {-1, 1}, and converted to a 
sequence of parens just for output.

Recursive
¨¨¨¨¨¨¨¨¨
The recursive solution goes like this: There are two kinds of 
properly-balanced strings of length 2n, the ones starting with "()" and 
the ones starting with "((". In the former case, the rest of the string 
is a properly-balanced string of length 2(n - 1), which maps to 
recursion directly. Whereas in the latter, the rest of the string has 
length 2(n - 1) and a balance of -2. We generate those unbalanced 
strings from balanced ones.

The performance gets worse with n both in terms of time and memory 
usage.

Iterative
¨¨¨¨¨¨¨¨¨
Since in the past quiz I "unrolled" a recursion, emulating it with a 
stack and a loop, I chose another approach for this one. Since for a 
known n the generation of solutions via nested loops is 
straightforward, the script generates them and evals the code.

As soon as we know we don't need to look further we halt a loop 
(negative balance, or too much opened parens). This is the generated 
code for n = 3 (filtered through perltidy -io):

my $bal = 0;
my @paren = (undef, '(', ')');
for my $i1 (1, -1) {
     $bal += $i1;
     next if $bal < 0
       ;
     for my $i2 (1, -1) {
         $bal += $i2;
         next if $bal < 0
           ;
         for my $i3 (1, -1) {
             $bal += $i3;
             next if $bal < 0
               ;
             for my $i4 (1, -1) {
                 $bal += $i4;
                 next if $bal < 0
                   || $bal > 2;
                 for my $i5 (1, -1) {
                     $bal += $i5;
                     next if $bal < 0
                       || $bal > 1;
                     for my $i6 (1, -1) {
                         $bal += $i6;
                         next if $bal;
                         print $paren[$i1];
                         print $paren[$i2];
                         print $paren[$i3];
                         print $paren[$i4];
                         print $paren[$i5];
                         print $paren[$i6];
                         print "\n";
                     } continue {
                         $bal -= $i6;
                     }
                 } continue {
                     $bal -= $i5;
                 }
             } continue {
                 $bal -= $i4;
             }
         } continue {
             $bal -= $i3;
         }
     } continue {
         $bal -= $i2;
     }
} continue {
     $bal -= $i1;
}

This version is much faster, and the memory usage is under control.

-- fxn




Recursive
¨¨¨¨¨¨¨¨¨
#!/usr/bin/perl

use strict;
use warnings;

my $n = shift;
defined $n and $n > 0 or die <<USAGE;
Usage: $0 positive_integer
USAGE

for my $b (@{balanced($n)}) {
     my @in_chars = map { $_ > 0 ? '(' : ')' } @$b;
     print join '', @in_chars, "\n";
}

sub balanced {
     my $n = shift;
     return [[1, -1]] if $n == 1;
     my @bs = ();
     for $b (@{balanced($n - 1)}) {
         push @bs, [1, -1, @$b];
         my $count = 0;
         my $offset = 0;
         for my $p (@$b) {
             ++$offset;
             $count += $p;
             if ($count <= 0) {
                 my @new = @$b;
                 splice @new, $offset, 0, -1;
                 push @bs, [1, @new];
             }
         }
     }
     return \@bs;
}



Iterative
¨¨¨¨¨¨¨¨¨
#!/usr/bin/perl

use strict;
use warnings;

my $n = shift;
defined $n and $n > 0 or die <<USAGE;
Usage: $0 positive_integer
USAGE

my $t = 2*$n;

# The code that prints a solution.
my $print = '';
$print .= "print \$paren[\$i$_];\n" for 1..$t;
$print .= 'print "\n";';

my $m = $t;
my @code = (<<DEEPEST_LOOP);
for my \$i$m (1, -1) {
\$bal += \$i$m;
next if \$bal;
$print
} continue {
\$bal -= \$i$m;
}
DEEPEST_LOOP

for $m (reverse 1..($t - 1)) {
     my $for = <<FOR;
for my \$i$m (1, -1) {
\$bal += \$i$m;
next if \$bal < 0
FOR
     $for .= " || \$bal > @{[$t - $m]}" if $m > $t/2;
     $for .= ";\n";
     unshift @code, $for;
     push @code, <<CONTINUE;
} continue {
\$bal -= \$i$m;
}
CONTINUE
}

unshift @code, <<TOP;
my \$bal = 0;
my \@paren = (undef, '(', ')');
TOP

eval join '', @code;
#print @code;