Re: Recognizing pattern in 2D grid

[Athanasius]

Hello pwagyi,

I think an array of arrays (AoA) is a better data structure for this task than a hash of hashes (HoH). And if each datum is only a single character, as in the example given, you can use regular expressions to do the searching. The following script lacks proper error checking, etc., but should give you an idea of how to proceed:

use strict;
use warnings;

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 q q c ) ],
);

recognize( pattern => 'horizontal', min => 3 );
recognize( pattern => 'vertical',   min => 5 );
recognize( pattern => 'diagonal',   min => 2 );

sub recognize
{
    my %config  = @_;
    my $pattern = $config{pattern} // 'horizontal';
    my $min     = $config{min}     //  3;
    my $reps    = $min - 1;

    if    ($pattern eq 'horizontal')
    {
        for my $row (0 .. $#grid)
        {
            my $string;
               $string .= $_ for $grid[$row]->@*;

            print "Found $pattern pattern '$&' in row $row\n"
                while $string =~ /(.)\1{$reps,}/g;
        }
    }
    elsif ($pattern eq 'vertical')
    {
        for my $col (0 .. $#{ $grid[0] })
        {
            my $string;
               $string .= $_->[$col] for @grid;

            print "Found $pattern pattern '$&' in column $col\n"
                while $string =~ /(.)\1{$reps,}/g;
        }
    }
    elsif ($pattern eq 'diagonal')
    {
        my $string;
           $string .= $grid[$_][$_] for 0 .. $#grid;

        print "Found $pattern pattern '$&' in left-right diagonal\n"
            while $string =~ /(.)\1{$reps,}/g;

        my $col = $#grid;
        $string = '';

        for my $row (0 .. $#grid)
        {
            $string .= $grid[$row][$col--];
        }

        print "Found $pattern pattern '$&' in right-left diagonal\n"
            while $string =~ /(.)\1{$reps,}/g;
    }
    else
    {
        die "Unknown pattern '$pattern', stopped";
    }
}

Output:

13:48 >perl 1862_SoPW.pl
Found horizontal pattern 'aaa' in row 1
Found horizontal pattern 'qqq' in row 4
Found vertical pattern 'aaaaa' in column 0
Found diagonal pattern 'aa' in left-right diagonal
Found diagonal pattern 'ccc' in left-right diagonal
Found diagonal pattern 'ccc' in right-left diagonal

13:57 >

Update: It occurs to me, belatedly, that a “diagonal” pattern might mean a sequence on any diagonal, and not just one of the two major diagonals, as I naïvely assumed. Extending the code to allow for matches on any diagonal is hereby left as the proverbial exercise for the reader. :-)

Hope that helps,