sub find_flccos { my @a = @{$_[0]}; my @b = @{$_[1]}; my (%map,@curchk,@longest); foreach my $i (0 .. $#a) { # I decided to store this map so we don't repeat this # O(n) step if we come across the same letter again $map{$a[$i]} = [ grep $b[$_] eq $a[$i], (0 .. $#b) ] unless defined $map{$a[$i]}; # ok, these are the indices in b where we should #start matching from foreach my $j (@{$map{$a[$i]}}) { @curchk = (); # make temporary indices my ($ti,$tj) = ($i,$j); # fill @curchk with the longest current match while ($ti < @a && $tj < @b && $a[$ti] eq $b[$tj]) { push @curchk, $a[$ti]; $ti++; $tj++; } # change the longest array if it is longer #than the one found previously @longest = @curchk if ($#curchk > $#longest); } } return @longest; } __DATA__ my (@a,@b,@c,@d,@e,@f); @a = qw( a a a a b c d ); @b = qw( a b c b a b a c a d ); @c = qw(fred bob joe jim mary elaine); @d = qw(frank joe jim mary bob); @e = @f = (); print join ",", find_flccos(\@a,\@b); print $/; print join ",", find_flccos(\@d,\@c); print $/; print join ",", find_flccos(\@e,\@f); print $/; OUTPUT: > perl flccos.pl a,b,c joe,jim,mary >