快捷方式agrep？快速找到每個單個字符不匹配

Question

我正在尋找最快的方法來查找大文件中每個單詞之間的每個單個字符不匹配。如果我有這樣的：

AAAA 
AAAB 
AABA 
BBBB 
CCCC 

我希望得到的東西是這樣的：

AAAA - AAAB AABA 
AAAB - AAAA 
AABA - AAAA 
BBBB 
CCCC 

目前我使用AGREP但我的文件是百萬行的長，這是非常緩慢的。每個單詞都在自己的行上，並且它們都是相同數量的字符。我期待有一些我無法找到的優雅。謝謝

編輯：這些單詞只有5個字符，A T C G或N，他們只有不到100個字符長。整個事情應該適合內存（< 5GB）。每行有一個單詞，我想將它與其他每個單詞進行比較。

編輯2：示例不正確現在已修復。

Answer 1

如果你正在尋找一個只有一個單詞性格的差異，你可以使用一些技巧。首先，比較兩個詞並計算不同的字符數，使用此：

($word1^$word2) =~ tr/\0//c 

這確實一個stringwise獨家或兩個詞;無論字符是否相同，都會產生「\ 0」;如果它們不相同，則會導致非「\ 0」。 tr在其補足計數模式下計算差異。其次，注意到單詞的前半部分或後半部分必須完全匹配，根據單詞的前半部分和後半部分將單詞分爲哈希，從而減少需要檢查給定單詞的其他單詞的數量。

這種方法應該只有兩倍或三倍所有字符串的內存（加上一點開銷）;可以通過將\$word和$$_用於輸出中的grep和分類映射$$ _，@match，以某種速度爲代價將其減少至內存的一至兩倍。

如果單詞長度相同，則可以刪除散列的頂層，並使用兩個不同的散列用於單詞的開始和結尾。

use strict; 
use warnings; 
use autodie; 
my %strings; 

my $filename = shift or die "no filename provided\n"; 
open my $fh, '<', $filename; 
while (my $word = readline $fh) { 
    chomp $word; 
    push @{ $strings{ 'b' . length $word }{ substr($word, 0, length($word)/2)} }, $word; 
    push @{ $strings{ 'e' . length $word }{ substr($word, length($word)/2)} }, $word; 
} 
seek $fh, 0, 0; 
while (my $word = readline $fh) { 
    chomp $word; 
    my @match = grep 1 == ($word^$_) =~ tr/\0//c, @{ $strings{ 'b' . length $word }{ substr($word, 0, length($word)/2) } }, @{ $strings{ 'e' . length $word }{ substr($word, length($word)/2) } }; 
    if (@match) { 
     print "$word - " . join(' ', sort @match) . "\n"; 
    } 
    else { 
     print "$word\n"; 
    } 
} 

請注意，這隻查找替換，而不是插入，刪除或換位。

Answer 2

它需要大容量內存，但下面可以分兩次完成任務：

#!/usr/bin/env perl 

use strict; 
use warnings; 

use Fcntl qw(:seek); 

my $fh = \*DATA; 

my $startpos = tell $fh; 

my %group; 

while (<$fh>) { 
    chomp; 

    my $word = $_; 

    for my $i (0 .. length($word) - 1) { 
     substr my $star = $word, $i, 1, "\0"; 
     push @{ $group{$star} }, \$word; 
    } 
} 

seek $fh, $startpos, SEEK_SET; 

while (<$fh>) { 
    chomp; 

    my %uniq; 

    my $word = $_; 

    for my $i (0 .. length($word) - 1) { 
     substr my $star = $word, $i, 1, "\0"; 
     $uniq{$_}++ for map $$_, @{ $group{$star} }; 
    } 

    delete $uniq{$word}; 

    print "$word - ", join(' ', sort keys %uniq), "\n"; 
} 

__END__ 
AAAA 
AAAB 
AABA 
BBBB 
CCCC 

輸出：

AAAA - AAAB AABA 
AAAB - AAAA 
AABA - AAAA 
BBBB - 
CCCC -