Question

我正在寻找找到大文件中每个单词之间每个字符不匹配的最快方法。如果我有这个：

AAAA
AAAB
AABA
BBBB
CCCC

我想得到这样的东西：

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

目前我正在使用agrep，但由于我的文件长达数百万行而且非常慢。每个单词都在它自己的行上，它们都是相同数量的字符。我希望有一些我无法找到的优雅。谢谢

编辑：单词由5个字符组成，A T C G或N，长度不超过100个字符。整个东西应该适合内存（<5GB）。每行有一个单词，我想将它与其他每个单词进行比较。

Edit2：示例不正确现在已修复。

Answer 1

如果您正在寻找只有一个字符差异的单词，那么您可以使用几个技巧。首先，要比较两个单词并计算不同的字符数，请使用：

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

这是一个字符串排除或两个单词;如果字符相同，则为＆＃34; \ 0＆＃34;将导致;他们不一样的地方，非 - ＆＃34; \ 0＆＃34;将导致。 tr，在补数计数模式下，计算差异。

其次，注意到单词的前半部分或后半部分必须完全匹配，将单词的前半部分和后半部分分成哈希值，减少检查给定单词所需的其他单词的数量。

这种方法应该只是所有字符串内存的两到三倍（加上一点开销）;通过在grep中使用\$word并使用$$_并在输出中排序映射$$ _，@匹配，可以将其减少到内存的一到两倍。以某种速度为代价。

如果单词的长度都相同，则可以删除散列的顶级，并使用两个不同的散列用于单词＆＃39;开始和结束。

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 -

更快的agrep方式？快速找到每个字符不匹配

2 个答案: