Name

anagram.pl

Language

perl

Licence

GPL

What does it do?

It takes at least one and optionally two arguments. The first is a list of letters, the second should be a single letter that appears in the first argument. It then goes on to list all the words it can find of a minimum word length from that list, capitalising the words it found that use all the letters. If it sees a second argument, then it will list just the words that contain that letter.

The minimum word length is hard-coded in the script itself, and can be changed by editing the variable in the Settings section.

It depends on the program an, which is basically the workhorse of the script. Just sudo apt-get an to install.

Bugs

  1. I have not yet handled the case where the inputted letter list has less than the minimum word length. This should be easy enough to handle, though.
  2. The super-user hasn't got an in their path, so this script fails for the super-user. No biggie, I suppose. Probably shouldn't be running these scripts as the super-user anyway.

Comments

This was initially produced to handle the Target puzzle in The Age, a daily periodical published where I live. It appears as a 3 x 3 grid of letters with the centre one highlighted. The goal is to make as many words of four letters or more containing the highlighted letter. The letters themselves make one nine-lettered word. Because I quite often don't buy the paper every day, I was missing out on solutions, so I wrote this program just to check how I do.

This script uses the word list in /usr/share/dict/words. You can install other word lists by installing, for example, wbritish or wbritish-{small|large|huge|insane}, and switch between them using sudo select-default-wordlist.

The minimum length for the phrase to search for words in is set to 4, which is probably a reasonable minimum.

Tom Paton's page is a good example online of this puzzle.

Version: 1.10

#!/usr/bin/perl # anagram.pl takes upto two arguments, the first of which should be a list of # letters (no spaces), and the optional second a single letter that is # contained the letter list in the first argument. This then returns all words # four letters or more that contains the letter in the first argument. # Copyright (C) 2016 Stewart Park # This program is free software: you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation, either version 3 of the License, or (at your option) any later # version. # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more # details. # You should have received a copy of the GNU General Public License along with # this program. If not, see <http://www.gnu.org/licenses/>. use strict; use warnings; ############ # Settings # ############ my $minWordLength = 4; ###### End of settings ###### # Usage sub usage { print "\nThis program can take two arguments. The first should be a group of\n"; print "at least four letters. The second argument is optional, and should only\n"; print "contain a single letter that must be one of the letters in the first argument.\n"; print "This will then print out a list of words of at least ".$minWordLength." letters found in\n"; print "that group that contain that first letter. This was developed to get answers\n"; print "to the 'Target' puzzle in The Age\n"; print "(http://www.theage.com.au).\n"; print "\n"; print "Example usages:\n"; print "\n\t$0 inaudibly\n\n"; print "will print out the list of words of at least ".$minWordLength." letters that can be made from\n"; print "the letters in 'inaudibly'. It will highlight the word(s) that uses all the\n"; print "letters, and will tell you the longest words it found.\n"; print "\n\t$0 inaudibly l\n\n"; print "will do the same as the above, but will only print out the words that contain\n"; print "the letter 'l'.\n"; print "\n"; } # We should have 1 or 2 command line arguments. Anything else means that the person # doesn't know how to use the program. if (!((scalar(@ARGV) == 2) or (scalar(@ARGV) == 1))) { # Usage &usage(); exit(0); } # Check for the existance of required programs # an Anagram thingo my $an = qx/which an/; chomp $an; if (length($an) == 0) { # A length of zero means the program wasn't found. die "The anagram program 'an' wasn't found, aborting"; } my $an_args = qq/-w -m $minWordLength/; # Righto, check the command line arguments: # The first should be just a list of at least four letters ... my $phrase = ''; if ($ARGV[0] =~ q/^[a-zA-Z]{4}[a-zA-Z]*$/) { $phrase = $ARGV[0]; } else { print "\nThe first command line argument should be a list of at least four letters, and contain *only* letters.\n"; &usage(); die "First argument should contain only letters and be at least four letters long, aborting"; } # The second, if it exists, should be a single letter only my $singleLetter = ''; if (scalar(@ARGV) == 2) { if ($ARGV[1] =~ q/^[a-zA-Z]$/) { $singleLetter = $ARGV[1]; } else { print "\nAborting ... the second command line argument needs to be a single letter.\n"; &usage(); die "Incorrect form of the second command line argument, aborting"; } # ... and should be contained in the group of letters in the first argument. if (!($phrase =~ qq/$singleLetter/)) { print "\nThe phrase doesn't contain the letter."; &usage(); die "Didn't find '$singleLetter' in '$phrase', aborting"; } } # Ok, all set to go my $phraseLength = length($phrase); my @wordList = qx/$an $an_args $phrase/; my @sortedWordList = sort @wordList; my @longestWords = (); # Print and count only the non-proper nouns (those not starting with a capital letter) and # those not containing an apostrophe. my $wordCount = 0; my $longestWord = ""; for my $word (@sortedWordList) { chomp $word; if ($word =~ q/^[a-z]/) { if (!($word =~ q/[']/)) { if ((length($singleLetter) != 0) && !($word =~ qq/$singleLetter/)) { # Do nothing if we have a single letter and don't find it in the word } else { $wordCount++; if (length($word) == $phraseLength ) { $word = uc($word); } print "$word\n"; # Collect all of the longest words in an array my $numLongestWords = @longestWords; if ($numLongestWords == 0) { $longestWords[0] = $word; } elsif (length($word) == length($longestWords[0])) { @longestWords[$numLongestWords] = $word; } elsif (length($word) > length($longestWords[0])) { @longestWords = ($word); } } } } } if ($wordCount == 0) { print qq/\nNo words found.\n\n/; exit 0; } print "\nWord count: $wordCount, longest word"; my $numLongestWords = @longestWords; if ($numLongestWords > 1) { print "s"; } print ": "; for (my $i = 0; $i < ($numLongestWords - 1); $i++) { printf "%s, ", $longestWords[$i]; } print $longestWords[$numLongestWords -1].".\n\n"; # Fin