1

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

AAAA
AAAB
AABA
BBBB
CCCC

我想得到这样的东西：

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

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

编辑：单词仅由 5 个字符组成，ATCG 或 N，它们的长度不到 100 个字符。整个事情应该适合内存（<5GB）。每行一个单词，我想将它与其他单词进行比较。

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

4

2 回答 2

4

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

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

这对两个单词进行字符串排他或；只要字符相同，就会产生“\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";
    }
}

请注意，这只查找替换，而不是插入、删除或转座。

于 2014-12-07T07:20:17.017 回答
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 -
于 2014-12-07T07:12:08.983 回答