Created
October 4, 2018 11:25
-
-
Save AdamBrouwersHarries/fbf5e4bc9e6f5b9ec88bcac33c0a524a to your computer and use it in GitHub Desktop.
Utterly nerd sniped.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Control.Monad | |
import Data.List | |
import Data.Function | |
-- Define a name - i.e. just a variable | |
data Name = MkName Char deriving (Eq, Show) | |
-- Define a context - a mapping from variabels to values | |
data Context = Ctx [(Name, Int)] deriving (Eq) | |
-- pretty print them... | |
instance Show Context where | |
show (Ctx ps) = "[" ++ (intercalate ", " $ map showPair ps) ++ "]" where | |
showPair (MkName c, i) = [c] ++ " -> " ++ (show i) | |
-- Get names given a list of values. | |
mkNames :: [a] -> [Name] | |
mkNames l = take (length l) $ map MkName ['a'..] | |
-- Make a specific context. | |
mkContext :: [Name] -> [Int] -> Context | |
mkContext n v = Ctx $ zip n v | |
-- Make all possible contexts from these values | |
mkContexts :: [Int] -> [Context] | |
mkContexts v = nub $ map (mkContext names) $ permutations v where | |
names = mkNames v | |
-- Define arithmetic expressions of the kind that we're allowed in countdown. | |
data Expression = | |
Add Expression Expression | | |
Sub Expression Expression | | |
Mul Expression Expression | | |
Div Expression Expression | | |
Var Name | |
deriving (Eq) | |
-- Define a representation, given a context, that returns variable names | |
-- if a value cannot be found in the context. | |
repr :: Expression -> Context -> String | |
repr (Var (MkName n)) (Ctx c) = case lookup (MkName n) c of | |
Just i -> show i | |
Nothing -> [n] | |
repr (Add l r) c = "(" ++ (repr l c) ++ "+" ++ (repr r c) ++ ")" | |
repr (Sub l r) c = "(" ++ (repr l c) ++ "-" ++ (repr r c) ++ ")" | |
repr (Mul l r) c = "(" ++ (repr l c) ++ "*" ++ (repr r c) ++ ")" | |
repr (Div l r) c = "(" ++ (repr l c) ++ "/" ++ (repr r c) ++ ")" | |
-- Define a pretty printer using an empty context (always showing names) | |
instance Show Expression where | |
show e = repr e (Ctx []) | |
-- Define evaluation for an expression, given a context (assignment to variables) | |
eval :: Expression -> Context -> Maybe Int | |
eval (Var v) (Ctx c) = lookup v c | |
eval (Add l r) c = liftM2 (+) (eval l c) (eval r c) | |
eval (Sub l r) c = liftM2 (-) (eval l c) (eval r c) | |
eval (Mul l r) c = liftM2 (*) (eval l c) (eval r c) | |
eval (Div l r) c = lf ((eval l c), (eval r c)) >>= uncurry checkedDiv where | |
lf (Just a, Just b) = Just (a, b) | |
lf _ = Nothing | |
checkedDiv i j = if j /= 0 && i `mod` j == 0 then Just (i `div` j) else Nothing | |
-- Expand a list of names into possible expressions involving the names. | |
-- This is where the "meat" of the program is, and where we generate trees. | |
-- Note, we make sure that we use each variable _once_, by creating a Var | |
-- at the very root of the recursion, and not before. | |
expand :: [Name] -> [Expression] | |
expand [] = undefined | |
expand (n:[]) = [Var n] | |
expand (n:ns) = (expand ns) >>= (pairs (Var n)) where | |
pairs :: Expression -> Expression -> [Expression] | |
pairs v e = [Add v e, Mul v e, Sub v e, Sub e v, Div v e, Div e v] | |
-- Show a list of showables in a nicer way. | |
prettyShow :: Show a => [a] -> String | |
prettyShow xs = "[\n " ++ (intercalate "\n " $ map show xs) ++ "\n]" | |
-- Given a set of possible assignments, and an expression, find out every possible | |
-- outcome of evaluating that expression, given those values. | |
-- For utilities sake, group the result with the context + expression | |
tryExpression :: [Context] -> Expression -> [(String, Int)] | |
tryExpression cs e = cs >>= (groupEval e) where | |
groupEval :: Expression -> Context -> [(String, Int)] | |
groupEval e c = case eval e c of | |
Just i -> [(repr e c, i)] | |
Nothing -> [] | |
-- Given a list of integers, find every possible expression, assignment, and result | |
findSolutions :: [Int] -> [(String, Int)] | |
findSolutions values = expressions >>= (tryExpression contexts) where | |
names = mkNames values | |
contexts = mkContexts values | |
expressions = expand names | |
main :: IO () | |
main = putStrLn $ prettyShow $ sortBy (compare `on` snd) $ findSolutions [3,3,8,8] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment