anagrams2.hs

import Control.Monad
import Data.Char
import Data.List

makeGroup xs = (head xs, length xs)

histogram = map makeGroup . group . sort

diffHistograms ((lx, cx) : xs) ((ly, cy) : ys)
	| lx == ly && cx == cy = diffHistograms xs ys
	| lx == ly && cx > cy = map ((lx, cx - cy) :) $ diffHistograms xs ys
	| otherwise = map ((lx, cx) :) $ diffHistograms xs ((ly, cy) : ys)
diffHistograms xs [] = [xs]
diffHistograms [] ys = []

anagrams word dict = [(fst first, fst second) |
	first <- dict,
	rest <- diffHistograms word (snd first),
	second <- dict,
	rest == snd second]

printSolution (first, second) = putStrLn $ first ++ " " ++ second

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

findAnagrams = anagrams . histogram

main = do
	dict <- buildDictionary
	mapM_ printSolution $ findAnagrams "documenting" dict