summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2012-10-14 11:12:12 +0100
committerDaniel Silverstone <dsilvers@digital-scurf.org>2012-10-14 11:12:12 +0100
commit5a8bba12eebbd9041dc9200461e49b6a4ebeb457 (patch)
treeb7874c378001245c9ba7f53bfb95ef9bfc35db75
parentb38578bff3b8219cf1bc0e8d337a02915777e3b4 (diff)
downloadcountdown-5a8bba12eebbd9041dc9200461e49b6a4ebeb457.tar.bz2
Initial hacky attempts
-rw-r--r--.gitignore1
-rw-r--r--CountdownTry1.hs130
-rw-r--r--CountdownTry2.hs140
-rw-r--r--PROBLEM100
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"
diff --git a/PROBLEM b/PROBLEM
new file mode 100644
index 0000000..8aa936b
--- /dev/null
+++ b/PROBLEM
@@ -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.