Hello Monks,
The world turns for word gamers, and my needs have evolved as physical meetings with my usual partners are deemed too risky on covid grounds. So now we're gonna see if we can send each other moves. I have to find a way to represent it so that she can see it on her windows machine, but we'll deal with that when we get there. I'm developing on ubuntu, because doing so on windows makes me lose my mind. My machine is dual boot with windows 10/strawberry perl in case we need to test on the platform of our friends from Redmond. We've gotten some pretty good results for 3 bites of this apple,
and that while the logic was shifting hugely. What I'm presenting here today will have a different logic yet than what went before. Specifically, I did not know what to do about the game's 'qu' tile. The remedy is that I just changed the dictionary, and the 'qu' tile plays as if it were then just the one letter 'q':
s/qu/q/g for @dictwords;There's only one 'q' in this game, so words with 2 of them are simply unattainable.
$ cd my_data/ $ ls 1.english.txt upwords.10 $ grep '\(.*q\)\{2\}' 1.english.txt equivoque equivoques quinquennia quinquennial quinquennially quinquennials quinquennium quinquenniums $ grep '\(.*q\)\{2\}' upwords.10 eqivoqe eqivoqes qinqennia qinqennial qinqennium $
We also see that our reduced lexicon is indeed smaller:
$ wc -l * 172819 1.english.txt 125817 upwords.10 298636 total $
I could write a line of code to zap these words out of the dictionary, but 5 words that will not match is not a great hindrance in this scheme. Without further ado, let me post output, source, and then questions.
$ ./7.word.pl abs is /home/hogan/Documents/hogan/7.word.pl path1 is /home/hogan/Documents/hogan path2 is /home/hogan/Documents/hogan/upwords This script will build the above path2. Proceed? (y|n)y pattern is a?a?c?d?r?s?t? in main aa aas act acta acts ad ads ar arc arcs ars art arts as at cad + cads car carat carats card cards cars cart carts casa cast cat cats +dart darts data drat drats rad rads ras rat rats sac sacra sad sard s +at scad scar scart scat star ta tad tads tar tars tas trad tsar woohoo ======= with underpat unchanged fxxxxexx with underpat changed fxxxxxxx
Source:
#!/usr/bin/perl use strict; use warnings; use Path::Tiny; use Data::Dump; use 5.016; # ## paths and constraints my $abs = path(__FILE__)->absolute; my $path1 = Path::Tiny->cwd; my $games = "upwords"; my $path2 = path( $path1, $games ); say "abs is $abs"; say "path1 is $path1"; say "path2 is $path2"; print "This script will build the above path2. Proceed? (y|n)"; my $prompt = <STDIN>; chomp $prompt; die unless ( $prompt eq "y" ); my $maxtiles = 10; my $cachefilename = path( "my_data", "upwords.$maxtiles" ); my $download_file = '/home/hogan/Documents/hogan/my_data/1.english.txt +'; unless ( -s $cachefilename && -s $download_file ) { use LWP::Simple; my $url = 'https://storage.googleapis.com/google-code-archive-downloads/v2/code. +google.com/dotnetperls-controls/enable1.txt'; say "execution was here"; getstore( $url, $download_file ); } ## substitute q for qu my $dictionaryfile = path($download_file); my @dictwords; if ( -s $cachefilename ) { @dictwords = path($cachefilename)->lines( { chomp => 1 } ); } unless ( -s $cachefilename ) { print "sub q for qu"; @dictwords = path($dictionaryfile)->lines( { chomp => 1 } ); s/qu/q/g for @dictwords; # some words shortened # cache the ones of maxtiles length @dictwords = grep( /^[a-z]{2,$maxtiles}\z/, @dictwords ); $cachefilename->spew( join "\n", @dictwords, '' ); } my $refDict = \@dictwords; #dd $refDict; ### make a "sample hand" my @tiles = qw( a a d r t s c ); my $string = 'f e'; my @matches = matches( $refDict, @tiles ); say "in main @matches"; say " woohoo ======="; my @matches1 = extensions1( $refDict, @tiles, $string ); say "with underpat unchanged @matches1"; my @matches2 = extensions2( $refDict, @tiles, $string ); say "with underpat changed @matches2"; sub matches { my ( $refDict, @tiles ) = @_; my @dict = @$refDict; my @matches; my $pattern = join '', map "$_?", sort @tiles; say "pattern is $pattern"; for my $word (@dict) { if ( join( '', sort split //, $word ) =~ /^$pattern$/ ) { push @matches, $word; } } return @matches; } sub extensions1 { my ( $refDict, @tiles, $understring ) = @_; my @dict = @$refDict; my @extensions; $understring = 'fxxxxexx'; push( @extensions, $understring ); return @extensions; } sub extensions2 { my ( $refDict, @tiles, $understring ) = @_; my @dict = @$refDict; my @extensions; $understring = 'fxxxxxxx'; push( @extensions, $understring ); return @extensions; }
The first subroutine works and might be thought of as having no underpattern. What I want for the logic on the second sub, extensions1, is all words one can form by adjoining tiles to the underpattern without changing the underpattern at all. Then for extensions2, I want words that can be formed whilst maintaining at least one letter of the underpattern.
We've looked at similar situations in the threads that have gone before, in particular with the prolific tybalt89's responses. We had the board involved previously, and it was a much more entangled situation, as a 3-d version of scrabble must be. The truth is that even after months of trying, I cannot penetrate every line of his scripts, so I'm hoping that dropping the board out of it allows me to understand what's going on.
Simple question here: how does one flesh out the logic of these extensions to do as described above?
Thanks for your comment,
In reply to Upwords IV: creating words with underpatterns by Aldebaran
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |