It has been a while since I read some programming in haskell book (matasano challenges, euler problems, 4clojure problems, and so on kept me busy :D). So here it goes, the chapter 11 exercises was about the countdown problem.
Given a list of numbers and a result, find the possible operations which, when evaluated, renders such result.
choices
Redefine the combinatorial function
choicesusing a list comprehension rather than the library functionsconcatandmap.
My first point-free implementation:
choices :: [a] -> [[a]] choices = (concatMap perms) . subs
Using list comprehension:
choices :: [a] -> [[a]] choices xs = [ p | s <- subs xs, p <- perms s] *Problem> choices [1,2,3] [[],[3],[2],[2,3],[3,2],[1],[1,3],[3,1],[1,2],[2,1],[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]] *Problem> choices [1,2,3,4] [[],[4],[3],[3,4],[4,3],[2],[2,4],[4,2],[2,3],[3,2],[2,3,4],[3,2,4],[3,4,2],[2,4,3],[4,2,3],[4,3,2],[1],[1,4],[4,1],[1,3],[3,1],[1,3,4],[3,1,4],[3,4,1],[1,4,3],[4,1,3],[4,3,1],[1,2],[2,1],[1,2,4],[2,1,4],[2,4,1],[1,4,2],[4,1,2],[4,2,1],[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1],[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[1,3,2,4],[3,1,2,4],[3,2,1,4],[3,2,4,1],[1,3,4,2],[3,1,4,2],[3,4,1,2],[3,4,2,1],[1,2,4,3],[2,1,4,3],[2,4,1,3],[2,4,3,1],[1,4,2,3],[4,1,2,3],[4,2,1,3],[4,2,3,1],[1,4,3,2],[4,1,3,2],[4,3,1,2],[4,3,2,1]]
isChoice
Define a recursive function
isChoice :: Eq a ⇒ [a] → [a] → Boolthat decides if one list is chosen from another, without using the combinatorial functionspermsandsubs.Hint: start by defining a function that removes the first occurrence of a value from a list.
We'll follow the hint and implement the function remove1:
remove1 :: Eq a => a -> [a] -> [a] remove1 _ [] = [] remove1 x (y:ys) | x == y = ys | otherwise = y:remove1 x ys *Problem> remove1 1 [3,2..1] [3,2] *Problem> remove1 1 [9,8..1] [9,8,7,6,5,4,3,2] *Problem> remove1 1 [9,8..0] [9,8,7,6,5,4,3,2,0] *Problem> remove1 1 [9,8..0] ++ [1] [9,8,7,6,5,4,3,2,0,1]
Now, we can use it to help us implement the isChoice function
isChoice :: Eq a => [a] -> [a] -> Bool isChoice [] _ = True isChoice _ [] = False isChoice (x:xs) l = elem x l && isChoice xs (remove1 x l) *problem> isChoice [11] [1..10] False *Problem> isChoice [2..3] [1..10] True *Problem> isChoice [] [1..10] True *Problem> isChoice [] [] True *Problem> isChoice [1..2] [] False
split
What effect would generalising the function
splitto also return pairs containing the empty list have on the behaviour of solutions?
Here is the split function:
split :: [a] -> [([a], [a])] split [] = [] split [_] = [] split (x:xs) = ([x], xs) : [(x: ls, rs) | (ls, rs) <- split xs] *Problem> split [1,3,7,10,25,50] [([1],[3,7,10,25,50]),([1,3],[7,10,25,50]),([1,3,7],[10,25,50]),([1,3,7,10],[25,50]),([1,3,7,10,25],[50])]
And the client call:
exprs :: [Int] -> [Expr] exprs [] = [] exprs [x] = [Val x] exprs xs = [ x | (ls, rs) <- split xs, l <- exprs ls, r <- exprs rs, x <- combine l r] Problem> exprs [1, 10] [App Mul (Val 1) (Val 10),App Add (Val 1) (Val 10),App Sub (Val 1) (Val 10),App Div (Val 1) (Val 10)]
Adding the empty pairs to the existing result, [[], l], [l, []] (l is the initial list), would result in exprs to never reduce the size of the list when calling recursively exprs.
Thus breaking.
Checks
Using
choices,exprs, andeval, verify that there are 33665406 possible expressions over the numbers 1, 3, 7, 10, 25, 50, and that only 4672540 of these expressions evaluate successfully.
Computing all possible expressions from all possible choices from the list [1, 3, 7, 10, 25, 50] renders:
*Problem> length [ es | cs <- choices [1,3,7,10,25,50], es <- exprs cs] 33665406
With the current definition of a valid expression:
valid :: Op -> Int -> Int -> Bool valid Add x y = x <= y valid Sub x y = x > y valid Mul x y = x <= y && x /= 1 && y /= 1 valid Div x y = y /= 1 && x `mod` y == 0
Evaluating those valid expressions renders:
*Problem> length [ es | cs <- choices [1,3,7,10,25,50], es <- exprs cs, eval es /= []] 245644
which differs from the problem.
Using the basic implementation for valid, we obtain indeed the same number.
valid :: Op -> Int -> Int -> Bool valid Add _ _ = True valid Sub x y = x > y valid Mul _ _ = True valid Div x y = y /= 0 && x `mod` y == 0 *Problem> length [ es | cs <- choices [1,3,7,10,25,50], es <- exprs cs, eval es /= []] 4672540
Checks 2
Similarly, verify that the number of expressions that evaluate successfully increases to 10839369 if the numeric domain is generalised to arbitrary integers.
Hint: modify the definition of valid.
Now modifying the signature of valid to permit no particular filter on those numbers:
valid :: Op -> Int -> Int -> Bool valid Add _ _ = True valid Sub _ _ = True valid Mul _ _ = True valid Div x y = y /= 0 && x `mod` y == 0
We obtain:
*Problem> length [ es | cs <- choices [1,3,7,10,25,50], es <- exprs cs, eval es /= []] 10839369
Modifications
Modify the final program to:
- allow the use of exponentiation in expressions;
- produce the nearest solutions if no exact solution is possible;
- order the solutions using a suitable measure of simplicity.
We first need to add the exp operation in the data Op:
-- operation data Op = Add | Sub | Mul | Div | Exp deriving (Show)
Then update the definition of valid expression.
We will follow the same guideline, that is no negative exponent and as a ^ 1 = a=, we will refuse any exponent 1.
Thus the following definition:
valid :: Op -> Int -> Int -> Bool valid Add x y = x <= y valid Sub x y = x > y valid Mul x y = x <= y && x /= 1 && y /= 1 valid Div x y = y > 1 && x `mod` y == 0 valid Exp _ y = y == 0 || y > 1 *Problem> valid Exp 10 2 True *Problem> valid Exp 10 (-1) False *Problem> valid Exp 10 1 False
Then updating the apply function to add the evaluation part of the Exp operation:
apply :: Op -> Int -> Int -> Int apply Add x y = x + y apply Sub x y = x - y apply Mul x y = x * y apply Div x y = x `div` y apply Exp x y = x ^ y *Problem> apply Exp 10 2 100
At last, updating the ops function to add Exp to the possible operations:
ops :: [Op] ops = [Mul, Add, Sub, Div, Exp]
Now everything is good to be able to compute possible expressions. For example, with 1, 2, 10, and a solution 100, we only have the expression 10 ^ 2:
*Problem> solutions' [1,2,10] 100 [App Exp (Val 10) (Val 2)]
QuickCheck
We will use a little bit of quickCheck to ensure everything is still ok.
First we need to deal with the property we want to ensure is ok. This property is the fact that every expression generated from the list [1, 3, 7, 10, 25, 50], for a given n, when evaluated, indeed renders [n].
For this, we will need a generator of not too big interval [1..1000] seems good.
prop_solution = forAll (elements [1..1000]) $ \n -> all (\x -> eval x == [n]) (solutions' [1, 3, 7, 10, 25, 50] n)
Then, as this treatment is heavy (the number of expressions can be quite huge), we will limit ourselves to only 2 passing tests (feel free to increase).
deepCheck :: Testable prop => prop -> IO () deepCheck p = verboseCheckWith stdArgs { maxSuccess = 2 } p
Now we can run the tests.
test :: IO () test = do deepCheck prop_solution *Problem> test Passed: 852 Passed: 332 +++ OK, passed 2 tests.
QuickCheck gave us the number it elected, for the curious, we can see those results:
*Problem> solutions' [1, 3, 7, 10, 25, 50] 852 [App Sub (App Mul (App Sub (Val 25) (Val 10)) (App Add (Val 7) (Val 50))) (Val 3),App Add (App Sub (Val 3) (Val 1)) (App Mul (App Add (Val 7) (Val 10)) (Val 50)),App Add (Val 3) (App Sub (App Mul (App Add (Val 7) (Val 10)) (Val 50)) (Val 1)),App Sub (App Add (Val 3) (App Mul (App Add (Val 7) (Val 10)) (Val 50))) (Val 1),App Sub (App Mul (App Add (Val 1) (Val 10)) (App Add (Val 7) (App Mul (Val 3) (Val 25)))) (Val 50),App Add (App Sub (Val 3) (App Exp (Val 1) (Val 25))) (App Mul (App Add (Val 7) (Val 10)) (Val 50)),App Sub (App Mul (App Sub (Val 25) (Val 7)) (App Sub (Val 50) (Val 1))) (App Mul (Val 3) (Val 10)),App Add (Val 3) (App Sub (App Mul (App Add (Val 7) (Val 10)) (Val 50)) (App Exp (Val 1) (Val 25))),App Sub (App Add (Val 3) (App Mul (App Add (Val 7) (Val 10)) (Val 50))) (App Exp (Val 1) (Val 25))] *Problem> length $ solutions' [1, 3, 7, 10, 25, 50] 852 9 *Problem> length $ solutions' [1, 3, 7, 10, 25, 50] 332 145