anagrams.hs

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List
import System.Environment

histogram = map (head &&& length) . group . sort

diffHistograms ((lx, cx) : xs) ((ly, cy) : ys) acc
	| lx == ly && cx == cy = diffHistograms xs ys acc
	| lx == ly && cx > cy = diffHistograms xs ys ((lx, cx - cy) : acc)
	| otherwise = diffHistograms xs ((ly, cy) : ys) ((lx, cx) : acc)
diffHistograms xs [] acc = [reverse acc ++ xs]
diffHistograms [] ys acc = []

anagrams word 1 acc dict = do
	w <- dict
	guard $ word == snd w
	return $ fst w : acc

anagrams word len acc dict = do
	first <- dict
	rest <- diffHistograms word (snd first) []
	anagrams rest (len - 1) (fst first : acc) dict

buildDictionary = do
	wordList <- liftM (lines . map toLower) $ readFile "wordlist.txt"
	return $ zip wordList (map histogram wordList)

solve word len = do
	dict <- buildDictionary
	mapM_ (putStrLn . intercalate " ") $ anagrams (histogram word) len [] dict

help = putStrLn "Usage: anagrams <word> <length>"

main = do
	args <- getArgs
	case args of
		[word, num] -> case reads num of
			[(len, "")] -> solve word len
			otherwise -> help
		otherwise -> help