```1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 ``` ```module Main where import qualified Data.List as L -- Start Domain-Specific-Language (DSL) for expression-creation -- and evaluation. -- Algebraic type wrapping to do symbol manipulation data Operation = Add | Subtract | Multiply | Divide deriving Eq -- Expressions are naturally binary tree structures data Expression = Leaf (Maybe Integer) | Branch Expression Operation Expression -- Expression equivalence -- To do this properly would require a better data representation to -- make the separation between commutative and noncommutative binary -- operators cleaner. -- This basic filter just cuts the most frequent duplicates to thin -- the list to a manageable size. instance Eq Expression where (==) (Leaf a) (Leaf b) = a == b (==) (Leaf _) (Branch _ _ _) = False (==) (Branch _ _ _) (Leaf _) = False -- Screw third layer. Also screw more complex checking. -- Handle second layer commutative equivalence explicitly (==) (Branch (Branch e1 Add e2) Add e3) (Branch (Branch e4 Add e5) Add e6) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) (==) (Branch e1 Add (Branch e2 Add e3)) (Branch e4 Add (Branch e5 Add e6)) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) (==) (Branch (Branch e1 Add e2) Add e3) (Branch e4 Add (Branch e5 Add e6)) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) (==) (Branch (Branch e1 Multiply e2) Multiply e3) (Branch (Branch e4 Multiply e5) Multiply e6) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) (==) (Branch e1 Multiply (Branch e2 Multiply e3)) (Branch e4 Multiply (Branch e5 Multiply e6)) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) (==) (Branch (Branch e1 Multiply e2) Multiply e3) (Branch e4 Multiply (Branch e5 Multiply e6)) = (e1 == e4 && e2 == e5 && e3 == e6) || (e1 == e6 && e2 == e5 && e3 == e4) || (e1 == e4 && e2 == e6 && e3 == e5) || (e1 == e5 && e2 == e6 && e3 == e4) || (e1 == e5 && e2 == e4 && e3 == e6) || (e1 == e6 && e2 == e4 && e3 == e5) -- Handle first layer commutative equivalence explicitly (==) (Branch e1 Add e2) (Branch e3 Add e4) = (e1 == e3 && e2 == e4) || (e1 == e4 && e2 == e3) (==) (Branch e1 Multiply e2) (Branch e3 Multiply e4) = (e1 == e3 && e2 == e4) || (e1 == e4 && e2 == e3) -- Noncommutative general case (==) (Branch e1 a e2) (Branch e3 b e4) = a == b && (e1 == e3) && (e2 == e4) -- Print convenience later instance Show Operation where show Add = "+" show Subtract = "-" show Multiply = "*" show Divide = "/" instance Show Expression where show (Leaf (Just a)) = show a show (Branch e1 o e2) = "("++show e1++show o++show e2++")" show _ = "()" -- Eval for symbol expression simplification retaining only integer results -- Simplifies an expression either to a Leaf or a Nothing, depending on whether -- the operations stayed in ring of integers or not. eval :: Expression -> Expression eval (Leaf a) = Leaf a eval (Branch (Leaf Nothing) _ _) = Leaf Nothing eval (Branch _ _ (Leaf Nothing)) = Leaf Nothing eval (Branch (Leaf (Just a)) o (Leaf (Just b))) = case o of Add -> Leaf \$ Just \$ (+) a b Subtract -> Leaf \$ Just \$ (-) a b Multiply -> Leaf \$ Just \$ (*) a b Divide -> if b == 0 then Leaf Nothing else case quotRem a b of (n,0) -> Leaf \$ Just n (_,_) -> Leaf Nothing eval (Branch e1 o e2) = eval \$ Branch (eval e1) o (eval e2) -- Redefine nub -- Found a cute bug where the normal nub does not in fact nub out -- all possibilities reliably. However this redefinition does. -- Go figure. nub :: (Eq a) => [a] -> [a] nub = L.nubBy (==) -- Define simple list permutations permutations :: (Eq a) => [a] -> [[a]] permutations [] = [[]] permutations xs = [x:ps | x <- xs, ps <- permutations (xs L.\\ [x])] -- Define total permutations of three possible operations operations :: [[Operation]] operations = [[x,y,z] | x <- p, y <- p, z <- p] where p = [Add, Subtract, Multiply, Divide] -- Zip up list of elements and operations into all parenthized expressions -- Deliberately only works for 4 numbers currently. General solution not -- attempted yet. express :: [Integer] -> [Operation] -> [Expression] express [i1,i2,i3,i4] [o1,o2,o3] = [e1,e2,e3,e4,e5] where l i = Leaf (Just i) b l1 o l2 = Branch l1 o l2 e1 = b (b (b (l i1) o1 (l i2)) o2 (l i3)) o3 (l i4) e2 = b (b (l i1) o1 (b (l i2) o2 (l i3))) o3 (l i4) e3 = b (b (l i1) o1 (l i2)) o2 (b (l i3) o3 (l i4)) e4 = b (l i1) o1 (b (b (l i2) o2 (l i3)) o3 (l i4)) e5 = b (l i1) o1 (b (l i2) o2 (b (l i3) o3 (l i4))) express _ _ = error "Unsupported expression." -- Take a list of integers and form all possible expressions out of it makeExpressions :: [Integer] -> [Expression] makeExpressions l = concat [express i o | i <- permutations l, o <- operations] -- Filter list of expressions keeping only ones that evaluate to a specific Leaf keepLeaf :: Integer -> [Expression] -> [Expression] keepLeaf i = filter ((Leaf (Just i) == ) . eval) -- Find all solutions for a particular 4 numbers solve :: Integer -> [Integer] -> [Expression] solve i = nub . keepLeaf i . concatMap makeExpressions . permutations solveBroken :: Integer -> [Integer] -> [Expression] solveBroken i = L.nub . keepLeaf i . concatMap makeExpressions . permutations main = sequence_ \$ map putStrLn cases where cases = ["Working nub: "++(show \$ solve 10 [2,2,9,9]) ,"Broken nub: "++(show \$ solveBroken 10 [2,2,9,9]) ] ```
 ```1 2 ``` ```Working nub: [(((2+9)+9)/2)] Broken nub: [(((2+9)+9)/2),((2+(9+9))/2)] ```