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