A simple script that tries to solve an anagram by comparing all possible letter combinations of a word with one or multiple dictionaries.

Requirements

Example

 $ ./anagram.pl --lang en,de ehrensenf
 0 results  in dictionary en
 1 result  in dictionary de
 fernsehen

Source code

anagram.pl

#!/usr/bin/perl -w
use strict;

use Getopt::Long;
use Text::Aspell;

# get and check command line arguments
my @languages;
my $help = 0;
GetOptions('help|?' => \$help, 'lang=s' => \@languages) or usage();
if ( $help ) { usage() };
if ( @ARGV < 1 ) { usage("missing input") }
if ( @ARGV > 1 ) { usage("too much input") }
@languages = split( /,/, join( ',', @languages ) );
if ( ! @languages ) { @languages = ('en') }
my $anagram = lc( $ARGV[0] );

my $speller;
foreach my $lang ( @languages ) {
# init spell checker
	$speller = Text::Aspell->new();
	$speller->set_option( 'ignore-case', 'true' );
	$speller->set_option( 'lang', $lang );
# check if the given dictionary exists
	if ( ! grep( /^$lang:/, $speller->list_dictionaries() ) ) {
		print( "unknown dictionary $lang\n" );
		next;
	}
# get the results (hash is used to eliminate duplicate results)
	my %results;
	&check( "", $anagram, \%results );
	my @resultsUnique = keys( %results );
# output results
	my $numResults = @resultsUnique;
	my $s = ( $numResults != 1 ) ? 's' : '';
	print( "$numResults result$s  in dictionary $lang\n" );
	foreach ( @resultsUnique ) { print( "$_\n" ) }
}

# subroutine for recursively checking all possible letter combinations
#
# given a word of length n, build strings beginning with the first letter of
# the word and ending with all possible combinations of the letters 2 to n
# (which are words of the length (n-1) and are built the same way),
# then build strings beginning with the second letter of the word and ending
# with all possible combinations of the letters 1 and 3 to n and so on...
#
# this is done by iterating over the letters of the string $rest (which
# contains the full anagram when this routine is called from the main program),
# removing the current letter from $rest and appending it to $prefix 
# (which must be empty when this routine is called from the main program)
# and calling this routine again with the new $prefix and $rest, until $rest
# contains only one letter which means we are done building one combination of
# the letters and we can check it against the dictionary
sub check {
# $results: reference to the hash of results
	my ( $prefix, $rest, $results )  = @_;
	my $l = length( $rest );
	if ( $l == 1 ) {
		my $word = $prefix . $rest;
		if ( $speller->check( $word ) ) {
			 $results->{$word} = 1;
		}
	} else {
		for ( my $i = 0; $i < $l; $i++ ) {
# we need to remove the letter at position $i from $rest, so we have to get the
# substrings on the left and right side of it to build the new $rest
			my $left = ( $i == 0 ) ? "" : substr( $rest, 0, $i );
			my $letter = substr( $rest, $i, 1 );
			my $right = ( $i == $l-1 ) ? "" : substr( $rest, $i+1 );
			&check( $prefix . $letter, $left . $right, $results );
		}
	}
}

# subroutine for printing usage information and ending the program
sub usage {
	my $errorString = shift;
	if ( defined( $errorString ) ) {
		print( "$errorString\n" );
	}
	print << "EOF";
$0 - solves anagrams using aspell dictionary

usage:	$0 [options] word
options:
  --help|-?	print this help message
  --lang	comma separated list of the dictionaries to check (default=en)
EOF
	exit( 0 );
}