Langton's ant: Difference between revisions

Content added Content deleted

Inline

@@ Line 2,912: / Line 2,912: @@
 =={{header|Haskell}}==
+The set of black cells is represented as a set of points. Complementary set is regarded as white cells.
-<lang Haskell>data Color = Black | White
-  deriving (Read, Show, Enum, Eq, Ord)
+Necessary import:
-putCell c = putStr (case c of Black -> "#"
-                              White -> ".")
+<lang Haskell>import Data.Set (member,insert,delete,Set)</lang>
-toggle :: Color -> Color
-toggle color = toEnum $ 1 - fromEnum color
+In order to express the ant's algorithm literally we define two operators:
+<lang Haskell>-- functional sequence
-data Dir = East | North | West | South
+(>>>) = flip (.)
-  deriving (Read, Show, Enum, Eq, Ord)
+-- functional choice
-turnLeft South = East
+p ?>> (f, g) = \x -> if p x then f x else g x</lang>
-turnLeft dir = succ dir
+Finally define the datatype representing the state of ant and ant's universe
-turnRight East = South
+<lang Haskell>data State = State { antPosition :: Point
-turnRight dir = pred dir
+                   , antDirection :: Point
+                   , getMesh :: Set Point }</lang>
+Now we are ready to express the main part of the algorithm
-data Pos = Pos { x :: Int,  y :: Int }
+<lang Haskell>step :: State -> State
-  deriving (Read)
+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</lang>
+That's it.
-instance Show Pos where
-  show p@(Pos x y) = "(" ++ (show x) ++ "," ++ (show y) ++ ")"
+Here is the solution of the task:
--- Return the new position after moving one unit in the given direction
+<lang Haskell>task :: State -> State
-moveOne pos@(Pos x y) dir =
+task = iterate step
-  case dir of
+   >>> dropWhile ((< 50) . distance . antPosition)
-    East  -> Pos (x+1) y
-    South -> Pos x (y+1)
+   >>> head >>> getPosition
-    West  -> Pos (x-1) y
+  where distance (x,y) = max (abs x) (abs y)</lang>
-    North -> Pos x (y-1)
+For given initial configuration it returns the set of black cells at the end of iterations.
--- Grid is just a list of lists
-type Grid = [[Color]]
+We can display it graphically using Gloss library
-colorAt g p@(Pos x y) = (g !! y) !! x
+<lang haskell>import Graphics.Gloss
+main = display w white (draw (task initial))
-replaceNth n newVal (x:xs)
+  where
-     | n == 0 = newVal:xs
-     | otherwise = x:replaceNth (n-1) newVal xs
+    w = InWindow "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</lang>
+Or animate the ant's trajectory
-toggleCell g p@(Pos x y) =
+<lang haskell>main = simulate w white 500 initial draw (\_ _ -> step)
-  let newVal = toggle $ colorAt g p
+  where
-  in replaceNth y (replaceNth x newVal (g !! y)) g
+    w = InWindow "Ant" (400,400) (0,0)
+    initial = State (0,0) (1,0) mempty
-printRow r = do { mapM_ putCell r ; putStrLn "" }
+    draw (State p _ s) = pictures [foldMap drawCell s, color red $ drawCell p]
+    drawCell (x,y) = Translate (10*x) (10*y) $ rectangleSolid 10 10</lang>
-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</lang>
 =={{header|Icon}} and {{header|Unicon}}==