$ 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
$
####
$ wc -l *
172819 1.english.txt
125817 upwords.10
298636 total
$
####
$ ./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 sat scad scar scart scat star ta tad tads tar tars tas trad tsar
woohoo =======
with underpat unchanged fxxxxexx
with underpat changed fxxxxxxx
####
#!/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 = ;
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;
}