import Data.Set (member, fromAscList, Set)
import Data.Ord (comparing)
import Data.List (maximumBy,sortBy)
import qualified Data.Map as Map
import Data.Char
type Substitution = [Char]
type Cryptogram = String
permute [] = [[]]
permute l = [x:ys | (x,xs) <- extractions l, ys <- permute xs]
stepPermute (prefix,l) = [(x:prefix, xs) | (x,xs) <- extractions l]
search :: Set String -> Cryptogram -> (String,String) -> [Substitution]
search dict crypt sub = step . sortBy (comparing (lift eval)) $ strings
where permutations = stepPermute sub
strings = zip (map (uncurry (++)) permutations) permutations
lift f = f dict crypt . fst
step ss | any (lift done) ss = map fst . filter (lift done) $ ss
step ss = concatMap (search dict crypt) (map snd ss)
extractions [] = []
extractions l = extract l []
where extract [] _ = []
extract (x:xs) prev = (x, prev++xs) : extract xs (x : prev)
count f = length . filter f
cryptogram = "a clockwork orange"
bestScore = count (`elem` ['a'..'z'])
initial = ['a'..'z']
states = permute initial
succ = tail
eval dict crypt sub = score dict (subst crypt sub)
subst crypt sub = map (\ c -> Map.findWithDefault c c dsub) crypt
where dsub = Map.fromAscList (zip ['a'..'z'] sub)
score dict text = sum (map (lookup dict) (words text))
where lookup dict w = if member w dict then length w else 0
done dict crypt sub = eval dict crypt sub == bestScore crypt
test = maximumBy (comparing (eval dict crypt)) states
where dict = fromAscList ["a", "ad", "bad", "cab", "cad"]
crypt = "d bda cdb"
initial = "abcd"
states = permute initial
test2 = search dict crypt initial
where dict = fromAscList ["a", "ad", "bad", "cab", "cad"]
initial = ("", "abcd")
crypt = "d bda cdb"
run = do dictionary <- readFile "/usr/share/dict/words"
let words = fromAscList . map (map toLower) . lines $ dictionary
return (maximumBy (comparing (eval words cryptogram)) states)
main = run >>= print