0votos

Hormiga de Langton en Haskell

por josejuan hace 4 años

Sobre un toroide.

Simular el algoritmo de la hormiga de Langton

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
{-# LANGUAGE RecordWildCards #-} 
import Graphics.Gloss 
import Graphics.Gloss.Geometry 
import Graphics.Gloss.Interface.Pure.Simulate 
import Graphics.Gloss.Data.Vector 
import Data.List 
import System.Environment 
import System.Random 
import Control.Applicative 
 
data World = 
     World {apos :: (Int,Int), dir :: Int, path :: [(Int,Int)], cell :: [[Bool]], cells :: Int} 
 
randomPoint :: Int -> Int -> (Int, Int) 
randomPoint cells r = (abs q, abs d `mod` cells) 
    where (d, q) = r `divMod` cells 
 
makeWorld :: [Int] -> Int -> World 
makeWorld (r:d:rs) cells = World start (d `mod` 4) [] (take cells $ rows rs) cells 
    where start   = randomPoint cells r 
          rows zs = map odd a: rows b where (a, b) = splitAt cells zs 
 
drawWorld :: Int -> World -> Picture 
drawWorld size (World {..}) = Pictures $ grid ++ [path', ant] 
    where px x = fromIntegral (x * size) - 0.5 * fromIntegral ((cells - 1) * size) 
          w = fromIntegral size 
          to (x, y) = (px x, px y) 
          at = uncurry Translate . to 
          color True  = Color $ makeColor 0.5 0.1 0.1 1.0 
          color False = Color $ makeColor 0.1 0.5 0.1 1.0 
          box p c = at p $ Pictures [color c $ rectangleSolid w w, Color (greyN 0.5) $ rectangleWire w w] 
          grid = [box (x, y) ((cell!!x)!!y) | x <- [0..cells-1], y <- [0..cells-1]] 
          path' = Color white $ Pictures [Line $ map to g | g <- hyper (apos: path)] 
          hyper [u] = [[u]] -- para no dibujar saltos en el hiperespacio :) 
          hyper (u@(a, b):v@(c, d):vs) | abs (a - c) < 2 && abs (b - d) < 2 = (u:us):rs 
                                       | otherwise                          = [u]: hyper (v:vs) 
                                       where (us:rs) = hyper (v:vs) 
          ant = Color black $ at apos $ circleSolid (0.5 * w) 
 
advanceWorld :: ViewPort -> Float -> World -> World 
advanceWorld _ _ (World {..}) = 
    World ((x + dx) `mod` cells, (y + dy) `mod` cells) dir' (apos: path) cell' cells 
    where (x, y) = apos 
          dir' = (dir + if (cell!!x)!!y then 1 else 3) `mod` 4 
          (dx, dy) = [(0, 1), (1, 0), (0, -1), (-1, 0)]!!dir' 
          cell' = a ++ (u ++ (not v):vs): bs 
                  where (a, b:bs) = splitAt x cell 
                        (u, v:vs) = splitAt y b 
 
main = do 
    (cells:size:_) <- map read <$> getArgs 
    rnd <- randoms <$> getStdGen :: IO [Int] 
     
    simulate 
        (InWindow "Langton" (size * cells, size * cells) (0, 0)) 
        black 30 (makeWorld rnd cells) (drawWorld size) advanceWorld 
2 comentarios
0votos

Escrito por josejuan hace 4 años

Una captura de la animación:

Captura

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.