perl中的高效子串匹配
发布时间:2020-12-15 21:55:25 所属栏目:大数据 来源:网络整理
导读:我正在寻找一个有效的解决方案,找到一个字符串中最长的子字符串,容忍主字符串中的n个不匹配 例如: 主弦 AGACGTACTACTCTACTAGATGCA * TACTCTAC * AGACGTACTACTCTACTAGATGCA * TACTCTAC * AGACGTACTACTCTACAAGATGCA * TACTCTAC * AGACGTACTACTTTACAAGATGCA *
我正在寻找一个有效的解决方案,找到一个字符串中最长的子字符串,容忍主字符串中的n个不匹配
例如: > AGACGTACTACTCTACTAGATGCA * TACTCTAC * 搜索字符串: > TACTCTACT:这应该被视为与所有上述主要字符串匹配. 另外,我可能会遇到子串的一部分位于主字符串末尾的情况,我也想选择它. 如果你能给出一些指示,我将不胜感激. PS:我将有一个搜索字符串和大约1亿个主字符串来搜索子字符串. 谢谢! 解决方法use strict; use warnings; use feature qw( say ); sub match { my ($s,$t,$max_x) = @_; my $m = my @s = unpack('(a)*',$s); my $n = my @t = unpack('(a)*',$t); my @length_at_k = ( 0 ) x ($m+$n); my @mismatches_at_k = ( 0 ) x ($m+$n); my $offset = $m; my $best_length = 0; my @solutions; for my $i (0..$m-1) { --$offset; for my $j (0..$n-1) { my $k = $j + $offset; if ($s[$i] eq $t[$j]) { ++$length_at_k[$k]; } elsif ($length_at_k[$k] > 0 && $mismatches_at_k[$k] < $max_x) { ++$length_at_k[$k]; ++$mismatches_at_k[$k]; } else { $length_at_k[$k] = 0; $mismatches_at_k[$k] = 0; } my $length = $length_at_k[$k] + $max_x - $mismatches_at_k[$k]; $length = $i+1 if $length > $i+1; if ($length >= $best_length) { if ($length > $best_length) { $best_length = $length; @solutions = (); } push @solutions,$i-$length+1; } } } return map { substr($s,$_,$best_length) } @solutions; } say for match('AABBCC','DDBBEE',2); 输出: AABB ABBC BBCC (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |