use strict; use warnings; use Data::Dumper; # Word Master quick hack on 5/18/2021 # en-US.dic is a flat file of sorted words (about 150K words) open (my $fh, '<', 'en-US.dic') or die "can't find dictionary file: en-US.dic"; my @dic = map{chomp; $_}grep {!/'/ and !/[A-Z]/}<$fh>; #no apostrophes allowed #no proper nouns Rome (capital letters) $0 =~ m!(\\|/)([\w.]+)\s*$!; print "Word Master ($2)\n"; #like wm.pl this allows renaming the program print "# Enter list of letters by using semicolon followed by the letters\n"; print "# example>:omdee\n"; print "# in pattern, use simple dash for single unknown letters\n"; print "# m-de would match \"mode\"\n"; print "# quit|exit|q to exit program\n"; print "\n"; my $line; my %master_letter_freq; my $master_letter_list =""; #could be repeated letters like ee,tt,etc while ( (print "list of letters or pattern: "),$line=<>, $line !~ /\s*quit|exit|q\s*$/i) { next unless $line =~ /\S/; #skip blank lines chomp $line; my $cur_pattern; if ($line =~ /^\s*:([a-zA-Z]+)\s*$/) # new list of letters { $master_letter_list = lc $1; ## Force all letter lists to LOWER CASE only for (split //,$master_letter_list) { $master_letter_freq{$_}++; } print "master_letter_freq:\n"; print Dumper \%master_letter_freq; ##################### } elsif ($line =~ /^\s*([a-zA-Z-]+)\s*$/) #no leading ":", this is a pattern { $cur_pattern = lc $1; # Force all patters to LOWER CASE only if ($master_letter_list eq "") { print "No master letter list exists -> can't run this pattern! Error!\n"; next; } my $regex = ''; for (split //, $cur_pattern) # gen regex { if ($_ ne '-' and !exists $master_letter_freq{$_}) { print "Pattern has a letter that's not in master list! Error!\n"; next; } if ($_ eq '-') {$regex .= "[$master_letter_list]";} else {$regex .= "$_";} } my @result = grep{/^$regex$/i}@dic; # filter out any result if the number of times a # letter is repeated is more than the number of times it is # repeated in the master letter list # RESULT: foreach (@result) { my %seen; $seen{$_}++ for (split //,lc $_); # print "Testing Result $_, seen histogram is:\n"; # print Dumper \%seen; foreach (keys %seen) { next RESULT if ($seen{$_} > $master_letter_freq{$_}); } print "$_\n"; } } else { print "Illegal input line!\n"; } } __END__ Copied from Command Line - shows difference on different runs list of letters or pattern: :otrwreh list of letters or pattern: --r-w threw throw list of letters or pattern: ---w thew trow whew list of letters or pattern: list of letters or pattern: :otrwreh list of letters or pattern: --r-w threw throw list of letters or pattern: ---w thew trow whew list of letters or pattern: q list of letters or pattern: :otrwreh master_letter_freq: $VAR1 = { 'w' => 1, 'h' => 1, 't' => 1, 'o' => 1, 'r' => 2, 'e' => 1 }; list of letters or pattern: ---w thew trow list of letters or pattern