Skip to content

Instantly share code, notes, and snippets.

@JohnMertz
Created December 29, 2019 01:04
Show Gist options
  • Save JohnMertz/3e9f3371748069078e6ffe5faac8bcb9 to your computer and use it in GitHub Desktop.
Save JohnMertz/3e9f3371748069078e6ffe5faac8bcb9 to your computer and use it in GitHub Desktop.
Wordscape - Anagram word search assistant
#!/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