Skip to content

Instantly share code, notes, and snippets.

@mmakowski
Created March 8, 2012 20:27
Show Gist options
  • Save mmakowski/2003231 to your computer and use it in GitHub Desktop.
Save mmakowski/2003231 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-
tree they help
2854 8531 8422 2955
t= r= e= h= y= l= p=
-}
module Decode where
{-
ghci:
-}
import Control.Unification
import Control.Unification.IntVar
import Control.Monad.Logic
import Data.Foldable
import Data.Functor.Fixedpoint
import Data.List
import Data.Traversable
-- let's revise type fixing:
data IntListF r = Nil | Cons Int r
type IntList = Fix IntListF
-- now:
data TermF r = C Char
| L [r]
| P r r
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type Term = Fix TermF
instance Unifiable TermF where
zipMatch (C a) (C b) | a == b = Just (C a)
zipMatch (L as) (L bs) | length as == length bs = Just $ L $ zip as bs
zipMatch (P a1 a2) (P b1 b2) = Just $ P (a1, b1) (a2, b2)
zipMatch _ _ = Nothing
-- Solver can do unification and backtracking
type Solver a = IntBindingT TermF Logic a
main :: IO ()
main = print $ solve ["tree", "they", "help"] ["2854", "8531", "8422", "2955"]
-- observe tells the logic thing to go and find a solution
solve :: [String] -> [String] -> String
solve ws ds = pretty . observe . evalIntBindingT $ solver (parse ws) (parse ds)
-- runLogic . evalIntBindingT
parse :: [String] -> Term
parse = Fix . L . map parseStr
parseStr :: String -> Term
parseStr = Fix . L . map (Fix . C)
-- here we can use a catamorphism; it takes a data structure and an algebra
-- i.e. a function that goes from bottom (C in our case) to top replacing the type
-- param with result type, "collapsing" (folding) the structure
pretty :: Term -> String
pretty = cata trans
trans :: TermF String -> String
trans (C c) = [c]
trans (L ss) = intercalate ", " ss
trans (P a b) = a ++ "= " ++ b
solver :: Term -> Term -> Solver Term
solver = undefined -- TODO!
{-
slowDecode :: [String] -> [String] -> [[(Char, Char)]]
slowDecode decoded encoded =
filter (encodesCorrectly decoded encoded) allEncodings
encodesCorrectly :: [String] -> [String] -> [(Char, Char)] -> Bool
encodesCorrectly = error
allEncodings :: [[(Char, Char)]]
allEncodings = error
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment