use strict; my @a = qw/ fred bob joe jim mary elaine /; my @b = qw/ frank joe jim mary bob /; print "LCS[anjiro] - ", join($", get_lcs(\@a, \@b)), $/; @a = qw/ a b c /; @b = qw/ a b x c /; print "LCS[zby] - ", join($", get_lcs(\@a, \@b)), $/; sub get_lcs { my @a = @{ +shift }; my @b = @{ +shift }; my %map = map { $b[$_] => $_ } 0 .. $#b; my(@lcs, @tmp); for(0 .. $#a) { next unless exists $map{$a[$_]} or $a[$_ + 1] eq $b[$map{$a[$_]} + 1]; push @tmp, $a[$_] if $a[$_] eq $b[$map{$a[$_]}]; if($a[$_ + 1] ne $b[$map{$a[$_]} + 1]) { @lcs = @tmp if @tmp > @lcs; @tmp = (); } } @lcs = @tmp if @tmp > @lcs; return @lcs; } __output__ LCS[anjiro] - joe jim mary LCS[zby] - a b