# Haskell Quiz/Numeric Maze/Solution Ninju

### From HaskellWiki

< Haskell Quiz | Numeric Maze(Difference between revisions)

m |
|||

(3 intermediate revisions by one user not shown) | |||

Line 1: | Line 1: | ||

− | I haven't yet any added any optimization, because I wanted to keep the program as simple (and therefore readable) as possible, but I might add some later. |
+ | [[Category:Haskell Quiz solutions|Numeric Maze]] |

<haskell> |
<haskell> |
||

Line 5: | Line 5: | ||

import System.Environment |
import System.Environment |
||

import Data.List |
import Data.List |
||

+ | |||

+ | data Operator = AddTwo | Double | Halve |
||

main :: IO () |
main :: IO () |
||

main = do args <- getArgs |
main = do args <- getArgs |
||

− | if length args == 2 |
+ | if length args == 2 |

− | then do let [a,b] = map read args |
+ | then let [a,b] = map read args |

− | putStrLn $ show (solve a b) |
+ | in print $ solve a b |

else putStrLn "Usage: solve START TARGET" |
else putStrLn "Usage: solve START TARGET" |
||

− | return () |
||

− | |||

− | data Operation = AddTwo Integer | Double Integer | Halve Integer |
||

− | valid :: Operation -> Bool |
+ | apply :: Operator -> Integer -> Integer |

− | valid (Halve x) = x `mod` 2 == 0 |
+ | apply AddTwo x = x + 2 |

− | valid _ = True |
+ | apply Double x = x * 2 |

+ | apply Halve x = x `div` 2 |
||

− | apply :: Operation -> Integer |
+ | valid :: Operator -> Integer -> Bool |

− | apply (AddTwo x) = x + 2 |
+ | valid Halve x = even x |

− | apply (Double x) = x * 2 |
+ | valid _ _ = True |

− | apply (Halve x) = x `div` 2 |
||

solve :: Integer -> Integer -> [Integer] |
solve :: Integer -> Integer -> [Integer] |
||

− | solve a b = solve' [[a]] b |
+ | solve a b = solve' [[a]] b [a] |

− | where |
+ | |

− | solve' paths target = case find ((== target) . last) paths of |
+ | solve' :: [[Integer]] -> Integer -> [Integer] -> [Integer] |

− | Just path -> path |
+ | solve' paths target seen = case find ((== target) . last) paths of |

− | Nothing -> solve' (concatMap buildPathsFrom paths) target |
+ | Just path -> path |

− | buildPathsFrom path = [ path ++ [apply (op (last path))] | op <- [AddTwo, Double, Halve], valid (op (last path)) ] |
+ | Nothing -> let newPaths = filter ((`notElem` seen) . last) $ concatMap buildPathsFrom paths |

+ | newSeen = seen ++ map last newPaths |
||

+ | in solve' newPaths target newSeen |
||

+ | |||

+ | buildPathsFrom :: [Integer] -> [[Integer]] |
||

+ | buildPathsFrom path = let n = last path |
||

+ | in [ path ++ [ apply operator n ] | operator <- [AddTwo, Double, Halve], valid operator n ] |
||

</haskell> |
</haskell> |

## Latest revision as of 08:23, 27 November 2009

module Main where import System.Environment import Data.List data Operator = AddTwo | Double | Halve main :: IO () main = do args <- getArgs if length args == 2 then let [a,b] = map read args in print $ solve a b else putStrLn "Usage: solve START TARGET" apply :: Operator -> Integer -> Integer apply AddTwo x = x + 2 apply Double x = x * 2 apply Halve x = x `div` 2 valid :: Operator -> Integer -> Bool valid Halve x = even x valid _ _ = True solve :: Integer -> Integer -> [Integer] solve a b = solve' [[a]] b [a] solve' :: [[Integer]] -> Integer -> [Integer] -> [Integer] solve' paths target seen = case find ((== target) . last) paths of Just path -> path Nothing -> let newPaths = filter ((`notElem` seen) . last) $ concatMap buildPathsFrom paths newSeen = seen ++ map last newPaths in solve' newPaths target newSeen buildPathsFrom :: [Integer] -> [[Integer]] buildPathsFrom path = let n = last path in [ path ++ [ apply operator n ] | operator <- [AddTwo, Double, Halve], valid operator n ]