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
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |