### Re: "Inverse" Pattern Matching

by choroba (Cardinal)
 on Jul 04, 2013 at 22:32 UTC Need Help??

in reply to "Inverse" Pattern Matching

What about this? I keep a list of possible positions, I delete non-matching positions recursively character by character. If I make the string much longer (x 100_000), it still runs only for 8 seconds on my box.
```#!/usr/bin/perl
use warnings;
use strict;
use feature qw(say);

#                         1         2         3         4
#               0123456789012345678901234567890123456789012345
#               |         |         |    |   |        |
our \$string  = '1234561234123x561234123x61234x3456123412345x1';
our \$pattern = '123456';

our \$pattern_length = length \$pattern;

our %results;

search(0, 0, [0 .. length(\$string) - 1]);
say for sort { \$a <=> \$b } keys %results;

sub search {
my (\$p_pos, \$s_pos, \$positions) = @_;
return if \$p_pos > \$pattern_length;
return unless @\$positions;

if (\$p_pos == \$pattern_length) {
undef @results{@\$positions};
return;
}

my \$char = substr \$pattern, \$p_pos, 1;

search(\$p_pos + 1, \$s_pos + 1,
[ grep {
my \$ch = substr(\$string, \$s_pos + \$_, 1);
\$char eq \$ch or 'x' eq \$ch;
} @\$positions ]);

search(\$p_pos + 2, \$s_pos + 1,
[ grep substr(\$string, \$s_pos + \$_, 1) eq 'x',
@\$positions ]);
}
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Replies are listed 'Best First'.
Re^2: "Inverse" Pattern Matching
by hdb (Monsignor) on Jul 05, 2013 at 12:21 UTC

Thanks a lot. I am still working to get a proper understanding but your proposal has already found a match in my example that I have overlooked!

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1042533]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2024-07-22 11:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.