root/examples/matrix-p5.pl

#!/usr/bin/perl -w

use List::Util <sum>;
use strict;

print "5x5 matrix in one line: " unless @ARGV;
my $matrix = shift || <>;
chomp $matrix;
$matrix ||= "abcdefghijklmnopqrstuvwxy";
my @matrix = [ ('_') x 7 ];
push @matrix, [ '_', (split //, substr $matrix, 0, 5, ''), '_' ] while $matrix;
push @matrix, [ ('_') x 7 ];

my @adj;

for my $y (1..5) {
    for my $x (1..5) {
        for my $dx (-1..1) {
            for my $dy (-1..1) {
                $dy or $dx or next;
                $matrix[$y + $dy][$x + $dx] eq '_' and next;
                push @{ $adj[$y][$x] }, { y => $y + $dy, x => $x + $dx };
            }
        }
    }
}

sub build_re {
    my ($y, $x, $todo, $had) = @_;
    my $r = $matrix[$y][$x] or die "y=$y,x=$x is empty (@_)";
    --$todo or return $r;
    my %had = $had ? %$had : ("$y/$x" => 1);  # copy
    
    my @next = map {
        $had{"$_->{y}/$_->{x}"}++ 
            ? () 
            : build_re($_->{y}, $_->{x}, $todo, \%had)
    } @{ $adj[$y][$x] };

    @next or return $r;

    return $todo == 1
        ? $r . (@next == 1 ? "@next?" : '[' . join('', @next) . ']?')
        : $r . '(?:' . join('|', @next) . ')' . ($todo < 4 ? '?' : '');
}

my @re;

for my $y (1..5) {
    for my $x (1..5) {
        push @re, build_re $y, $x, 6;
    }
}

my $re = join '|', @re;
$re = "^(?:$re)\\z";  # Don't compile yet - once is enough

my %scores = (
  a => 1, b => 3, c => 3, d => 2, e => 1, f => 4, g => 2, h => 4, i => 1, 
  j => 8, k => 5, l => 1, m => 3, n => 1, o => 1, p => 3, q =>10, r => 1, 
  s => 1, t => 1, u => 1, v => 4, w => 4, x => 8, y => 4, z =>10
);
$_ *= 10 for values %scores;

my @matches;
open my $fh, '/usr/share/dict/american-english' or die $!;

substr(join('', @{ $matrix[1] }), 1, 5) =~ /$re/ or die;  # Precompile
while (<$fh>) {
    $_ .= chomp;
    next if tr/a-z//c;  # Regex would destroy the compiled one
    // and push @matches, [ $_, sum map $scores{$_}, split // ];
        # Re-use precompiled regex
}

my @sorted = sort { 
    $b->[1] <=> $a->[1]                   # high score .. low score
    || length $a->[0] <=> length $b->[0]  # short .. long
    || $a->[0] cmp $b->[1]                # a .. z
} @matches;

printf "MATRIX IS WORTH %d POINTS\n", sum map $_->[1], @sorted;
printf "%3d %s\n", $_->[1], $_->[0] for @sorted;