Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
85 lines (67 sloc) 2.24 KB
#!/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;