Re: Perl Quiz of the Week #23

Mark Jason Dominus <[email protected]> writes:

> 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.  For example,
> given the argument '3', the program should print these five lines:

Note that one way to check the output of one's program (beyond the
fact that it should produce distinct lines of only parentheses and
that those should be balanced, etc.) is given by "Catalan numbers"
(http://mathworld.wolfram.com/CatalanNumber.html).

Correct programs output C_n lines when given the number n;
specifically, there should be 1 line output when given "1", 2 lines
when given "2", 5 lines when given "3", etc.

(The first few Catalan numbers are:
 1  2  5  14  42  132  429  1430  4862  16796  58786  208012  742900
)

In fact, here's a simple perl script to check the output of a given
program.  Just pipe the output of your program into it, and it'll say
it's OK or die with an error message.

Yes, the fact that a single blank line is acceptable input is
intentional.

#! /usr/bin/perl
# parencheck.pl
# Pipe the output of a 'parens' program through this to
# check it.  For example:
#   perl parens.pl 7 | perl parencheck.pl
# Or give the name of a file containing 'parens' output
# as a parameter:
#   perl parencheck.pl parens_output_7.txt

use strict;

sub binom {
  # slow, but cute
  my ($n, $k) = @_;
  if ($n < 1 or $k < 1 or $k >= $n) { return 1; }
  binom($n-1,$k-1)*$n/$k;
}

sub catalan {
  # one of many ways it can be calculated
  binom(2*$_[0], $_[0])/($_[0]+1);
}

sub checkline {
  # does the line contain only
  # balanced parens?
  my ($line) = shift;
  my $mangled = $line;
  $mangled =~ s/\s//g;
  if ($mangled =~ /[^\(\)]/) {
    die "Line '$line' contains invalid characters";
  }
  while(length($mangled)) {
    if (not $mangled =~ s/\(\)//g) {
      die "Line '$line' has mismatched parens";
    }
  }
}

my %seen=();

my $firstline = <>;

die "Empty input" if (!defined($firstline));

chomp($firstline);

my $mangledfirst = $firstline;

$mangledfirst =~ s/\s//g;

my $len = length($mangledfirst);

checkline($firstline);

$seen{$mangledfirst} = 1;

while (<>)
{
  chomp;
  my $mangled = $_;
  $mangled =~ s/\s//g;
  die "Already seen '$_'" if ($seen{$mangled});
  die "Differing lengths on '$_'" unless $len==length($mangled);
  checkline($_);
  $seen{$mangled}=1;
}

my $nfound = keys %seen;
if (catalan($len/2) != $nfound) {
  die "Found $nfound lines; needed " . catalan($len/2);
}

printf "Input OK - found \%d lines of \%d pairs of matching parens\n",
       $nfound, $len/2;

__END__