Elementary cellular automaton: Difference between revisions
Content deleted Content added
m no longer draft |
→{{header|Haskell}}: Added Haskell solution |
||
Line 708: | Line 708: | ||
ENDFUNC |
ENDFUNC |
||
</lang> |
</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}}== |
=={{header|J}}== |