Personal tools

Haskell Quiz/Numeric Maze/Solution Ninju

From HaskellWiki

< Haskell Quiz | Numeric Maze(Difference between revisions)
Jump to: navigation, search
Current revision (08:23, 27 November 2009) (edit) (undo)
m
 
(One intermediate revision not shown.)
Line 1: Line 1:
[[Category:Haskell Quiz solutions|Numeric Maze]]
[[Category:Haskell Quiz solutions|Numeric Maze]]
-
 
-
I haven't yet added any optimization, because I wanted to keep the program as simple (and therefore readable) as possible, but I might add some later.
 
<haskell>
<haskell>
Line 7: 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>

Current revision


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 ]
Retrieved from "http://www.haskell.org/haskellwiki/Haskell_Quiz/Numeric_Maze/Solution_Ninju"

Category: Haskell Quiz solutions