2016 Update

Task/Langtons-ant/Haskell/langtons-ant-1.hs

@@ -0,0 +1 @@
+import Data.Set (member,insert,delete,Set)

Task/Langtons-ant/Haskell/langtons-ant-2.hs

@@ -0,0 +1,5 @@
+-- functional sequence
+(>>>) = flip (.)
+
+-- functional choice
+p ?>> (f, g) = \x -> if p x then f x else g x

Task/Langtons-ant/Haskell/langtons-ant-3.hs

@@ -0,0 +1,5 @@
+data State = State { antPosition :: Point
+                   , antDirection :: Point
+                   , getCells :: Set Point }
+
+type Point = (Float, Float)

Task/Langtons-ant/Haskell/langtons-ant-4.hs

@@ -0,0 +1,10 @@
+step :: State -> State
+step = isBlack ?>> (setWhite >>> turnRight,
+                    setBlack >>> turnLeft) >>> move
+  where
+    isBlack   (State p _     m) = member p m
+    setBlack  (State p d     m) = State p d (insert p m)
+    setWhite  (State p d     m) = State p d (delete p m)
+    turnRight (State p (x,y) m) = State p (y,-x) m
+    turnLeft  (State p (x,y) m) = State p (-y,x) m
+    move (State (x,y) (dx,dy) m) = State (x+dx, y+dy) (dx, dy) m

Task/Langtons-ant/Haskell/langtons-ant-5.hs

@@ -0,0 +1,5 @@
+task :: State -> State
+task = iterate step
+   >>> dropWhile ((< 50) . distance . antPosition)
+   >>> getCells . head
+  where distance (x,y) = max (abs x) (abs y)

Task/Langtons-ant/Haskell/langtons-ant-6.hs

@@ -0,0 +1,8 @@
+import Graphics.Gloss
+
+main = display w white (draw (task initial))
+  where
+    w = InWindow "Langton's Ant" (400,400) (0,0)
+    initial = State (0,0) (1,0) mempty
+    draw = foldMap drawCell
+    drawCell (x,y) = Translate (10*x) (10*y) $ rectangleSolid 10 10

Task/Langtons-ant/Haskell/langtons-ant-7.hs

@@ -0,0 +1,6 @@
+main = simulate w white 500 initial draw (\_ _ -> step)
+  where
+    w = InWindow "Langton's Ant" (400,400) (0,0)
+    initial = State (0,0) (1,0) mempty
+    draw (State p _ s) = pictures [foldMap drawCell s, color red $ drawCell p]
+    drawCell (x,y) = Translate (10*x) (10*y) $ rectangleSolid 10 10

Task/Langtons-ant/Haskell/langtons-ant.hs

@@ -1,81 +0,0 @@
-data Color = Black | White
-  deriving (Read, Show, Enum, Eq, Ord)
-
-putCell c = putStr (case c of Black -> "#"
-                              White -> ".")
-
-toggle :: Color -> Color
-toggle color = toEnum $ 1 - fromEnum color
-
-
-data Dir = East | North | West | South
-  deriving (Read, Show, Enum, Eq, Ord)
-
-turnLeft South = East
-turnLeft dir = succ dir
-
-turnRight East = South
-turnRight dir = pred dir
-
-data Pos = Pos { x :: Int,  y :: Int }
-  deriving (Read)
-
-instance Show Pos where
-  show p@(Pos x y) = "(" ++ (show x) ++ "," ++ (show y) ++ ")"
-
--- Return the new position after moving one unit in the given direction
-moveOne pos@(Pos x y) dir =
-  case dir of
-    East  -> Pos (x+1) y
-    South -> Pos x (y+1)
-    West  -> Pos (x-1) y
-    North -> Pos x (y-1)
-
--- Grid is just a list of lists
-type Grid = [[Color]]
-
-colorAt g p@(Pos x y) = (g !! y) !! x
-
-replaceNth n newVal (x:xs)
-     | n == 0 = newVal:xs
-     | otherwise = x:replaceNth (n-1) newVal xs
-
-toggleCell g p@(Pos x y) =
-  let newVal = toggle $ colorAt g p
-  in replaceNth y (replaceNth x newVal (g !! y)) g
-
-printRow r = do { mapM_ putCell r ; putStrLn "" }
-
-printGrid g = mapM_ printRow g
-
-
-data State = State { move :: Int, pos :: Pos, dir :: Dir, grid :: Grid }
-
-printState s = do {
-  putStrLn $ show s;
-  printGrid $ grid s
-}
-
-instance Show State where
-   show s@(State m p@(Pos x y) d g) =
-     "Move: " ++ (show m) ++  " Pos: " ++ (show p) ++ " Dir: " ++ (show d)
-
-nextState s@(State m p@(Pos x y) d g) =
-  let color = colorAt g p
-      new_d = case color of White -> (turnRight d)
-                            Black -> (turnLeft d)
-      new_m = m + 1
-      new_p = moveOne p new_d
-      new_g = toggleCell g p
-  in State new_m new_p new_d new_g
-
-inRange size s@(State m p@(Pos x y) d g) =
-  x >= 0 && x < size && y >= 0 && y < size
-
-initialState size = (State 0 (Pos (size`div`2) (size`div`2)) East [ [ White | x <- [1..size] ] | y <- [1..size] ])
-
---- main
-size = 100
-allStates = initialState size : [nextState s | s <- allStates]
-
-main = printState $ last $ takeWhile (inRange size) allStates