examples/matrix-p5.pl

   1 #!/usr/bin/perl -w
   2
   3 use List::Util <sum>;
   4 use strict;
   5
   6 print "5x5 matrix in one line: " unless @ARGV;
   7 my $matrix = shift || <>;
   8 chomp $matrix;
   9 $matrix ||= "abcdefghijklmnopqrstuvwxy";
  10 my @matrix = [ ('_') x 7 ];
  11 push @matrix, [ '_', (split //, substr $matrix, 0, 5, ''), '_' ] while $matrix;
  12 push @matrix, [ ('_') x 7 ];
  13
  14 my @adj;
  15
  16 for my $y (1..5) {
  17     for my $x (1..5) {
  18         for my $dx (-1..1) {
  19             for my $dy (-1..1) {
  20                 $dy or $dx or next;
  21                 $matrix[$y + $dy][$x + $dx] eq '_' and next;
  22                 push @{ $adj[$y][$x] }, { y => $y + $dy, x => $x + $dx };
  23             }
  24         }
  25     }
  26 }
  27
  28 sub build_re {
  29     my ($y, $x, $todo, $had) = @_;
  30     my $r = $matrix[$y][$x] or die "y=$y,x=$x is empty (@_)";
  31     --$todo or return $r;
  32     my %had = $had ? %$had : ("$y/$x" => 1);  # copy
  33
  34     my @next = map {
  35         $had{"$_->{y}/$_->{x}"}++
  36             ? ()
  37             : build_re($_->{y}, $_->{x}, $todo, \%had)
  38     } @{ $adj[$y][$x] };
  39
  40     @next or return $r;
  41
  42     return $todo == 1
  43         ? $r . (@next == 1 ? "@next?" : '[' . join('', @next) . ']?')
  44         : $r . '(?:' . join('|', @next) . ')' . ($todo < 4 ? '?' : '');
  45 }
  46
  47 my @re;
  48
  49 for my $y (1..5) {
  50     for my $x (1..5) {
  51         push @re, build_re $y, $x, 6;
  52     }
  53 }
  54
  55 my $re = join '|', @re;
  56 $re = "^(?:$re)\\z";  # Don't compile yet - once is enough
  57
  58 my %scores = (
  59   a => 1, b => 3, c => 3, d => 2, e => 1, f => 4, g => 2, h => 4, i => 1,
  60   j => 8, k => 5, l => 1, m => 3, n => 1, o => 1, p => 3, q =>10, r => 1,
  61   s => 1, t => 1, u => 1, v => 4, w => 4, x => 8, y => 4, z =>10
  62 );
  63 $_ *= 10 for values %scores;
  64
  65 my @matches;
  66 open my $fh, '/usr/share/dict/american-english' or die $!;
  67
  68 substr(join('', @{ $matrix[1] }), 1, 5) =~ /$re/ or die;  # Precompile
  69 while (<$fh>) {
  70     $_ .= chomp;
  71     next if tr/a-z//c;  # Regex would destroy the compiled one
  72     // and push @matches, [ $_, sum map $scores{$_}, split // ];
  73         # Re-use precompiled regex
  74 }
  75
  76 my @sorted = sort {
  77     $b->[1] <=> $a->[1]                   # high score .. low score
  78     || length $a->[0] <=> length $b->[0]  # short .. long
  79     || $a->[0] cmp $b->[1]                # a .. z
  80 } @matches;
  81
  82 printf "MATRIX IS WORTH %d POINTS\n", sum map $_->[1], @sorted;
  83 printf "%3d %s\n", $_->[1], $_->[0] for @sorted;
  84