Created
December 29, 2019 01:04
-
-
Save JohnMertz/3e9f3371748069078e6ffe5faac8bcb9 to your computer and use it in GitHub Desktop.
Wordscape - Anagram word search assistant
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
# Program to find all words from a given pool of letters. Written to solve the | |
# Android puzzle game "Wordscape". | |
use strict; | |
use warnings; | |
# Default Debian ispell dictionary | |
my $dict = "/etc/dictionaries-common/words"; | |
# Evaluate arguments. | |
our $min; | |
my $letters = ''; | |
foreach (@ARGV) { | |
# If a minimum length is provided and not already defined, assign it. | |
if ($_ =~ m/^-m=\d+$/ && !defined $min) { | |
$min = $_; | |
$min =~ s/-m=(\d+)/$1/; | |
# Otherwise all letters get appended. | |
} elsif ($_ =~ m/^[a-z]+$/) { | |
$letters .= $_; | |
# Non-alphabetical characters throw error. | |
} else { | |
print "Invalid argument: $_\n"; | |
usage(); | |
} | |
} | |
# If a minimum length is not provided, set to 1 | |
if (!defined $min) { | |
$min = 1; | |
} | |
# Die if no letters were provided | |
unless ($letters) { | |
print "No input letters to evaluate\n"; | |
usage(); | |
} | |
# Die if fewer letters than required | |
if ($min > (length $letters)) { | |
print "Fewer letters of input than the minimum word length\n"; | |
usage(); | |
} | |
# Push all letters into an array | |
my @l; | |
for (my $i = 0; $i < (length $letters); $i++) { | |
push @l, (substr $letters, $i, 1); | |
} | |
# Pull entire dictionary into memory | |
open my $fh, '<', $dict; | |
my @words; | |
while (<$fh>) { | |
push @words, $_; | |
} | |
close $fh; | |
# Search pattern for all letters that CAN appear | |
our @unique; | |
my $possible = '[' . $letters . ']'; | |
# Search pattern for all letters that CANNOT appear | |
my $impossible = '['; | |
foreach my $alpha ('a' .. 'z') { | |
my $skip = 0; | |
foreach my $used (@l) { | |
if ($alpha eq $used) { | |
$skip++; | |
last; | |
} | |
} | |
unless ($skip) { | |
$impossible .= $alpha; | |
} | |
} | |
$impossible .= ']'; | |
# Create empty nested arrays for valid words of all available lengths | |
our @keepers; | |
foreach (my $i = $min; $i <= (length $letters); $i++) { | |
@keepers[$i] = (); | |
} | |
# Eliminate words that cannot match, add others to appropriate length array | |
# Searching a truncated list of just the right length words drastically improves | |
# efficiency | |
foreach (@words) { | |
chomp $_; | |
if ($_ =~ m/$possible/i && !($_ =~ m/$impossible/i)) { | |
push @{$keepers[(length $_)]}, $_; | |
} | |
} | |
undef @words; | |
our @found; # Global array for good matches | |
# Pass initial blank string and all available letters to recursive algorithm | |
recursive_search('',@l); | |
# Print all results | |
foreach (@found) { | |
print $_ . "\n"; | |
} | |
sub recursive_search { | |
my ($pattern, @remaining) = @_; | |
# Length of $pattern plus the one character tried this round | |
my $len = (length $pattern)+1; | |
# Get unique array so that the same word isn't searched twice | |
my @unique; | |
foreach my $let (@remaining) { | |
my $skip = 0; | |
foreach (@unique) { | |
if ($_ eq $let) { | |
$skip++; | |
last; | |
} | |
} | |
unless ($skip) { | |
push @unique, $let; | |
} | |
} | |
# Skip if pattern will not be at or above minimum defined | |
if ( $len >= $min ) { | |
# Try to append each of the remaining characters to the pattern | |
foreach my $add (@unique) { | |
foreach my $word (@{$keepers[$len]}) { | |
if ($word =~ m/$pattern$add/i) { | |
push @found, $word; | |
last; | |
} | |
} | |
} | |
} | |
# If there are still enough letters for another round, continue | |
if (scalar @remaining > 1) { | |
# Prevent repeating the next round for the same letter | |
my @tried; | |
for (my $i = 0; $i < (scalar @remaining); $i++) { | |
my $skip = 0; | |
foreach (@tried) { | |
if ($remaining[$i] eq $_) { | |
$skip++; | |
last; | |
} | |
} | |
if ($skip) { | |
next; | |
} else { | |
push @tried, $remaining[$i]; | |
my $tmp_pattern = $pattern; | |
my @tmp_array = @remaining; | |
$tmp_pattern = $pattern.$remaining[$i]; | |
splice @tmp_array, $i, 1; | |
recursive_search($tmp_pattern,@tmp_array); | |
} | |
} | |
} | |
} | |
sub usage { | |
print <<"EOF"; | |
Usage: $0 [-m=N] any alpha i n p u t | |
-m=N Define a minimum word length to find. eg. -m=6 | |
All alphabetical input is used on a letter-by-letter basis to find words. It | |
does not matter how they are spaced. However, any input that is not | |
alphabetical will throw an error. A lack of input will also throw an error. | |
Finally, a minimum word length longer than the input will throw an error. | |
EOF | |
exit | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment