my @str = map {chomp; $_} ; print LCS(@str), "\n"; sub LCS{ my ($d,$s,%l,%t)=(0,''); my @p=map{my $i=$_;({map{substr($_[$i],$_,1),$_}0..length($_[$i])-1})}0..$#_; my @o=map{my $l=$_;my $r=[map $p[$_]{$l},0..$#p];$l{$r}=[$r,$l];$r}split//,$_[0]; for my $i(0..$#o){$t{$o[$i]}=[map{g($o[$i],$o[$_])?"$o[$_]":()}grep$_!=$i,0..$#o]} my @w=map[$_,1],grep@{$t{$_}},keys%t; while(@w){my $i=pop@w;($s,$d)=@$i if$i->[1]>$d; my @n=@{$t{(split/:/,$i->[0])[-1]}}or next;push@w,map["$i->[0]:$_",$i->[1]+1],@n} join'',map$l{$_}[1],split/:/,$s; } sub g{$_[1]->[$_]<=$_[0]->[$_]&&return 0 for 0..(@{$_[0]}>@{$_[1]}?$#{$_[1]}:$#{$_[0]});1}