#!/usr/bin/perl -w use strict; main( @ARGV ); exit( 0 ); # Return the possible starting points for a new open paren: sub Starts { my( $str )= @_; my @start; my $start= 1 + rindex( $str, "(" ); pos($str)= $start; while( $str =~ /[^()]/g ) { push @start, pos($str)-1; } return @start; } # Return the possible ending points: sub Ends { my( $str, $start )= @_; pos($str)= $start; $str =~ /[^()]+/g; return $start+1 .. pos($str); } # Iterator that adds one new pair of parens: sub AddParenIter { my( $str )= @_; my @start= Starts( $str ); my @end= Ends( $str, $start[0] ); return sub { if( ! @end ) { shift @start; return if ! @start; @end= Ends( $str, $start[0] ); } my $new= $str; substr( $new, shift(@end), 0 )= ")"; substr( $new, $start[0], 0 )= "("; return $new; }; } # Iterator that adds N new pairs of parens: sub AddParensIter { my( $count, $str )= @_; my @iter= AddParenIter( $str ); return sub { my $next; while( not $next= $iter[-1]->() ) { pop @iter; return if ! @iter; } while( @iter < $count ) { push @iter, AddParenIter( $next ); $next= $iter[-1]->(); } return $next; } } sub main { die "Usage: $0 count string\n", " or: $0 M..N J..K\n" unless 2 == @_; my( $count, $str )= @_; if( $count !~ /\.\./ ) { my $iter= AddParensIter( $count, $str ); $count= 0; while( $str= $iter->() ) { print ++$count, ": $str\n"; } return; } my( $m, $n )= split /\.\./, $count; my( $j, $k )= split /\.\./, $str; print "parens\tlengths\n"; for my $len ( $j .. $k ) { printf "\t%7d", $len; } for my $parens ( $m .. $n ) { printf "\n%5d:", $parens; for my $len ( $j .. $k ) { my $iter= AddParensIter( $parens, "x"x$len ); my $count= 0; ++$count while $iter->(); printf "\t%7d", $count; } } print "\n"; }