[Haskell-cafe] Re: Learning about Programming Languages
(specifically Haskell)
Roel van Dijk
vandijk.roel at gmail.com
Tue May 4 06:35:51 EDT 2010
Here is my attempt. I tried to avoid higher concepts like folds and
things like the ($) operator. Most recursions are written explicitly.
{---- BEGIN CODE ----}
module Main where
-- Data type representing a door which is either Open or Closed.
data Door = Open | Closed deriving Show
toggle :: Door -> Door
toggle Open = Closed
toggle Closed = Open
-- Applies the function f to every n'th element of a list.
skipMap :: (a -> a) -> Int -> [a] -> [a]
skipMap f n | n < 1 = error "skipMap: step < 1"
| otherwise = go (n - 1)
where
-- Apply the function 'f' to an element of the list when the
-- counter reaches 0, otherwise leave the element untouched.
go _ [] = []
go 0 (x:xs) = f x : go (n - 1) xs
go c (x:xs) = x : go (c - 1) xs
-- Calculate the final answer.
run :: Int -> [Door]
run n = go 1 initialDoors -- Start by toggling every door.
where
-- Initial list of closed doors
initialDoors :: [Door]
initialDoors = replicate n Closed
-- Toggle every c doors, then proceed by toggling every c+1 doors
-- of the result, etcetera... Stops after toggling the n'th door.
go :: Int -> [Door] -> [Door]
go c doors
| c > n = doors
| otherwise = go (c + 1) (skipMap toggle c doors)
-- Print information about a single door.
printDoor :: (Int, Door) -> IO ()
printDoor (n, door) = putStrLn ("Door #" ++ show n ++ " is " ++ show door)
printRun :: Int -> IO ()
printRun n = mapM_ printDoor (zip [1..n] (run n))
-- The program entry point.
main :: IO ()
main = printRun 100
{---- END CODE ----}
More information about the Haskell-Cafe
mailing list