$ 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; }