Given the following numbers:
100 75 50 25 6 3
and the following operators:
(*) (-) (+) (/)
build an Expression, that yields 952 when it is evaluated (evaluate applies all the operators bottom - up)
Doubles are used for convenience, number is rounded and checked against an integer to mitigate floating point error that might accumulate.
module Example (solve, Expression(Value, Expr)) where
data Expression = Value Double | Expr Expression (Double -> Double -> Double) Expression
solve :: [Double] -> Expression
--solve = undefined
--- my brute-force solution
solve xs = head . filter validate . allExpressions os . allOrders $ xs
where os = getPermutationsAtDepth (length xs - 1) ops
evaluate :: Expression -> Double
evaluate (Value x) = x
evaluate (Expr i o j) = (evaluate i) `o` (evaluate j)
validate :: Expression -> Bool
validate = (==952) . round . evaluate
-- ok because all the numbers are unique
removed :: Eq a => a -> [a] -> [a]
removed x = filter (/=x)
allOrders :: Eq a => [a] -> [[a]]
allOrders [x] = [[x]]
allOrders xs = concat [ [ x:ns | ns <- allOrders (removed x xs)] | x <- xs]
ops = [(*), (-), (+), (/)] :: [Op]
type Op = Double -> Double -> Double
data NodeTree a = Node a [NodeTree a] | Leaf a deriving (Show)
genTree :: a -> [a] -> Int -> NodeTree a
genTree root es 1 = Node root (map Leaf es)
genTree root es depth = Node root (map (\x -> genTree x es (depth-1)) es)
getPaths :: NodeTree a -> [[a]]
getPaths (Leaf x) = [[x]]
getPaths (Node r xs) = concat [ [ r:t | t <- getPaths c] | c <- xs]
getPermutationsAtDepth :: Int -> [a] -> [[a]]
getPermutationsAtDepth 1 xs = [xs]
getPermutationsAtDepth depth xs = concat . map getPaths . map (\x -> genTree x xs d) $ xs where d = depth - 1
toExpression :: [Op] -> [Double] -> Expression
toExpression _ [] = error "should not be more operators than values!"
toExpression [] [e] = Value e
toExpression (o:os) (e:es) = Expr (Value e) o (toExpression os es)
allExpressions :: [[Op]] -> [[Double]] -> [Expression]
allExpressions os es = [toExpression o e | o <- os, e <- es]module ExampleSpec where
-- Tests can be written using Hspec http://hspec.github.io/
-- Replace this with your own tests.
import Test.Hspec
import Example
import Data.List
numbers = [100, 75, 50, 25, 6, 3] :: [Double]
collectNums :: Expression -> [Double]
collectNums (Value x) = [x]
collectNums (Expr x _ y) = collectNums x ++ collectNums y
evaluate :: Expression -> Double
evaluate (Value x) = x
evaluate (Expr i o j) = (evaluate i) `o` (evaluate j)
validate :: Expression -> Bool
validate = (==952) . round . evaluate
-- `spec` of type `Spec` must exist
spec :: Spec
spec = do
describe "get the solution" $ do
it "must use each number once and only once" $ do
(sort . collectNums . solve $ numbers) `shouldBe` (sort numbers)
it "must equal 952" $ do
-- round because of floating point error
(round . evaluate . solve $ numbers) `shouldBe` (952 :: Int)
-- the following line is optional for 8.2
main = hspec specimprove speed, check only up until n/2