Data commit

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