### match diagonal text

by arivu198314 (Sexton)
 on Sep 22, 2011 at 07:31 UTC Need Help??
arivu198314 has asked for the wisdom of the Perl Monks concerning the following question:

I need to match particular number in the matrix formatted text like

```\$a='
220021
000200
020222
020222';

From the above matrix i need to find diagonal 1111 or 2222.

I have written the code, but its very big. So can anyone optimize this code

```my \$arraycount=0; my @charArray=(); my @linear=grep length, split /\n/
+, \$a;
@lines=@linear;
while (length join "", @linear)
{
\$reversed=join("", map { s/(.)//s ? \$1 : "" } @linear);
push (@charArray, [split //, \$reversed]);
}

my \$result; my \$findString='1|2';
for(my \$rw=0; \$rw < (@lines-3); \$rw++)
{
my @line=split //, \$lines[\$rw];
foreach my \$index (grep {\$line[\$_]=~m/\$findString/} 0..\$#line)
{
if ((\$line[\$index].\$charArray[\$index+1][\$rw+1].\$charArray[
+\$index+2][\$rw+2].\$charArray[\$index+3][\$rw+3] eq \$line[\$index] x 4) or
+ (\$line[\$index].\$charArray[\$index-1][\$rw+1].\$charArray[\$index-2][\$rw+
+2].\$charArray[\$index-3][\$rw+3] eq \$line[\$index] x 4))
{
print \$line[\$index];
}
}
}

Replies are listed 'Best First'.
Re: match diagonal text
by BrowserUk (Pope) on Sep 22, 2011 at 08:01 UTC
From the above matrix i need to find diagonal 1111 or 2222.

Do you mean that you are only interested in exactly 4 (not say 3) of '1's or '2's on a diagonal?

Are you only interested in those on this \ diagonal and not this / one?

Will the input always be 6 x 4?

If the answers to those three are yes, then a simple regex may be all you need:

```print \$_, "\n",
m[([12])(?:.{7}\1){3}]s ? 'matched' : 'failed'
for \$a, \$b, \$c, \$d;;

220021
000200
020222
020222
failed

100000
010000
001000
000100
matched

102000
010200
001020
000102
matched

102000
010200
001020
000201
failed

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

1. Do you mean that you are only interested in exactly 4 (not say 3) of '1's or '2's on a diagonal? Yes

2. Are you only interested in those on this \ diagonal and not this / one? Yes i need both diagonals

3. Will the input always be 6 x 4? not always, it will vary.

Please let me know for further assistance

Will the input always be 6 x 4? not always, it will vary.

Over what range?

Please let me know for further assistance

Thank you.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Re: match diagonal text
by Util (Priest) on Sep 22, 2011 at 15:14 UTC

I chose to generalize rather than optimize, and I think it lead to an improved solution.

Note that by reversing the lines, we can reuse the left-to-right algorithm to get the right-to-left diagonals. By also reversing the returned list, the line numbers are also made correct.

I first coded this to look for a complete diagonal of all 1 or 2, until I read the "~ 500x50" comment.

```#!perl
use strict;
use warnings;

while (<DATA>) {
chomp;
my @lines = map { [ split '' ] } split ' ';

my @diags_LR =         extract_diagonals(        @lines);
my @diags_RL = reverse extract_diagonals(reverse @lines);
#print "@diags_LR\n@diags_RL\n";

my @nums = map  { \$_ + 1 }
grep { wanted(\$diags_LR[\$_]) or wanted(\$diags_RL[\$_]) }
0 .. \$#diags_LR;
print "Diags found in lines: @nums\n  data:\$_\n" if @nums;

}

sub wanted {
my (\$diag) = @_;
#    return \$diag =~ m{ \A ([12]) \1+ \z }msx; # All 1's or all 2's
return \$diag =~ m{ 1111 | 2222 }msx; # Four 1's or 2's anywhere
}

sub extract_diagonals {
my @lines = @_;

my \$row_count    = scalar   @lines;
my \$column_count = scalar @{\$lines[0]};
die unless \$column_count > 1 and \$row_count > 1;

my \$diag_length = (\$row_count < \$column_count) ? \$row_count
: \$column_count;

my @diagonals;
for     my \$c ( 0 .. (\$column_count - \$diag_length) ) {
for my \$r ( 0 .. (\$row_count    - \$diag_length) ) {
my @diag_chars = map { \$lines[\$r+\$_][\$c+\$_] }
0 .. (\$diag_length-1);

push @diagonals, join( '', @diag_chars );
}
}
return @diagonals;
}

__DATA__
ABCDEFGH IJKLMNOP QRSTUVWX
ABCDEF GHIJKL MNOPQR STUVWX
ABC DEF GHI JKL MNO PQR STU VWX
ABCD EFGH IJKL MNOP QRST UVWX
ABCDE FGHIJ KLMNO PQRST UVWXY
220021 000200 020222 020222
100000 010000 001000 000100
102000 010200 001020 000102
102000 010200 001020 000201
Output:
```Diags found in lines: 1
data:100000 010000 001000 000100
Diags found in lines: 1 3
data:102000 010200 001020 000102

Create A New User
Node Status?
node history
Node Type: perlquestion [id://927285]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2018-10-19 23:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When I need money for a bigger acquisition, I usually ...

Results (111 votes). Check out past polls.

Notices?