Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Re: Two-dimensional match/regex? (2)

by Eily (Monsignor)
on Nov 29, 2014 at 01:42 UTC ( #1108686=note: print w/replies, xml ) Need Help??


in reply to Two-dimensional match/regex? (2)

In usual one-dimension search matches can not overlap if we use /g modifier and do not change pos(), but here I'm changing pos() and matches can overlap.
Since you said "In usual one-dimension search", I suppose you may already know how to make it possible for matches to overlap without changing pos. It is done by using look-around assertions.

perl -E 'say scalar (() = "banana" =~ /(?=ana)/g)' will print 2 (because the (?=) portion makes sures there's a match at that position, but perl moves at least one char forward after a zero width match). And you can still get the content of the matches by adding captures inside the look-ahead assertion. perl -E 'say join ", ", "banana" =~ /(?=(ana))/g'.

In the similar node you gave a link to, the main difficulty came from the fact that the lines where not of equal size, but since yours are, your problem translates pretty well to a one-dimension regex:

use v5.14; my $pattern = qr/#.{10}#.{13}#\./ms; $_ = <<STRING; #..#.....#. ..#...##... .#....#..## #..#....#.. ..#...#..#. .......#.#. ........... STRING say pos while /(?=$pattern)/g; __DATA__ 14 19 25
Now you can find the row and column of the matches by using modulos and division.

This, of course, only works when the lines are of constant length, but actually, you can just reformat the input string:

use v5.14; my $length = 20; # Must be higher than the length of the longest line # Add padding so that each line is $length chars long # Without checking what char there are (ie, the \n are kept) # So we know that if a char A is in position $a, the char B below it w +ill be in position # $a+$length, or there will be A.{$length-1}B $_ = pack "(A$length)*", <DATA>; # $length - 2 is one line down, one char to the left my $l1 = $length-2; # $length + 1 is one line down, one char to the right my $l2 = $length+1; my $pattern = qr/#.{$l1}#.{$l2}#\./s; # The first row and column have index 0 with this code say join ", ", 1+int(pos() / $length), 1+(pos() % $length) while /(?= +$pattern)/g; __DATA__ #..#.....# ..#...## .#....#..## #..#....#.....# ..#...#..#.## .......#.# ...........
1, 2 1, 7 2, 1

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2023-12-10 08:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?











    Results (39 votes). Check out past polls.

    Notices?