#!/usr/bin/perl
#THIS IS FILE LCS_DP.PL
# implements the DP for LCS
# for usage see the comments under 'usage options' below
# (at the start of the main routine)
#

use warnings;

sub random_letter {
# returns letter chosen randomly from the first r letters
    return chr( ord("a") +  int(rand $r) );
}

sub make_strings {
# sets @a and @b to random length n strings 
# over the alphabet {a,b,c}
# strings start at position 1, i.e., a[1], b[1]
# since that's how the recurrence works
    @a=@b=();
    $a[0]=$b[0]=""; 
    for ($i=1; $i<=$n; $i++) {
	push @a, random_letter;
	push @b, random_letter;
    }
}

sub make_m {
# fills in the dynamic programming table m[.,.]
    @m=();

    for ($i=0; $i<=$n; $i++) {
	$m[$i][0]=0; $m[0][$i]=0;
    }

    for ($i=1; $i<=$n; $i++) {
	for ($j=1; $j<=$n; $j++) {
	    if ($a[$i] eq $b[$j]) {
		$m[$i][$j]=$m[$i-1][$j-1]+1} #match case
	    elsif ($m[$i][$j-1]>= $m[$i-1][$j]) {
		$m[$i][$j]=$m[$i][$j-1] } #mismatch - for backtracing, ties go left
	    else {
		$m[$i][$j]=$m[$i-1][$j] }; #mismatch
	}
    }
}

sub make_lcs {
#sets @a_lcs and @b_lcs to indicator arrays for the lcs letters
# a_lcs[i] = 1 iff the ith letter of a is in the lcs, 1 <= i <= n 
    $i = $j = $n;
    while ($i + $j >0) {
	if ($a[$i] eq $b[$j]) {  #match case
	    $a_lcs[$i] = $b_lcs[$j] = 1;
	    $i--; $j--;
	}
	elsif ( $i==0 
		|| 
		($j>0) && $m[$i][$j-1]>= $m[$i-1][$j]
		) { #mismatch
	    $b_lcs[$j] = 0; $j--; 
	} 
	else { #mismatch
	    $a_lcs[$i] = 0; $i--; 
	}
    }
}

sub make_lcs_path {
#sets @path_i and @path_j to the table entries in the lcs path
# ie, m[ $path_i[k], $path_j[k] ] is an entry in m that's on the path
# k=0 is the start of the path, i.e., the entry n,n

    @path_i = @path_j = ();
    $i = $j = $n; 
    push @path_i, $i; push @path_j, $j;
    $done=0;
    while ($i + $j >0) {
	unless ($done) {
	    push @path_i, $i; push @path_j, $j;
	    $done = ($i==0 || $j==0); #path ends as soon as we hit the table's edge
	}
	if ($a[$i] eq $b[$j]) {  #match case
	    $i--; $j--;
	}
	elsif ( $i==0 
		|| 
		($j>0) && $m[$i][$j-1]>= $m[$i-1][$j]
		) { #mismatch
	    $j--; 
	} 
	else { #mismatch
	    $i--; 
	}
	if (!$done && $i==0 && $j==0) {push @path_i, $i; push @path_j, $j;}
    }
}

$n=3; $r=3;
while (1) {
    print "[n], [r], [g]o, [m] table or [q]uit?";
# usage options:
# n  redefines n, eg, "n 6" sets n to 6 
#    (n is the number of letters in each string)
#    dont forget to enter the number after n!
# r  redefines r, eg, "r 5" sets r to 5   
#    (strings are chosen randomly using the first r lowercase letters)
# g  generates new random strings and resolves the problem
#    keeping n & r unchanged
# m  prints the DP table for the current problem
#  
    $in=<>;chop $in;
    ($opt, $val)=split " ",$in;

    if ($opt eq "n" || $opt eq "r" || $opt eq "g") {
	if ($opt eq "n") {$n=$val} elsif ($opt eq "r") {$r=$val};
	unless ($opt eq "g") {
	    print "generating length $n strings over first $r letters\n";
	}
	make_strings;
	make_m;
	make_lcs;
#print a string
	for $i (1..$n) {
	    if ($a_lcs[$i]) {print "$a[$i]*";}
	    else  {print "$a[$i] ";}
	}
	print "\n";
#print b string
	for $i (1..$n) {
	    if ($b_lcs[$i]) {print "$b[$i]*";}
	    else  {print "$b[$i] ";}
	}
	print "\n";
#print lcs
	for $i (1..$n) {
	    if ($b_lcs[$i]) {print "$b[$i]";}
	}
	if ($m[$n][$n]==0) {print "empty lcs";};
	print "\n";
    }
    elsif ($in eq "q") {exit}
    elsif ($in eq "m") {
	make_lcs_path;
#$next_i,$next_j is the next table entry on the path to be encountered 
	$next_i= pop @path_i;  $next_j= pop @path_j;

	print  "      ";   
#print b
	for $j (1..$n) {
	    print "$b[$j]";
	    if ($b_lcs[$j]) {print "* ";}
	    else {print "  ";}
	}
	print "\n";
#print the rest of the table
	for $i (0..$n) {
	    if ($i==0) {print  "   ";} 
#after 0th row, each row begins with next letter of a
	    else {print "$a[$i]";
		  if ($a_lcs[$i]) {print "* ";}
		  else {print "  ";}
	      }
#print the table entries    
	    for $j (0..$n) {
		print $m[$i][$j];
		if ($i == $next_i && $j == $next_j ) {
		    print "* "; 
		    $next_i= pop @path_i;  $next_j= pop @path_j;
		} 
		else {print "  ";}
	    }
	    print "\n";
	}
    }
}