Perl: the Markov chain saw PerlMonks

### Re^2: How do you match a stretch of at least N characters

 on Sep 11, 2017 at 14:39 UTC ( #1199116=note: print w/replies, xml ) Need Help??

Choroba, thank you very much for the code. I am bit confused, is the second part an addition to the previous one? Because - I think - I get only exact matches with the second part, or not?
• Comment on Re^2: How do you match a stretch of at least N characters

Replies are listed 'Best First'.
Re^3: How do you match a stretch of at least N characters
by choroba (Bishop) on Sep 11, 2017 at 14:46 UTC
No, it's a replacement. It reports 107 matches for me, 92 of them are exact.

```(\$q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+\$1,++print+eval\$q,q,a,
Aha, ok, I see, probably I just ran into the exact ones by chance... I know I am pushing my luck a bit, but since you have been so helpful and the code is yours, is there a way that I can see which of the 10-mers are consecutive and "paste" them into one larger match?
```AGCAATATTTCAAG
AGCAATATTTCAAG

GCAATATTTCAAGA
GCAATATTTCAAGA

For example, these 2 are basically the same, just going 1 position further.
Hm, now that I am thinking it better, was the problem I asked for a question of finding the longest possible match with one mismatch allowed? Would that have been easier and I was wasting everyone's time here?
> is there a way that I can see which of the 10-mers are consecutive and "paste" them into one larger match?

It's not so easy. You can't paste them together, as that might increase the number of mismatches over the threshold.

But you can change the algorithm totally if you want to find the longest matches. Just move the shorter string alongside the longer one, and then for each position try to find the longest match starting there.

```#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my \$stretch = 10;
my \$mismatches = 1;

substr \$reference_str, 0, 0, 'x' x (length(\$small_str) - 1);
\$reference_str .= 'x' x (length(\$small_str) - 1);

for my \$start_pos (0 .. length(\$reference_str) - length(\$small_str)) {
my \$substr = substr \$reference_str, \$start_pos, length(\$small_str)
+;

my (\$from, \$diffs) = (0, 0);
for my \$inner_pos (0 .. length(\$small_str) ) {
++\$diffs if substr(\$substr, \$inner_pos, 1)
ne substr \$small_str, \$inner_pos, 1;

if (\$diffs > \$mismatches || \$inner_pos == length(\$small_str) )
+ {
say join "\n\t",
\$start_pos + \$from + 1 - length \$small_str,
substr(\$small_str, \$from, \$inner_pos - \$from),
substr(\$reference_str, \$from + \$start_pos, \$inner_pos
+- \$from)
if \$inner_pos - \$from >= \$stretch;

++\$from until (substr \$small_str, \$from, 1) ne substr(\$sub
+str, \$from, 1) || \$from > \$inner_pos;
++\$from;
--\$diffs;
}
}
}

> was the problem I asked for a question of finding the longest possible match with one mismatch allowed?

Basically, yes.

```(\$q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+\$1,++print+eval\$q,q,a,

Create A New User
Node Status?
node history
Node Type: note [id://1199116]
help
Chatterbox?
and snow settles gently...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2018-01-21 19:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How did you see in the new year?

Results (229 votes). Check out past polls.

Notices?