I'm a little dumbfounded that this much progress got made this quickly...wow.... I'll show sample output and then list source.

You bet. I think I'm going to get an extra physical game for myself.

I'm gonna need some time just to catch up to all this....

Fixed a bug allowing adding an 's' to existing word. Also tweaked some algorithms,

It now picks highest scoring move (instead of longest word). I think it now follows all the rules from the wikipedia page except the one about the "Qu" tile.

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11108138
use warnings;
use Path::Tiny;
use List::Util qw( shuffle uniq first );
$SIG{__WARN__} = sub { die @_ };

my $n = 10;            # configuration  board will be  $n by $n
my $maxtiles = 7;
my $dictionaryfile = '/usr/share/dict/words';
my $cachefilename = "words.11108138.$n"; # for caching subsets of dict
+ionary

my $n1 = $n + 1;
my $board = ('.' x $n . "\n") x $n;
my $heights = $board =~ tr/./0/r;
my @dictwords;
if( -f $cachefilename )
  {
  @dictwords = split /\n/, path($cachefilename)->slurp;
  }
else
  {
  print "caching words of max length $n\n";
  @dictwords = sort { length $b <=> length $a }
    grep /^[a-z]{2,$n}$/,
    split /\n/, path($dictionaryfile)->slurp;
  path($cachefilename)->spew(join "\n", @dictwords, '');
  }

