更快的 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///c

这将对两个单词执行字符串排除或;只要字符相同，就会产生"\0";如果它们不相同，就会产生非"\0"。 TR 在其补码计数模式下计算差异。

其次，请注意单词的前半部分或后半部分

必须完全匹配，将单词按其前半部分和后半部分划分为哈希，减少您需要检查给定单词的其他单词的数量。

这种方法应该只有所有字符串内存的两到三倍(加上一点开销(;通过推送$word并在 grep 中使用$$_和排序映射 $$_，它可以减少到内存的一到两倍，@match输出中，

但代价是速度。如果单词的

长度都相同，则可以删除哈希的顶层，并将两个不同的哈希用于单词的开头和结尾。

use strict;
use warnings;
use autodie;
my %strings;
my $filename = shift or die "no filename providedn";
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///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 "$wordn";
    }
}

请注意，这仅查找替换，而不查找插入、删除或转置。

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, "";
        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, "";
        $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 -