Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: Recognizing pattern in 2D grid

by Eily (Monsignor)
on Jan 16, 2018 at 15:23 UTC ( [id://1207354]=note: print w/replies, xml ) Need Help??


in reply to Recognizing pattern in 2D grid

Hello pwagyi.

I wanted to try a on a flat string, with a regex that would do something like /A(.*)B.{N}C.{N}D/ where (.*) would be of length 0 (row), width (column) or width+1 (diagonal from top left to bottom right), and N would somehow be equal to that length.

I managed to do that using (??{ CODE }) patterns, which makes it possible to embed a new sub pattern in a regex while it is being run. But it is not available by default: you need use re "eval";.

Since the regex is build from the searched pattern, this ended up being a function that takes a pattern as a parameter, and returns a closure that will search that pattern in a grid. Maybe that's too many advanced perl feature for usable code ^^" .

use strict; use warnings; use re qw( eval ); use Data::Dump qw( pp ); sub finder_maker { my $pattern = shift; my @chars = split //, $pattern; die unless @chars > 1; my ($first_char, $second_char, @tail) = @chars; # Each character after the first two will be followed by (??{'.{'.le +ngth($1).'}'}) # This means that the code '.{'.length($1).'}' will be run while the + regex is executed # and be replaced by .{N} with N the length of the first interval my $regex_tail = join "", map "(??{'.{'.length(\$1).'}'})$_", @tail; # Return a sub that will search for this pattern in a grid return sub { my $data = $_[0]; my $width = @{ $data->[0] }; say "Searching for $pattern in:\n", pp($data); # To avoid the string "ABCD" for # A B # C D # giving a false row on BC, we add dummy values to onl +y keep the actual rows as valid # So we will have "AB__CD__" instead my $string = ""; $string .= join "", @$_, "_" x @$_, "\n" for @$data; my %directions = ( 0 => "Row", 2*$width => "Column", 2*$width+1 => "Diagonal" ); # Allow a distance that matches a row, column or diago +nal for the first interval my $first_interval = join "|", map ".{$_}", keys %dire +ctions; # Find the first char, then the second, separated by a +n allowed interval $string =~ /$first_char ($first_interval) $second_char + $regex_tail/xs or say "Not found\n\n" and return { }; my $out = { x => int($-[0]%(1+2*$width)), y => int($-[0]/(1+2*$width)), Direction => $directions{length $1} }; say "Found:\n", pp($out), "\n\n"; return $out; }; } my $grid = [ [ qw( a a b a c ) ], [ qw( a a a c f ) ], [ qw( a f c 1 b ) ], [ qw( a w x c z ) ], [ qw( a q h q c ) ] ]; my $afx = finder_maker("afx"); $afx->($grid); finder_maker("fc1b")->($grid); my $smaller = [ ['w', 'a'], ['a', 'q'] ]; my $wq = finder_maker("wq"); $wq->($grid); $wq->($smaller); finder_maker("Nothing")->($smaller);
Searching for afx in: [ ["a", "a", "b", "a", "c"], ["a", "a", "a", "c", "f"], ["a", "f", "c", 1, "b"], ["a", "w", "x", "c", "z"], ["a", "q", "h", "q", "c"], ] Found: { Direction => "Diagonal", x => 0, y => 1 } Searching for fc1b in: [ ["a", "a", "b", "a", "c"], ["a", "a", "a", "c", "f"], ["a", "f", "c", 1, "b"], ["a", "w", "x", "c", "z"], ["a", "q", "h", "q", "c"], ] Found: { Direction => "Row", x => 1, y => 2 } Searching for wq in: [ ["a", "a", "b", "a", "c"], ["a", "a", "a", "c", "f"], ["a", "f", "c", 1, "b"], ["a", "w", "x", "c", "z"], ["a", "q", "h", "q", "c"], ] Found: { Direction => "Column", x => 1, y => 3 } Searching for wq in: [["w", "a"], ["a", "q"]] Found: { Direction => "Diagonal", x => 0, y => 0 } Searching for Nothing in: [["w", "a"], ["a", "q"]] Not found

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1207354]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (6)
As of 2024-03-28 18:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found