my @drawpile = shuffle + #  thanks to GrandFather 11108145
  ('a') x 9, ('b') x 2, ('c') x 2, ('d') x 4, ('e') x 12, ('f') x 2,
  ('g') x 4, ('h') x 2, ('i') x 9, ('j') x 1, ('k') x 1, ('l') x 4, ('
+m') x 2,
  ('n') x 6, ('o') x 8, ('p') x 2, ('q') x 1, ('r') x 6, ('s') x 4, ('
+t') x 6,
  ('u') x 4, ('v') x 2, ('w') x 2, ('x') x 1, ('y') x 2, ('z') x 1 ;
my @tiles = sort splice @drawpile, 0, $maxtiles;
print "tiles: @tiles\n";
my $pat = join '', map "$_?", @tiles;

my $word = first
  { /^[@tiles]+$/ and (join '', sort split //) =~ /^$pat$/ } @dictword
+s;
$word or die "no starting word can be found\n";
substr $board, $n1 * ($n >> 1) + ($n - length($word) >> 1),
  length $word, $word;
substr $heights, $n1 * ($n >> 1) + ($n - length($word) >> 1),
  length $word, 1 x length $word;
my $tiles = join '', @tiles;
$tiles =~ s/$_// for split //, $word;
@tiles = split //, $tiles;
push @tiles, splice @drawpile, 0, $maxtiles - @tiles;
my @chosen = $word;
my $changed = 1;
my $moves = 0;
my $totalscore = 2 * length $word;
printboard();

while( @tiles )
  {
  $heights =~ tr/5// == $n ** 2 and last; # all 5, no more play possib
+le
  my @best; # [ flip, pos, pat, old, highs, word ]
  my @all = (@tiles, ' ', sort +uniq $board =~ /\w/g);
  $moves++;
  print "moves: $moves  tiles: @tiles\n";
  my @subdict = grep /^[@all]+$/, @dictwords;
  for my $flip ( 0, 1 )
    {
    my @pat;
    $board =~ /(?<!\w).{2,}(?!\w)(?{ push @pat, [ $-[0], $& ] })(*FAIL
+)/;
    @pat = map expand($_), @pat;
    @pat = sort { length $b->[1] <=> length $a->[1] } @pat;

    for ( @pat )
      {
      my ($pos, $pat) = @$_;
      my $old = substr $board, $pos, length $pat;
      my $highs = substr $heights, $pos, length $pat;
      my @under = $old =~ /\w/g;
      my $underpat = qr/[^@under@tiles]/;
      my @w = grep {
        length $pat == length $_
        && !/$underpat/
        && /^$pat$/
        && ( ($old ^ $_) !~ /^\0+\]$/ ) # adding just an 's' not allow
+ed
        && matchrule( $old, $highs, $_ )
        } @subdict;
      $best[ score($old, $highs, $_) ] //=
        [ $flip, $pos, $pat, $old, $highs, $_ ] for @w;
      }
    transpose();
    }
  if( $changed = @best )
    {
    my ($flip, $pos, $pat, $old, $highs, $word) = @{ $best[-1] };
    my $newmask = ($old ^ $word) =~ tr/\0/\xff/cr;
    $flip and transpose();
    substr $board, $pos, length $word, $word;
    substr $heights, $pos, length $highs,
      ($highs & $newmask) =~ tr/0-5/1-6/r | ($highs & ~$newmask);
    $flip and transpose();
    my $tiles = join '', @tiles;
    $tiles =~ s/$_// for split //, $word & $newmask;
    @tiles = split //, $tiles;
    $totalscore += my $score = score( $old, $highs, $word );
    print '-' x 20, "chosen: $flip $pos $word   score: $score\n";
    push @chosen, $word;
    }
  else
    {
    my $tiles = join '', @tiles; # discard random tile
    $tiles =~ s/$_// and last for 'q', 'z', $tiles[rand @tiles];
    @tiles = split //, $tiles;
    }
  @tiles = sort @tiles, splice @drawpile, 0, $maxtiles - @tiles;
  $changed and printboard();
  }
print "\nchosen words: @chosen\ntotalscore: $totalscore\n";

sub score
  {
  my ($old, $highs, $word) = @_;
  my $score = ($old ^ $word) =~ tr/\0//c == $maxtiles ? 20 : 0;
  $score += chop($highs) + (chop($old) ne $_) for reverse split //, $w
+ord;
  $score == length $word and $score *= 2; # no stacked letters
  return $score;
  }

sub printboard
  {
  my $bd = $board =~ tr/\n/-/r;
  $bd =~ s/-/   $_/ for $heights =~ /.*\n/g;
  print $bd;
  }

sub matchrule
  {
  my ($old, $highs, $word) = @_;
  $old eq $word and return 0;
  my $newmask = ($old ^ $word) =~ tr/\0/\xff/cr;
  ($newmask & $highs) =~ tr/5// and return 0;
  my $tiles = "@tiles";
  $tiles =~ s/$_// or return 0 for ($newmask & $word) =~ /\w/g;
  return 1;
  }

sub transpose # both board and heights arrays
  {
  local $_ = $board;
  $board = '';
  $board .= "\n" while s/^./ $board .= $& ; '' /gem;
  $_ = $heights;
  $heights = '';
  $heights .= "\n" while s/^./ $heights .= $& ; '' /gem;
  }

sub expand # change patterns with several letters to several single le
+tter pats
  {
  my @ans;
  my ($pos, $pat) = @{ shift() };
  push @ans, [ $pos, $` =~ tr//./cr . $& . $' =~ tr//./cr ]
    while $pat =~ /\w/g;
  return @ans;
  }
[download]

Hrm, some of the words in the list look a bit funny/repeated?

--------------------chosen: 1 71 rove   score: 8
....du....   0000120000
..s.en....   0010120000
mantal....   4134550000
antimodel.   2212551210
..r.at....   0010150000
..unttrrid   0033451511
..p.ueo...   0010231000
..i.rdv...   0010121000
..clever..   0011111100
..........   0000000000
moves: 28  tiles: q

chosen words: achira satrap benign watered satrapic ailuro injury untu
+rgid untorrid isozooid unhoaxed defeater unhooted unpitted unpotted d
+efeature antibody unlotted defeature wakeel defeature gantsl clever a
+ntimodel santal mangal mantal rove
totalscore: 544
[download]

?


The way forward always starts with a minimal test.

I found and fixed a bug in tile handling, and also removed the option to play normal scrabble (it was adding too much noise). Also cleaned up some parts, including a major streamlining to 'matchrule'.

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11108138
use warnings;
use Path::Tiny;
use List::Util qw( shuffle uniq first );
$SIG{__WARN__} = sub { die @_ };

my $n = 10;            # configuration  board will be  $n by $n
my $maxtiles = 7;

my $n1 = $n + 1;
my $board = ('.' x $n . "\n") x $n;
my $heights = $board =~ tr/./0/r;
my @dictwords;
my $filename = "words.11108138.$n"; # for caching
if( -f $filename )
  {
  @dictwords = split /\n/, path($filename)->slurp;
  }
else
  {
  print "caching words of length $n\n";
  @dictwords = sort { length $b <=> length $a }
    grep /^[a-z]{2,$n}$/,
    split /\n/, path('/usr/share/dict/words')->slurp;
  path($filename)->spew(join "\n", @dictwords, '');
  }

my @drawpile = shuffle + #  thanks to GrandFather 11108145
  ('a') x 9, ('b') x 2, ('c') x 2, ('d') x 4, ('e') x 12, ('f') x 2,
  ('g') x 4, ('h') x 2, ('i') x 9, ('j') x 1, ('k') x 1, ('l') x 4, ('
+m') x 2,
  ('n') x 6, ('o') x 8, ('p') x 2, ('q') x 1, ('r') x 6, ('s') x 4, ('
+t') x 6,
  ('u') x 4, ('v') x 2, ('w') x 2, ('x') x 1, ('y') x 2, ('z') x 1 ;
my @tiles = sort splice @drawpile, 0, $maxtiles;
print "tiles: @tiles\n";
my $pat = join '', map "$_?", @tiles;

my $word = first
  { /^[@tiles]+$/ and (join '', sort split //) =~ /^$pat$/ } @dictword
+s;
$word or die "no starting word can be found\n";
substr $board, $n1 * ($n >> 1) + ($n - length($word) >> 1),
  length $word, $word;
substr $heights, $n1 * ($n >> 1) + ($n - length($word) >> 1),
  length $word, 1 x length $word;
my @chosen = $word;
my $changed = 1;
my $moves = 0;
my $totalscore = 2 * length $word;
printboard();

while( @tiles )
  {
  $heights =~ tr/5// == $n ** 2 and last; # all 5, no more play possib
+le
  my @best; # [ flip, pos, pat, old, highs, word ]
  my @all = (@tiles, ' ', sort +uniq $board =~ /\w/g);
  $moves++;
  print "moves: $moves  tiles: @tiles\n";
  my @subdict = grep /^[@all]+$/, @dictwords;
  for my $flip ( 0, 1 )
    {
    my $inorder = join '', map "$_?", sort "@all" =~ /\w/g;
    my $orderpat = qr/^$inorder$/;

    my @pat;
    $board =~ /(?<!\w).{2,}(?!\w)(?{ push @pat, [ $-[0], $& ] })(*FAIL
+)/;
    @pat = map expand($_), @pat;
    @pat = sort { length $b->[1] <=> length $a->[1] } @pat;

    for ( @pat )
      {
      my ($pos, $pat) = @$_;
      my $old = substr $board, $pos, length $pat;
      my $highs = substr $heights, $pos, length $pat;
      my @under = $old =~ /\w/g;
      my $underpat = qr/[^@under@tiles]/;
      my $w = first {
        length $pat == length $_
        && !/$underpat/
        && /^$pat$/
        && ( /s$/ ? $pat ne s/s$/./r : 1 )
        && matchrule( $old, $highs, $_ )
        } @subdict;
      $w and $best[ length $w ] //=
        [ $flip, $pos, $pat, $old, $highs, $w ], last;
      }
    transpose();
    }
  if( $changed = @best )
    {
    my ($flip, $pos, $pat, $old, $highs, $word) = @{ $best[-1] };
    $flip and transpose();
    my $usedtiles = '';
    $usedtiles = $word;
    my $same = $word ^ substr $board, $pos, length $word;
    my $tmppos = $pos;
    for ( split //, $same )
      {
      if( $_ ne "\0" )
        {
        substr( $heights, $tmppos, 1 ) =~ tr/0-4/1-5/; # new tile, add
+ 1
        }
      else
        {
        $usedtiles =~ s/$_// for substr $board, $tmppos, 1;
        }
      $tmppos++;
      }
    substr $board, $pos, length $word, $word;
    $totalscore += my $score = score( $old, $highs, $word );
    print '-' x 20, "chosen: $flip $pos $word   score: $score\n";
    push @chosen, $word;
    $flip and transpose();
    my $tiles = join '', @tiles;
    $tiles =~ s/$_// for split //, $usedtiles;
    @tiles = split //, $tiles;
    }
  else
    {
    splice @tiles, rand @tiles, 1; # discard random tile
    }
  @tiles = sort @tiles, splice @drawpile, 0, $maxtiles - @tiles;
  $changed and printboard();
  }
print "\nchosen words: @chosen\ntotalscore: $totalscore\n";

sub score
  {
  my ($old, $high, $word) = @_;
  my $score = ($old ^ $word) =~ tr/\0//c == $maxtiles ? 20 : 0;
  $score += chop($high) + (chop($old) ne $_) for reverse split //, $wo
+rd;
  $score == length $word and $score *= 2; # no stacked letters
  return $score;
  }

sub printboard
  {
  my $bd = $board =~ tr/\n/-/r;
  $bd =~ s/-/   $_/ for $heights =~ /.*\n/g;
  print $bd;
  }

sub matchrule
  {
  my ($old, $highs, $word) = @_;
  $old eq $word and return 0;
  my $newmask = ($old ^ $word) =~ tr/\0/\xff/cr;
  ($newmask & $highs) =~ tr/5// and return 0;
  my $tiles = "@tiles";
  $tiles =~ s/$_// or return 0 for ($newmask & $word) =~ /\w/g;
  return 1;
  }

sub transpose # both board and heights arrays
  {
  local $_ = $board;
  $board = '';
  $board .= "\n" while s/^./ $board .= $& ; '' /gem;
  $_ = $heights;
  $heights = '';
  $heights .= "\n" while s/^./ $heights .= $& ; '' /gem;
  }

sub expand # change patterns with several letters to several single le
+tter pats
  {
  my @ans;
  my ($pos, $pat) = @{ shift() };
  push @ans, [ $pos, $` =~ tr//./cr . $& . $' =~ tr//./cr ]
    while $pat =~ /\w/g;
  return @ans;
  }
[download]