Puzzle solving with Haskell - make 24 with 3,3,8,8

articles ✒ 3-3-8-8-to-make-24

The Challenge

To make 24 using the numbers 3,3,8,8 each once with the operations +, *, - and /.

A suitable program

 
import Ratio
import List
 
data Expression = Expression Expression Char Expression | Value Rational
    deriving (Show, Eq, Ord)
 
eqplus :: Expression -> Expression -> Expression
eqplus a b = Expression (a) '+' (b)
 
eqminus :: Expression -> Expression -> Expression
eqminus a b = Expression (a) '-' (b)
 
eqmult :: Expression -> Expression -> Expression
eqmult a b = Expression (a) '*' (b)
 
eqdiv :: Expression -> Expression -> Expression
eqdiv a b = Expression (a) '/' (b)
 
spanOf :: [Rational] -> [(Rational, Expression)]
 
spanOf []  = []
spanOf [n] = [(n, Value n)]
spanOf ns  = (uniqueSorted fstequal . concat . concat) [ [ countdownValues (n, Value n) v | v <- spanOf (listMinusOne n ns) ] | n <- uniqueSorted (==) ns ]
 
fstequal :: Eq a => (a,b) -> (a,b) -> Bool
fstequal a b = fst a == fst b
 
uniqueSorted :: Ord a => (a -> a -> Bool) -> [a] -> [a]
uniqueSorted equal = uniqueSorted' equal . sort
 
uniqueSorted' :: (a -> a -> Bool) -> [a] -> [a]
uniqueSorted' equal (x:y:xs) | equal x  y    = uniqueSorted' equal (x:xs)
                             | otherwise     = x : uniqueSorted' equal (y:xs)
 
uniqueSorted' equal [x] = [x]
uniqueSorted' equal []  = []
 
countdownValues :: (Rational, Expression)-> (Rational, Expression) -> [(Rational, Expression)]
 
countdownValues (a,ta) (0,tb) = [(a, ta `eqplus` tb), (0, ta `eqmult` tb)]
countdownValues (0,ta) b = countdownValues b (0,ta)
 
countdownValues (a,ta) (b,tb) = 
    [(a + b, ta `eqplus` tb),
     (a - b, ta `eqminus` tb),
     (b - a, tb `eqminus` ta),
     (b * a, ta `eqmult` tb),
     (a / b, ta `eqdiv` tb),
     (b / a, tb `eqdiv` ta)]
 
solveCountdown :: [Rational] -> Rational -> Maybe Expression
solveCountdown values target = search target (spanOf values)
 
search :: Eq a => a -> [(a,b)] -> Maybe b
search a ((x,y):xs) | a == x = Just y
                    | otherwise = search a xs
search a [] = Nothing
 
listMinusOne :: Eq a => a -> [a] -> [a]
listMinusOne x (y:ys) | x == y    = ys
                      | otherwise = y:(listMinusOne x ys)                  
listMinusOne x [] = error "Not found!"
 
 

comment on this page