Perl - 2つ以上の文字列の最も長い共通接頭辞？

Question

どのように配列を取り、2つ以上の要素の最も長い共通接頭辞を見つけるPerlサブルーチンを作成できますか？ （文字列）

私はこのコードを持っている：

sub longest_common_prefix { 
    $prefix = shift; 
    for (@_) { 
     chop $prefix while (! /^\Q$prefix\E/); 
     } 
    return $prefix; 
} 

をしかし、あなたはすべての文字列の最長の共通のプレフィックスを探している場合にのみ動作します。

aaaBGFB 
aaaJJJJ 
jjfkBBB 
aaaHGHG 

私はそれが答えとしてaaaを返すようにしたい：私は以下の文字列の配列を渡す場合例えば

、。

ありがとうございます！

Answer 1

1つの方法は、情報をハッシュに格納することです。この例では、各プレフィックスの長さにハッシュキーを設定し、見つかった実際のプレフィックスの値を設定します。同じ長さの接頭辞が存在する場合、この方法は、キーと値を上書きするので、あなたは常に最長の長さを見つけ最後接頭辞を取得しますことを

注（sort()は最長のものを見つけるの世話をします）。

正規表現では、「文字列内の最初の文字を見つけてそれをキャプチャし、2番目のキャプチャで見つかったその文字を使用し、そこにある数だけキャプチャします」と言います。この文字列はjoin()となり、スカラーとしてハッシュされます。

use warnings; 
use strict; 

my %prefixes; 

while (<DATA>){ 
    my $prefix = join '', /^(.)(\1+)/; 
    $prefixes{length $prefix} = $prefix; 
} 

my $longest = (sort {$b <=> $a} keys %prefixes)[0]; 
print "$prefixes{$longest}\n"; 

__DATA__ 
aaBGFB 
aaaJJJJ 
jjfkBBB 
aaaHGHG 

は出力：

aaa 

Answer 2

私は修正trieを使用すると思います。

通常は、一つはトライに追加するには、次の使用することができます

sub add { 
    my $p = \shift; 
    my $s = shift; 
    $p = \($$p->{$_}) for split(//, $s); 
    $$p->{''} = 1; 
} 

しかし、我々は2つの変更が必要です。文字列を追加するとき

• 文字列のすべての接頭辞を追加する必要があります。たとえば、abcを追加する場合は、aとabをトライに追加する必要があります。
• トライに追加するとき、取得したパスの以前の部分の長さを返します。

だから我々は必要です：

sub add { 
    my $p = \shift; 
    my $s = shift; 

    my $cp_len = 0; 
    for (split(//, $s)) { 
     $p = \($$p->{$_}); 
     ++$cp_len if $$p->{$_}{''}; 
     $$p->{''} = 1; 
    } 

    return $cp_len; 
} 

は、取得するには、リストの中で最も長い文字列を検索するためのアルゴリズムで、リストから重複している文字列を削除するためのアルゴリズムと、この（の最適化されたバージョン）を組み合わせます次のソリューション：

use strict; 
use warnings; 
use feature qw(say); 

sub add { 
    my $p = \shift; 
    my $s = shift; 

    my $cp_len = 0; 
    for (split(//, $s)) { 
     ++$cp_len if exists($$p->{$_}); 
     $p = \($$p->{$_}); 
    } 

    return $cp_len; 
} 

my $t; 
my $lcp_len = 0; # lcp = longest common prefix 
my %lcps; 
while (<>) { 
    chomp; 
    my $cp_len = add($t, $_) 
     or next; 

    if ($cp_len >= $lcp_len) { 
     if ($cp_len > $lcp_len) { 
     $lcp_len = $cp_len; 
     %lcps =(); 
     } 

     $lcps{ substr($_, 0, $cp_len) } = 1; 
    } 
} 

my @lcps = sort keys %lcps; 

if (@lcps) { 
    say "Longest common prefix(es): @lcps"; 
} else { 
    say "No common prefix"; 
} 

データ：

abc 
abc 
abcd 
abcde 
hijklx 
hijkly 
mnopqx 
mnopqy 

出力：

Longest common prefix(es): hijkl mnopq 

上記に要する時間は、入力された文字の数に比例します。

Answer 3

最初の文字でキー配列された単語の配列のハッシュを保持できます。定義上、同じ文字で始まる単語がある場合、それらの単語は、その1文字の少なくとも1文字の共通接頭辞を共有します。

use strict; use warnings; 
sub lcp { 
    (join("\0", @_) =~ /^ ([^\0]*) [^\0]* (?:\0 \1 [^\0]*)* $/sx)[0]; 
} 

my %HoA; 
my $longest=''; 

while (my $line=<DATA>){ 
    $line =~ s/^\s+|\s+$//g ; 
    push @{ $HoA{substr $line, 0, 1} }, $line if $line=~/^[a-zA-Z]/; 
} 

for my $key (sort (keys %HoA)) { 
    if (scalar @{ $HoA{$key} } > 1){ 
     my $lon=lcp(@{ $HoA{$key} }); 
     my $s = join ', ', map { qq/"$_"/ } @{ $HoA{$key} }; 
     print "lcp: \"$lon\" for ($s)\n"; 
     if (length($lon) > length($longest)) { 
      $longest=$lon; 
     }    
    } 
    else{ 
     print "$key: no common prefix\n"; 
    } 
} 
print "\nlongest common prefix is \"$longest\"\n"; 

__DATA__ 
aardvark 
aaaBGFB 
aaaJJJJ 
jjfkBBB 
aaaHGHG 
interspecies 
interstellar 
interstate 

プリント：

lcp: "aa" for ("aardvark", "aaaBGFB", "aaaJJJJ", "aaaHGHG") 
lcp: "inters" for ("interspecies", "interstellar", "interstate") 
j: no common prefix 

longest common prefix is "inters"