Haskell Quiz/Numeric Maze/Solution Ninju: Difference between revisions

From HaskellWiki
No edit summary
No edit summary
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 do let [a,b] = map read args
                     putStrLn $ show (solve a b)
                     putStrLn $ show $ 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 = x `mod` 2 == 0
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>

Revision as of 20:17, 25 August 2008


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 do let [a,b] = map read args
                    putStrLn $ show $ 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 = x `mod` 2 == 0
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 ]