Wolfram's Rule 30 cellular automaton in PureScript.

Main.purs

module Main where

import Prelude

import Control.Comonad (class Comonad, class Extend, extend, extract)
import Control.Monad.Eff.Console (log)
import Data.Array ((..), (!!), cons, length, replicate, zipWith)
import Data.Function (on)
import Data.Int (fromStringAs, binary, toNumber, floor)
import Data.Int.Bits ((.&.))
import Data.List.Lazy (iterate, take)
import Data.Maybe (fromJust, fromMaybe, Maybe)
import Data.String (joinWith)
import Data.Traversable (scanl, for, sum)
import Math (pow)
import Partial.Unsafe (unsafePartial)
import TryPureScript (render, withConsole)


-- The pointer holds a row of cells, as well as an index
-- to refer to a specific value within that row.
data Pointer a = Pointer Int (Array a)
derive instance functorPointer :: Functor Pointer


instance extendPointer :: Extend Pointer where
  -- Replace every value in the board with an awareness of
  -- the board's other inhabitants. In this case, `extend`
  -- is like a context-aware `map`.
  extend f (Pointer p xs) = Pointer p xs'
      where xs' = map (\i -> f $ Pointer i xs)
                      (0 .. (length xs - 1))

instance comonadPointer :: Comonad Pointer where
  -- "Extract" the value at the given index. Nothing too
  -- fancy - we can unsafePartial because we "know" that
  -- our pointer index will never be out of range.
  extract (Pointer i xs) = unsafePartial (fromJust $ xs !! i)


-- Given a rule and a pointer to somewhere in a row, calculate
-- the value of the cell in the next row.
value :: Int -> Pointer Boolean -> Boolean
value rule (Pointer i xs) = rule .&. (pow' 2 bitmask) > 0

        -- The dependencies of this particular cell.
  where parents :: Array Boolean
        parents = fromMaybe false <$> [ xs !! (i + 1)
                                      , xs !! i
                                      , xs !! (i - 1) ]

        -- Integer-specific `pow` for convenience.
        pow' :: Int -> Int -> Int
        pow' = (\x -> floor <<< pow x) `on` toNumber

        -- Convert the parents to a bitmask. Not very general,
        -- but good enough for this demo...
        bitmask :: Int
        bitmask = sum $ zipWith (if _ then _ else 0) parents [1, 2, 4]


-- Print a boolean row with squares.
print :: Array Boolean -> String
print = joinWith "" <<< map (if _ then "█" else " ")


-- Actually print the majestic triangle!
main = render <=< withConsole $ for rows \(Pointer _ r) -> log $ print r

        -- The array we're going to start with - 1 T between 40 F.
        -- Adjust the 40s for different "board" widths and configs.
  where starter :: Array Boolean
        starter = replicate 40 false <> [true] <> replicate 40 false
        
        -- A scanl that keep the first row!
        scanl' f acc = cons acc <<< scanl f acc

        -- The list of comonadic iterations! Lazy lists aren't optimal
        -- here, but they make the example much prettier. The "30" is
        -- the rule used, so edit that to produce different triangles.
        rows = take 80 $ iterate (extend $ value 30) (Pointer 0 starter)