Elementary cellular automaton: Difference between revisions
Content added Content deleted
m (no longer draft) |
(→{{header|Haskell}}: Added Haskell solution) |
||
Line 708:
ENDFUNC
</lang>
=={{header|Haskell}}==
===Array-based solution ===
Straight-forward implementation of CA on a cyclic domain, using imutable arrays:
<lang Haskell>import Data.Array (listArray, (!), bounds, elems)
step rule a = listArray (l,r) res
where (l,r) = bounds a
res = [rule (a!r) (a!l) (a!(l+1)) ] ++
[rule (a!(i-1)) (a!i) (a!(i+1))| i <- [l+1..r-1] ] ++
[rule (a!(r-1)) (a!r) (a!l) ]
runCA rule = iterate (step rule)</lang>
The following gives decoding of the CA rule and prepares the initial CA state:
<lang Haskell>rule n l x r = n `div` (2^(4*l + 2*x + r)) `mod` 2
initial n = listArray (0,n-1) . center . padRight n
where
padRight n lst = take n $ lst ++ repeat 0
center = take n . drop (n `div` 2+1) . cycle</lang>
Finally the IO stuff:
<lang Haskell>displayCA n rule init = mapM_ putStrLn $ take n result
where result = fmap display . elems <$> runCA rule init
display 0 = ' '
display 1 = '*'</lang>
{{Out}}
<pre>λ> displayCA 40 (rule 90) (initial 40 [1])
*
* *
* *
* * * *
* *
* * * *
* * * *
* * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* * * *
* * * * * * * *
* * * * * * * *
* * * * * * * * * * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* * * *
* * * * * * * *
* * * * * * * *
* * * * * * * * * * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* * * *
* * * * * * * *
* * * * * * * *
* * * * * * * * * * * * * * * * </pre>
=== Comonadic solution ===
This solution is more involved, but it is slightly more efficient than Array-based one. What is more important, this solution is guaranteed to be total and correct by type checker.
The cyclic CA domain is represented by an infinite ''zipper list''. First we provide the datatype, the viewer and constructor:
<lang Haskell>{-# LANGUAGE DeriveFunctor #-}
import Control.Comonad
import Data.InfList (InfList (..))
import qualified Data.InfList as Inf
data Cycle a = Cycle Int a a (InfList a) deriving Functor
view (Cycle n _ x r) = Inf.take n (x ::: r)
fromList [] = let a = a in Cycle 0 a a (Inf.repeat a)
-- zero cycle length ensures that elements of the empty cycle will never be accessed
fromList lst = let x:::r = Inf.cycle lst
in Cycle (length lst) (last lst) x r</lang>
In order to run the CA on the domain we make it an instance of <code>Comonad</code> class. Running the CA turns to be just an iterative comonadic ''extension'' of the rule:
<lang Haskell>instance Comonad Cycle where
extract (Cycle _ _ x _) = x
duplicate x@(Cycle n _ _ _) = fromList $ take n $ iterate shift x
where shift (Cycle n _ x (r:::rs)) = Cycle n x r rs
runCA rule = iterate (=>> step)
where step (Cycle _ l x (r:::_)) = rule l x r</lang>
Rule definition and I/O routine is the same as in Array-based solution:
<lang Haskell>rule n l x r = n `div` (2^(4*l + 2*x + r)) `mod` 2
initial n lst = fromList $ center $ padRight n lst
where
padRight n lst = take n $ lst ++ repeat 0
center = take n . drop (n `div` 2+1) . cycle
displayCA n rule init = mapM_ putStrLn $ take n result
where result = fmap display . view <$> runCA rule init
display 0 = ' '
display 1 = '*'</lang>
=={{header|J}}==
| |||