http://www.perlmonks.org?node_id=1042533


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!