**diff options**

author | Daniel Silverstone <dsilvers@digital-scurf.org> | 2012-10-14 11:12:12 +0100 |
---|---|---|

committer | Daniel Silverstone <dsilvers@digital-scurf.org> | 2012-10-14 11:12:12 +0100 |

commit | 5a8bba12eebbd9041dc9200461e49b6a4ebeb457 (patch) | |

tree | b7874c378001245c9ba7f53bfb95ef9bfc35db75 | |

parent | b38578bff3b8219cf1bc0e8d337a02915777e3b4 (diff) | |

download | countdown-5a8bba12eebbd9041dc9200461e49b6a4ebeb457.tar.bz2 |

Initial hacky attempts

-rw-r--r-- | .gitignore | 1 | ||||

-rw-r--r-- | CountdownTry1.hs | 130 | ||||

-rw-r--r-- | CountdownTry2.hs | 140 | ||||

-rw-r--r-- | PROBLEM | 100 |

4 files changed, 371 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/CountdownTry1.hs b/CountdownTry1.hs new file mode 100644 index 0000000..af2fc89 --- /dev/null +++ b/CountdownTry1.hs @@ -0,0 +1,130 @@ +-- Countdown Try number 1 + +import System.Environment (getArgs) +import Data.Maybe (fromJust) +import Data.List (permutations, sortBy) + +data Operation = Plus | Minus | Times | Divide | Drop deriving (Show, Eq) + +data Solution = Solution [Int] [Operation] + +calcValue :: Int -> Int -> Operation -> Maybe Int +calcValue a b Plus = Just (a + b) +calcValue a b Minus + | a > b = Just (a - b) + | otherwise = Nothing +calcValue a b Times = Just (a * b) +calcValue a b Divide + | b == 0 = Nothing + | a `rem` b /= 0 = Nothing + | otherwise = Just (a `div` b) +calcValue _ b Drop = Just b + +solutionValueInner :: [Int] -> [Operation] -> Maybe Int +solutionValueInner [a] [] = Just a +solutionValueInner (a:b:cs) (op:ops) = + let newtop = calcValue a b op + in + if newtop == Nothing then + Nothing + else + solutionValueInner ((fromJust newtop):cs) ops + +solutionValue :: Solution -> Maybe Int +solutionValue (Solution nums ops) = solutionValueInner nums ops + +operationToOperator :: Operation -> String +operationToOperator op + | op == Plus = " + " + | op == Minus = " - " + | op == Times = " * " + | op == Divide = " / " + | otherwise = "" + +showSingleOperation :: String -> String -> Operation -> String +showSingleOperation a b op + | op == Drop = b + | otherwise = "(" ++ a ++ (operationToOperator op) ++ b ++ ")" + +showSolutionInner :: [String] -> [Operation] -> String +showSolutionInner (a:b:[]) (op:[]) = showSingleOperation a b op +showSolutionInner (a:b:cs) (op:ops) = + let newtop = showSingleOperation a b op + in + showSolutionInner (newtop:cs) ops + +showValue :: Maybe Int -> String +showValue Nothing = "error" +showValue (Just a) = show a + +showSolution :: Solution -> String +showSolution soln@(Solution nums ops) + | otherwise = ((showSolutionInner (map show nums) ops) ++ " = " ++ + (showValue (solutionValue soln))) + +genOperations :: [[Operation]] +genOperations = + let opslist = [Plus, Minus, Times, Divide, Drop] + in + [[a,b,c,d,e] | a <- opslist, b <- opslist, c <- opslist, d <- opslist, e <- opslist] + +distance :: Solution -> Int -> Int +distance soln target = + let solval = fromJust (solutionValue soln) + in + abs (target - solval) + +sortGoodSolutions :: Int -> [Solution] -> [Solution] +sortGoodSolutions target = sortBy (\s1 -> \s2 -> (compare + (distance s1 target) + (distance s2 target))) + + +sortedSolutions :: [[Int]] -> [[Operation]] -> Int -> [Solution] +sortedSolutions allnums allops target = + let allpossible = [Solution nums ops | nums <- allnums, ops <- allops] + in + sortGoodSolutions target (filter (\s -> (solutionValue s) /= Nothing) allpossible) + + +countdownSolver :: [Int] -> Int -> [Solution] +countdownSolver nums target = + let allnums = permutations nums + allops = genOperations + in + sortedSolutions allnums allops target + +runAndReport :: [Int] -> Int -> IO () +runAndReport nums target = do + putStrLn (showSolution (head (countdownSolver nums target))) + +filterBadNums :: [Int] -> [Int] +filterBadNums = filter (\a -> (((a > 0) && (a < 11)) || (a == 25) || (a == 50) || (a == 75) || (a == 100))) + +checkNumsAndRun :: [Int] -> Int -> IO () +checkNumsAndRun nums target + | length (filterBadNums nums) /= 6 = do + putStrLn "error: Input numbers do not meet requirements" + | otherwise = runAndReport nums target + +checkSplitAndRun :: [Int] -> Int -> IO () +checkSplitAndRun nums target + | (target < 100) || (target > 999) = do + putStrLn "error: Target is not between 100 and 999" + | otherwise = checkNumsAndRun nums target + +checkAndRun :: [Int] -> IO () +checkAndRun xs = checkSplitAndRun (init xs) (last xs) + +strToInt :: String -> Int +strToInt s = read s :: Int + +convertCheckAndRun :: [String] -> IO () +convertCheckAndRun = checkAndRun . map strToInt + +main :: IO () +main = do + args <- getArgs + case args of + [_,_,_,_,_,_,_] -> convertCheckAndRun args + _ -> putStrLn "error: exactly seven arguments needed" diff --git a/CountdownTry2.hs b/CountdownTry2.hs new file mode 100644 index 0000000..c5f3217 --- /dev/null +++ b/CountdownTry2.hs @@ -0,0 +1,140 @@ +-- Countdown Try number 2 + +import System.Environment (getArgs) +import Data.Maybe (fromJust) +import Data.List (permutations, sortBy) + +data Operation = Plus | Minus | Times | Divide | Drop deriving (Show, Eq) + +data RawSolution = RawSolution [Int] [Operation] + +data Solution = Solution RawSolution (Maybe Int) + +calcValue :: Int -> Int -> Operation -> Maybe Int +calcValue a b Plus = Just (a + b) +calcValue a b Minus + | a > b = Just (a - b) + | otherwise = Nothing +calcValue a b Times = Just (a * b) +calcValue a b Divide + | b == 0 = Nothing + | a `rem` b /= 0 = Nothing + | otherwise = Just (a `div` b) +calcValue _ b Drop = Just b + +solutionValueInner :: [Int] -> [Operation] -> Maybe Int +solutionValueInner [a] [] = Just a +solutionValueInner (a:b:cs) (op:ops) = + let newtop = calcValue a b op + in + if newtop == Nothing then + Nothing + else + solutionValueInner ((fromJust newtop):cs) ops + +rawSolutionValue :: RawSolution -> Maybe Int +rawSolutionValue (RawSolution nums ops) = solutionValueInner nums ops + +realiseSolution :: RawSolution -> Solution +realiseSolution soln = Solution soln (rawSolutionValue soln) + +solutionValue :: Solution -> Maybe Int +solutionValue (Solution _ val) = val + +operationToOperator :: Operation -> String +operationToOperator op + | op == Plus = " + " + | op == Minus = " - " + | op == Times = " * " + | op == Divide = " / " + | otherwise = "" + +showSingleOperation :: String -> String -> Operation -> String +showSingleOperation a b op + | op == Drop = b + | otherwise = "(" ++ a ++ (operationToOperator op) ++ b ++ ")" + +showRawSolutionInner :: [String] -> [Operation] -> String +showRawSolutionInner (a:b:[]) (op:[]) = showSingleOperation a b op +showRawSolutionInner (a:b:cs) (op:ops) = + let newtop = showSingleOperation a b op + in + showRawSolutionInner (newtop:cs) ops + +showValue :: Maybe Int -> String +showValue Nothing = "error" +showValue (Just a) = show a + +showRawSolution :: RawSolution -> String +showRawSolution (RawSolution nums ops) = (showRawSolutionInner (map show nums) ops) ++ " = " + +showSolution :: Solution -> String +showSolution (Solution raw val) = + (showRawSolution raw) ++ (showValue val) + +genOperations :: [[Operation]] +genOperations = + let opslist = [Plus, Minus, Times, Divide, Drop] + in + [[a,b,c,d,e] | a <- opslist, b <- opslist, c <- opslist, d <- opslist, e <- opslist] + +distance :: Solution -> Int -> Int +distance soln target = + let solval = fromJust (solutionValue soln) + in + abs (target - solval) + +sortGoodSolutions :: Int -> [Solution] -> [Solution] +sortGoodSolutions target = sortBy (\s1 -> \s2 -> (compare + (distance s1 target) + (distance s2 target))) + + +sortedSolutions :: [[Int]] -> [[Operation]] -> Int -> [Solution] +sortedSolutions allnums allops target = + let allpossible = [realiseSolution (RawSolution nums ops) | nums <- allnums, ops <- allops] + in + sortGoodSolutions target (filter (\s -> (solutionValue s) /= Nothing) allpossible) + + +countdownSolver :: [Int] -> Int -> [Solution] +countdownSolver nums target = + let allnums = permutations nums + allops = genOperations + in + sortedSolutions allnums allops target + +runAndReport :: [Int] -> Int -> IO () +runAndReport nums target = do + putStrLn (showSolution (head (countdownSolver nums target))) + +filterBadNums :: [Int] -> [Int] +filterBadNums = filter (\a -> (((a > 0) && (a < 11)) || (a == 25) || (a == 50) || (a == 75) || (a == 100))) + +checkNumsAndRun :: [Int] -> Int -> IO () +checkNumsAndRun nums target + | length (filterBadNums nums) /= 6 = do + putStrLn "error: Input numbers do not meet requirements" + | otherwise = runAndReport nums target + +checkSplitAndRun :: [Int] -> Int -> IO () +checkSplitAndRun nums target + | (target < 100) || (target > 999) = do + putStrLn "error: Target is not between 100 and 999" + | otherwise = checkNumsAndRun nums target + +checkAndRun :: [Int] -> IO () +checkAndRun xs = checkSplitAndRun (init xs) (last xs) + +strToInt :: String -> Int +strToInt s = read s :: Int + +convertCheckAndRun :: [String] -> IO () +convertCheckAndRun = checkAndRun . map strToInt + +main :: IO () +main = do + args <- getArgs + case args of + [_,_,_,_,_,_,_] -> convertCheckAndRun args + _ -> putStrLn "error: exactly seven arguments needed" @@ -0,0 +1,100 @@ +The Countdown numbers game - Problem definition +=============================================== + +The challenge is to take seven natural numbers as input and produce an +expression using between one and all of the first six of the naturals and the +mathematical operators plus, minus, times and divide to produce the target +natural which is the seventh input. + +At no point may an intermediate be anything other than a natural number. + +The source inputs will be selected from the set: + +[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 25, 50, 75, 100] + +The target number will be in the range [100 .. 999] inclusive. + +Commonly, two of the larger numbers and four of the rest will be selected at +random however there is no requirement for this, and the games consisting of +zero large and six small, or four large and two small have been seen and are +typically considered to be the hardest to solve. + +If you cannot get the exact target, then we want the expression yielding the +closest to the target it is possible to get. + +Some possible Haskell ponderings +-------------------------------- + +Our solver function probably takes its input in the form of the six numbers and +then returns a way to represent the list of best expressions it found. Ideally +we'd exhaustively find all the best ones, but we'll see what the best approach +is. + +As such, something like: + +countdownSolver :: [Int] -> Int -> [Solution] + +How might we look at solving this? +---------------------------------- + +If we express the problem as a stack of numbers and a sequence of operators +to perform on the stack, then we might get somewhere. + +The operators are Plus, Minus, Times, Divide and Drop. The first four take a +and b off the stack, perform their operation and push the result back. The +last one simply drops the top element from the stack. + +In this case, there are therefore five operators, each of which reduces the +stack by one element meaning we need to make five calls. + +There are 720 different ways to permute a list of 6 numbers. So we have to +consider 720 possible stacks. This isn't sounding too bad so far. + +However, there are 3125 possible sequences of operators which we will need +to consider. Meaning that there are 2250000 total ways to express things +in our solution path. + +Sometimes an operator will result in things which are not allowed in the +Countdown game. For example, if the result of an operation is not natural then +it is not permitted. Such operations might be a subtraction resulting in a +zero (or negative value) or a division resulting in a non-integer result. In +these circumstances we should short-circuit the evaluation of this solution as +"not acceptable" + +More Haskell ponderings +----------------------- + +data Operation = Plus | Minus | Times | Divide | Drop deriving (Show, Eq) + +data Solution = Solution [Int] [Operation] + +solutionValue :: Solution -> Maybe Int + +More consideration +------------------ + +With all of the above, we might define our solution finder by applying all +possible permutations of the list to all possible sequences of operators, +culling the ones which fail to evaluate and then sorting the rest to choose the +best. + +This is a very long-hand way of solving the problem and is probably orders of +magnitude too slow, but in good learning style, let's try it. + +This can be found in CountdownTry1.hs + +Having written this up, it turns out that on my laptop, runghc plus this +solution reliably finds the best it can within 30 seconds. Yay for fast CPUs. + +Unfortunately when you run "The most extraordinary numbers game ever?" it takes +a jot over 30 seconds, so we need to find a way to improve performance a tad. + +Possible ways to improve things +------------------------------- + +While pureness means Haskell nominally ought to be able to optimise calling +solutionValue repeatedly on a given solution, it's possible it's being +defeated. In CountdownTry2.hs we attempt to "lift" the solution's value into +its definition so that we can stop this from causing problems. + +This seems to (roughly) double the speed of the solver, so that'll do for now. |