Linux 去阿格雷普的更快的方法?快速找到每个不匹配的字符

Linux 去阿格雷普的更快的方法?快速找到每个不匹配的字符,linux,perl,grep,agrep,Linux,Perl,Grep,Agrep,我正在寻找最快的方法来查找大文件中每个单词之间的每个字符不匹配。如果我有这个: AAAA AAAB AABA BBBB CCCC 我想得到这样的东西: AAAA - AAAB AABA AAAB - AAAA AABA - AAAA BBBB CCCC 目前我正在使用agrep,但由于我的文件有数百万行长,速度非常慢。每个单词都在自己的行上,并且它们的字符数都相同。我希望有一些优雅的东西我没能找到。多谢各位 编辑:单词由5个字符组成,一个T、C、G或N,长度不到100个字符。整件事都应该放在

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

AAAA
AAAB
AABA
BBBB
CCCC
我想得到这样的东西:

AAAA - AAAB AABA
AAAB - AAAA
AABA - AAAA
BBBB
CCCC
目前我正在使用agrep,但由于我的文件有数百万行长,速度非常慢。每个单词都在自己的行上,并且它们的字符数都相同。我希望有一些优雅的东西我没能找到。多谢各位


编辑:单词由5个字符组成,一个T、C、G或N,长度不到100个字符。整件事都应该放在内存中它需要很大的内存占用,但以下几点可以在两个过程中完成您的任务:

#!/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

它需要很大的内存占用,但以下几点可以在两个过程中完成任务:

#!/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

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

( $word1 ^ $word2 ) =~ tr/\0//c
这对这两个词做了严格的异或运算;如果字符相同,则结果为\0;如果它们不相同,将导致非-\0。tr在补码计数模式下计算差异

第二,注意单词的前半部分或后半部分必须完全匹配,将单词按前半部分和后半部分划分为散列,减少需要检查给定单词的其他单词的数量

这种方法应该只占用所有字符串内存的两到三倍,外加一点开销;通过在grep中按\$word并使用$$\u,在输出中使用排序映射$$\u、@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";
    }
}

请注意,这只查找替换,而不是插入、删除或换位。

如果您查找的单词只有一个字符的差异,可以使用以下技巧。首先,要比较两个单词并计算不同的字符数,请使用以下方法:

( $word1 ^ $word2 ) =~ tr/\0//c
这对这两个词做了严格的异或运算;如果字符相同,则结果为\0;如果它们不相同,将导致非-\0。tr在补码计数模式下计算差异

第二,注意单词的前半部分或后半部分必须完全匹配,将单词按前半部分和后半部分划分为散列,减少需要检查给定单词的其他单词的数量

这种方法应该只占用所有字符串内存的两到三倍,外加一点开销;通过在grep中按\$word并使用$$\u,在输出中使用排序映射$$\u、@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";
    }
}

请注意,这只查找替换,而不是插入、删除或换位。

请告诉我们有关您的实际数据的更多信息;这些是长度变化很大的真实单词,还是固定的或有限的长度范围,或者使用字符子集?每行只有一个单词,您希望将每个单词与文件中的每个其他单词进行比较?AABA和AAAB不符合我对单个字符不匹配的定义;这是一个错误吗?如果不是,你的定义是什么?你的台词有多长?关键是要知道你的每个词有多长。它决定了整个列表是否可以保存在内存中;这些是长度变化很大的真实单词,还是固定的或有限的长度范围,或者使用字符子集?每行只有一个单词,您希望将每个单词与文件中的每个其他单词进行比较?AABA和AAAB不符合我对单个字符不匹配的定义;这是一个错误吗?如果不是,你的定义是什么?你的台词有多长?关键是要知道你的每个词有多长。它决定了整个列表是否可以保存在内存中。好吧,我本打算等待我的评论的答案,但我将发布我的答案,这就像你的答案一样,效率更高:是的,我想你已经澄清了他的例子中的不一致性。期待您的回答。+$uniq{${}至少有两个原因更好!它将动词放在第一位,并不意味着您需要预先递增的值。可能还有一些语言实现无法优化原始值的保存。好吧,我本打算等待我的评论的答案,但我将发布我的答案,这就像你的答案一样,效率更高:是的,我认为你已经澄清了他示例中的不一致性。期待你的回答。
++$uniq{${}之所以更好,至少有两个原因!它将动词放在第一位,并不意味着您需要预先递增的值。可能还有一些语言实现无法优化原始值的保存。出于好奇,这需要多长时间才能运行,需要多少个单词?使用如此小的输入字母表,如果您想用人类可读性换取表示的紧凑性,您可以转换成某种位图表示。您可以将其压缩为每个符号三位,但为了保持字节对齐,我可能会选择四位。根据分布模式的不同,也许有一种聪明的方法可以将其一直降低到每个符号两位。出于好奇,这需要运行多长时间,以及与多少个单词相对应?对于如此小的输入字母表,如果您想用人类可读性换取表示的紧凑性,可以转换为某种位图表示。您可以将其压缩为每个符号三位,但为了保持字节对齐,我可能会选择四位。根据分布模式的不同,也许有一种聪明的方法可以将其一直降到每个符号两位。