Anonymous user
Langton's ant: Difference between revisions
→{{header|Haskell}}: Replaced by more transparent and idiomatic solution
m (→{{header|Sidef}}: minor code simplifications) |
(→{{header|Haskell}}: Replaced by more transparent and idiomatic solution) |
||
Line 2,912:
=={{header|Haskell}}==
The set of black cells is represented as a set of points. Complementary set is regarded as white cells.
Necessary import:
<lang Haskell>import Data.Set (member,insert,delete,Set)</lang>
In order to express the ant's algorithm literally we define two operators:
<lang Haskell>-- functional sequence
(>>>) = flip (.)
-- functional choice
p ?>> (f, g) = \x -> if p x then f x else g x</lang>
Finally define the datatype representing the state of ant and ant's universe
<lang Haskell>data State = State { antPosition :: Point
, antDirection :: Point
, getMesh :: Set Point }</lang>
Now we are ready to express the main part of the algorithm
<lang Haskell>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</lang>
That's it.
Here is the solution of the task:
<lang Haskell>task :: State -> State
task = iterate step
>>> dropWhile ((< 50) . distance . antPosition)
where distance
For given initial configuration it returns the set of black cells at the end of iterations.
We can display it graphically using Gloss library
<lang haskell>import Graphics.Gloss
main = display w white (draw (task initial))
where
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
<lang haskell>main = simulate w white 500 initial draw (\_ _ -> step)
where
w = InWindow "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</lang>
=={{header|Icon}} and {{header|Unicon}}==
|