$ perl balanced.pl 3                                        
()()()
()(())
(())()
(()())
((()))
$ perl lcs.pl jamon hamon                                   
p=1     q=1     l=4
$ perl lcs.pl abcdef acdegh
p=0     q=0     l=1
p=2     q=1     l=3

##</code><code>##

#!/usr/bin/perl

=begin

Algorithm taken from:

TAOCP - D.Knuth
Vol 4 Fascicle 4 
Generating All Trees 
History of Combinatorial Generation
Algorithm P (Nested parenthesis in lexicographic order)

=cut        

use strict;
use warnings;
use v5.10;

my $n = shift || die "$!: need size";
my ( $l, $r ) = qw! ( ) !;
my $m;
( $m, my @a ) = init( $n, $m );

my $j;

while (1) {
    visit(@a);
    ( $m, @a ) = easy( $m, @a );
    next if ( $a[$m] eq $l );
    ( $m, $j, @a ) = findj( $m, @a );
    last if ( $j == 0 );
    ( $m, @a ) = incj( $m, $j, @a );
}

sub easy {
    my $m = shift;
    my @a = @_;
    $a[$m] = $r;
    if ( $a[ $m - 1 ] eq $r ) {
        $a[ $m - 1 ] = $l, $m--;
    }

    return $m, @a;
}

sub incj {
    my $m = shift;
    my $j = shift;
    my @a = @_;
    $a[$j] = $l;
    $m = 2 * $n - 1;
    return $m, @a;

}

sub findj {
    my $m = shift;
    my @a = @_;
    my $j = $m - 1;
    my $k = 2 * $n - 1;
    while ( $a[$j] eq $l ) {
        $a[$j] = $r, $a[$k] = $l, $j--, $k -= 2;
    }
    return $m, $j, @a;
}

sub init {
    my $n = shift;
    my $m = shift;
    $m = 2 * $n - 1;

    my @a;

    for my $k ( 1 .. $n ) {
        @a[ 2 * $k - 1, 2 * $k ] = ( $l, $r );
    }
    $a[0] = $r;
    return $m, @a;
}

sub visit {
    shift;
    print @_, "\n";
}

##</code><code>##

#!/usr/bin/perl

=begin

How many block moves does it take to transform one string to another?

algorithm taken from:
the string-to-string correction probem by Walter F. Tichy
ACM Transactions on Computer Systems Vol 2 No 4 Number 1984 p. 309-321

=cut

use strict;
use warnings;
use v5.10;

my @s = split //, shift || "shanghai rulez";
my @t = split //, shift || "sakhalin rulez";

# lengths

my $n = $#t;
my $m = $#s;

my ( $p, $q, $l ) = ( 0, 0, 0 );

while ( $q <= $n ) {
    ( $p, $l ) = f($q);

    printf( "p=%d\tq=%d\tl=%d\n", $p, $q, $l ) if ( $l > 0 );
    $q = $q + ( 1, $l )[ 1 < $l ];    # max(1,l) ... Perlmonks
}

sub f {
    my ($q)  = @_;
    my $pCur = 0;
    my $l    = 0;
    my $p    = 0;
    while ( ( $pCur + $l <= $m )
        and ( $q + $l <= $n ) )
    {

        my $lCur = 0;
        while ( ( $pCur + $lCur <= $m )
            and ( $q + $lCur <= $n )
            and ( $s[ $pCur + $lCur ] eq $t[ $q + $lCur ] ) )
        {
            $lCur++;
        }
        if ( $lCur > $l ) {
            $l = $lCur;
            $p = $pCur;
        }
        $pCur++;
    }
    return ( $p, $l );
}