Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

match diagonal text

by arivu198314 (Sexton)
on Sep 22, 2011 at 07:31 UTC ( #927285=perlquestion: print w/replies, xml ) 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.

      Thanks for your reply, please find my answers here

      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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://927285]
Approved by Corion
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (11)
As of 2018-07-19 13:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (408 votes). Check out past polls.

    Notices?