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";
    }
}
[download]

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 >
[download]

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,

Form a multiline string and play with the $gap.

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1207332

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

$_ = join '', map join('', @$_) . "\n", @grid; # convert to string
print;

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

sub recognize
  {
  my %args = @_;
  my ( $direction, $min) = @args{ qw( pattern min ) };
  $min // die "min not defined";
  my $reps = $min - 1;
  my $linesize = /\n/ && $+[0];
  my $gapref = { horizontal => [0], vertical => [$linesize - 1],
    diagonal => [$linesize - 2, $linesize]}->{$direction} //
    die "invalid direction $direction";

  for my $gap ( @$gapref )
    {
    print "\n";
    print "$direction @{[ 1 + length($2) / ($gap + 1) ]} '$1' at ",
      $-[1] % $linesize, ' ', int $-[1] / $linesize, "\n"
      while /(\w)(?=((?:.{$gap}\1){$reps,}))/gs;
    }
  }
[download]

Outputs:

aabac
aaacf
afc1b
awxcz
aqqqc

horizontal 3 'a' at 0 1
horizontal 3 'q' at 1 4

vertical 5 'a' at 0 0

diagonal 2 'a' at 1 0
diagonal 2 'a' at 3 0
diagonal 3 'c' at 4 0
diagonal 2 'a' at 1 1
diagonal 2 'c' at 3 1

diagonal 2 'a' at 0 0
diagonal 2 'a' at 1 0
diagonal 3 'c' at 2 2
diagonal 2 'c' at 3 3
[download]

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);
[download]

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
[download]