如果我要匹配一个字符串$a="ATTCCGGGAT";那么直接在shell里面grep它即可，写脚本也行$seq =~ /$a/;，但是如果我想查找这个字符串的模糊匹配，允许一个错配的情况，那么就非常多了！这时候简单的匹配已经不能达到目的，但是我们仍然可以用perl强大的正则匹配功能达到目的。

比如，它的匹配模式应该:

/.TTCCGGGAT/

/A.TCCGGGAT/

/AT.CCGGGAT/等等，可以把这些模式都综合起来就是下面这个

$b=(?^:(?:A(?:T(?:T(?:C(?:C(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT)|.GGGAT)|.CGGGAT)|.CCGGGAT)|.TCCGGGAT)|.TTCCGGGAT))

所以我们就应该通过程序来生成这个字符串，然后用

$seq =~ /$b/;来替代$seq =~ /$a/;

而允许两个错配的格式就更复杂了：

(?^:(?:A(?:T(?:T(?:C(?:C(?:G(?:G(?:G..|.(?:A.|.T))|.(?:G(?:A.|.T)|.AT))|.(?:G(?:G(?:A.|.T)|.AT)|.GAT))|.(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT))|.(?:C(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT)|.GGGAT))|.(?:C(?:C(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT)|.GGGAT)|.CGGGAT))|.(?:T(?:C(?:C(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT)|.GGGAT)|.CGGGAT)|.CCGGGAT))|.(?:T(?:T(?:C(?:C(?:G(?:G(?:G(?:A.|.T)|.AT)|.GAT)|.GGAT)|.GGGAT)|.CGGGAT)|.CCGGGAT)|.TCCGGGAT)))

[perl]

$a="ATTCCGGGAT";
$one_match=fuzzy_pattern($a,1);
print "$one_match\n";

sub fuzzy_pattern {
my ($original_pattern, $mismatches_allowed) = @_;
$mismatches_allowed >= 0
or die "Number of mismatches must be greater than or equal to zero\n";
my $new_pattern = make_approximate($original_pattern, $mismatches_allowed);
return qr/$new_pattern/;
}
sub make_approximate {
my ($pattern, $mismatches_allowed) = @_;
if ($mismatches_allowed == 0) { return $pattern }
elsif (length($pattern) <= $mismatches_allowed)
{ $pattern =~ tr/ACTG/./; return $pattern }
else {
my ($first, $rest) = $pattern =~ /^(.)(.*)/;
my $after_match = make_approximate($rest, $mismatches_allowed);
if ($first =~ /[ACGT]/) {
my $after_miss = make_approximate($rest, $mismatches_allowed-1);
return "(?:$first$after_match|.$after_miss)";
}
else { return "$first$after_match" }
}
}

[/perl]

只需要控制$one_match=fuzzy_pattern($a,1);里面的参数即可控制自己想要的匹配情况。

然后把生成的匹配模式用了进行序列匹配$seq =~ /$one_mismatch/;

这个程序的重点就是解析需要生成的匹配字符串规则，然后用递归来生成这个匹配字符串。

这种匹配，在引物搜索特别有用。

我想输出ATCG四个字符，组成一个12个字符长度字符串的全排列。共4^12=16777216种排列，

AAAAAAAAAAAA

AAAAAAAAAAAT

AAAAAAAAAAAC

AAAAAAAAAAAG

AAAAAAAAAATA

`````````````````````````

按照正常的想法是通过多重循环来生成全排列，所以我写下了下面这样的代码，但是有个问题，它不支持多扩展性，如果100个全排列，那么得写一百次循环嵌套。

所以我求助了perl-china群里的高手，其中一个给了一个结合二进制的巧妙解决方案。

perl -le '{$a{"00"}="A";$a{"01"}="T";$a{"10"}="C";$a{"11"}="G";for(0..100){print join"",map{$a{$_}} unpack("a2"x12,sprintf("%024b\n",$_))}}'

AAAAAAAAAAAA

AAAAAAAAAAAT

AAAAAAAAAAAC

AAAAAAAAAAAG

AAAAAAAAAATA

AAAAAAAAAATT

AAAAAAAAAATC

AAAAAAAAAATG

AAAAAAAAAACA

AAAAAAAAAACT

AAAAAAAAAACC

AAAAAAAAAACG

AAAAAAAAAAGA

AAAAAAAAAAGT

AAAAAAAAAAGC

AAAAAAAAAAGG

AAAAAAAAATAA

AAAAAAAAATAT

这里我简单解释一下这个代码

perl -le '{$a=sprintf("%024b\n",1);print $a}'

000000000000000000000001

这个sprintf是根据024b的格式把我们的十进制数字转为二级制，但是补全为24位。

perl -le '{@a=unpack("a2"x12,sprintf("%024b\n",100));print join":", @a}'

00:00:00:00:00:00:00:00:01:10:01:00

unpack这个函数很简单，就是把二进制的数值拆分成字符串数组，两个数字组成一个字符串。

最后通过map把$a{"00"}="A";$a{"01"}="T";$a{"10"}="C";$a{"11"}="G";对应成hash值并且输出即可！

然后这个大神又提成了一个递归的办法来解决

[perl]

#!/usr/bin/perl

my $arr = [];

$arr->[$_] = 0 for (0..11);
my @b = ("A","C","G","T");

while(1){
print join "", map {$b[$_]} @$arr;
print "\n";
exit unless &count($arr,11);
}

sub count {
my $arr = shift;
my $x = shift;

return 0 if $x < 0;

if ($arr->[$x] < 3){
$arr->[$x]++;
return 1;
}

else{
$arr->[$x] = 0;
return &count($arr,$x - 1);
}
}

[/perl]

还有另外一个大神也提成了一个递归的算法解决，算法之道还是蛮有趣的

最后还补充一个也是计算机技巧的解决方案，也是群里的朋友提出来的。

[perl]

#!/usr/bin/perl -w

my @A = qw(A T G C);
my $N = 12;

foreach my $n (0..4**$N){
foreach my $index (0..$N){
print $A[$n%4];
$n = $n >>2;
}
print "\n";
}

[/perl]

这个是位运算，如果C语言基础学的好的同学很快就能看懂的。