Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Cracking codes using backtracking
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Logic
import Data.List
import qualified Data.Map as M
type BindingT k v = StateT (M.Map k v)
bind :: (MonadPlus m, Ord k, Eq v) => k -> v -> BindingT k v m ()
bind k v = do
m <- get
case M.lookup k m of
Just v' | v' /= v -> mzero
_ -> put $ M.insert k v m
-- gives [('f','2'),('k','1'),('n','8'),('s','6'),('t','3'),('u','4')]
main :: IO ()
main = print $ solve ["funk", "nuts", "stun"] ["6348", "8342", "8436", "2481"]
type Solver a = BindingT Char Char Logic a
solve :: [String] -> [String] -> [(Char, Char)]
solve ws cs = M.toList . snd $ observe (runStateT (solveWords ws cs) M.empty)
-- | Solves for all supplied words and codes. Assumes one incorrect dummy code.
solveWords :: [String] -> [String] -> Solver ()
solveWords ws cs = foldr1 mplus $ map (go ws) (selections cs)
where
go ws cs = sequence_ $ map (flip solveWord cs) ws
selections [] = []
selections (x:xs) = xs : [ x:ys | ys <- selections xs]
solveWord :: String -> [String] -> Solver ()
solveWord w cs = foldr1 mplus $ map (sequence_ . zipWith bind w) cs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.