Here's some (incomplete) code that (sort of) plays upwords. What's missing is any scoring or score keeping.

I use a simple string for the board, and another string for the height of each cell.
Example board and example heights:

.......... 0000000000 .......c.. 0000000200 .lauze.o.. 0211110100 .e.....a.. 0100000100 .g.....r.. 0200000100 baronies.. 1533553100 .t.....e.. 0200000100 .e.....r.. 0100000200 .......... 0000000000 .......... 0000000000

Using a string enables me to "fairly" easily find all the locations where a new word could go using a regex.
Since words can be either left-right or top-down I go through the core of finding words twice, once normally, and the second time with the those two strings transposed(flipped around the major axis) to get the best (longest) word to play.

Other than scoring, I think I've got most of the rules followed correctly.
The program continues to play until it runs out of tiles, or (if you play smaller versions, like 4x4) the height string is all 5's.

#!/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; my $maxtiles = 7; my $upwords = 1; # 0 => extending(normal scrabble?) 1 => upwords 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 { @dictwords = sort { length $b <=> length $a } grep /^[a-z]{2,$n}$/, path('/usr/share/dict/words')->lines({chomp => 1}); path($filename)->spew(map "$_\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; substr $board, $n1 * ($n >> 1) + ($n - length($word) >> 1), length $word, $word; substr $heights, $n1 * ($n >> 1) + ($n - length($word) >> 1), length $word, ($upwords ? 1 : 5) x length $word; my @chosen = $word; my $changed = 1; my $moves = 0; my $b = $board =~ tr/\n/-/r; $b =~ s/-/ $_/ for $heights =~ /.*\n/g; print $b; while( @tiles ) { $upwords or $board =~ /\./ or last; $upwords && $heights =~ tr/0-4// == 0 and last; my @best; # [ flip, pos, pat, 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, [ $flip, $-[0], $& ] })(*FAIL)/; $upwords and @pat = map expand($_), @pat; @pat = grep $_->[2] =~ /\w/, @pat; $upwords or @pat = grep { substr( $board, $_->[1], length $_->[2]) =~ /\./ } + @pat; for my $p ( @pat ) { my ($flip, $pos, $pat) = @$p; my @under = substr( $board, $pos, length $pat) =~ /\w/g; my $w = first { /^[@under@tiles]+$/ && /^$pat$/ && (join '', sort /\w/g ) =~ /$orderpat/ && ( /s$/ ? $pat ne s/s$/./r : 1 ) && ( $upwords ? matchrule( $pos, $_ ) : 1 ) } @subdict; $w and $best[ length $w ] //= [ $flip, $pos, $pat, $w ]; } transpose(); } if( $changed = @best ) { my ($flip, $pos, $pat, $word) = @{ $best[-1] }; $flip and transpose(); if( $upwords ) { my $same = $word ^ substr $board, $pos, length $word; my $tmppos = $pos; substr( $heights, $tmppos++, 1 ) += $_ ne "\0" for split //, $sa +me; } else { substr($heights, $pos, length $word) =~ tr/0/5/; } substr $board, $pos, length $word, $word; print '-' x 20, "chosen: $flip $pos $word\n"; push @chosen, $word; $flip and transpose(); my $tmpword = $word; $tmpword =~ s/$_// for $pat =~ /\w/g; my $tiles = join '', @tiles; $tiles =~ s/$_// for split //, $tmpword; @tiles = split //, $tiles; } else { splice @tiles, rand @tiles, 1; # discard random tile } @tiles = sort @tiles, splice @drawpile, 0, $maxtiles - @tiles; if( $changed ) { my $b = $board =~ tr/\n/-/r; $b =~ s/-/ $_/ for $heights =~ /.*\n/g; print $b; } } print "\nchosen words: @chosen\n"; sub matchrule { my ($pos, $word) = @_; my $tiles = join '', @tiles; my $bd = substr $board, $pos, length $word; my $count = substr $heights, $pos, length $word; $bd eq $word and return 0; for ( reverse split //, $word ) { my $bchar = chop $bd; my $stack = chop $count; $_ eq $bchar and next; $stack >= 5 and return 0; $tiles =~ s/$_// or return 0; } return 1; } sub transpose { local $_ = $board; $board = ''; $board .= "\n" while s/^./ $board .= $& ; '' /gem; local $_ = $heights; $heights = ''; $heights .= "\n" while s/^./ $heights .= $& ; '' /gem; } sub expand { my @ans; my ($flip, $pos, $pat) = @{ shift() }; push @ans, [ $flip, $pos, $` =~ tr//./cr . $& . $' =~ tr//./cr ] while $pat =~ /\w/g; return @ans; }

And here's a sample partial output:

moves: 9 tiles: c g j l n q x --------------------chosen: 1 78 coarsen .......... 0000000000 .......c.. 0000000200 .gauze.o.. 0111110100 .e.....a.. 0100000100 .l.....r.. 0100000100 baronies.. 1533553100 .d.....e.. 0100000100 .......n.. 0000000100 .......... 0000000000 .......... 0000000000 moves: 10 tiles: g j l q r t x --------------------chosen: 1 78 coarser .......... 0000000000 .......c.. 0000000200 .gauze.o.. 0111110100 .e.....a.. 0100000100 .l.....r.. 0100000100 baronies.. 1533553100 .d.....e.. 0100000100 .......r.. 0000000200 .......... 0000000000 .......... 0000000000 moves: 11 tiles: e g j l q t x --------------------chosen: 1 13 legate .......... 0000000000 .......c.. 0000000200 .lauze.o.. 0211110100 .e.....a.. 0100000100 .g.....r.. 0200000100 baronies.. 1533553100 .t.....e.. 0200000100 .e.....r.. 0100000200 .......... 0000000000 .......... 0000000000

Lots of little interesting problems in this game. It was fun, thanks.


In reply to Re: Inputing vectors into a scrabble-esque game by tybalt89
in thread Inputing vectors into a scrabble-esque game by Aldebaran

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.