Rosetta Code

Langton's ant: Difference between revisions

Page Discussion

Langton's ant (view source)

Revision as of 11:39, 26 September 2016

65 bytes added ,  7 years ago
→‎{{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.
<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 ->>> Poshead x>>> (y+1)getPosition
where distance West(x,y) = -> Posmax (abs x-1) (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
| otherwisew = x:replaceNthInWindow "Ant" (n-1400,400) newVal xs(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}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/204626"