ラングトンのアリ

平面が格子状に構成され、各マスが白または黒で塗られる。ここで、1つのマスを「アリ」とする。アリは各ステップで上下左右のいずれかのマスに移動することができる。アリは以下の規則に従って移動する。

* 黒いマスにアリがいた場合、90°右に方向転換し、そのマスの色を反転させ、1マス前進する。

* 白いマスにアリがいた場合、90°左に方向転換し、そのマスの色を反転させ、1マス前進する。

この単純な規則で驚くほど複雑な動作をする。

wikipedia:ラングトンのアリ

no title

面白そうだったので実装してみた．

コードを実行するとpbm画像を出力する．

convert ant-*.pbm ant.gif

とすると…

こんなgifアニメができる．

画像出力に手間取った．

import Data.Array.IO (IOUArray, newArray, readArray, writeArray, getBounds, getElems)
import Control.Monad (when)
import Text.Printf (printf)
data Direction = U | R | D | L deriving Enum
type Ant = (Direction, (Int, Int))
type State = (Ant, IOUArray (Int,Int) Bool)
-- True <=> White, False <=> Black
next :: State -> IO State
next (a@(d,p),b) = do c <- readArray b p
writeArray b p $ not c
(_,(w,h)) <- getBounds b
return $ (move (w,h) (turn c d) p, b)
turn :: Bool -> Direction -> Direction
turn c = toEnum.(`mod` 4).next.fromEnum
where next | c         = pred
| otherwise = succ
move :: (Int, Int) -> Direction -> (Int, Int) -> Ant
move (h,w) d (x,y) = (d, (mod (x + dx) h, mod (y + dy) w))
where (dx,dy) = case d of U -> ( 1,); R -> (, 1);
D -> (-1,); L -> (,-1)
initial :: Int -> Int -> IO State
initial h w = do b <- newArray ((,), (h-1,w-1)) False
return ((U, (div h 2, div w 2)), b)
toPBM :: State -> IO String
toPBM (a,b) = do (_,(h,w)) <- getBounds b
cs <- getElems $ b
let hd = ["P1n", show $ w+1, "n", show $ h+1, "n"]
return.concat $ hd ++ map (show.fromEnum.not) cs
run :: Int -> Int -> Int -> Int -> IO ()
run h w c m = loop (::Int) $ initial h w
where loop i s =
when (i<m) $ do writeFile (name i) =<< toPBM =<< s
loop (i+1).(!!c).iterate (next =<<) $ s
name i = "ant-" ++ printf "%03d" i ++".pbm"
main :: IO ()
main = run 200 200 200 200

本当はバイナリ形式のPBMにしたかったが，やりかたが良く分からないのと，コードが長くなりそう．

（多分，今のままでやるなら，Boolを8個まとめないといけなそう，根拠はないわけではない．Word8）

あと，IOUArrayを使っているところがちょっと．状態の更新自体はIOアクションを含まないものなので，

STUArrayを使いたいが，それだと多分，画像出力が面倒？