Let's get back to our CA generator. Literate Haskell follows:

Last time we defined a function to generate the next state of a given cell in our cellular universe, given a rule number and a tuple consisting of the current state of the cell to the left, the cell itself, and the cell to the right. >import Data.Bits >genNextBit :: Int -> ( Bool, Bool, Bool ) -> Bool >genNextBit rulenum ( left, center, right ) = rulenum `testBit` idx > where idx = ( if left then (4::Int) else (0::Int) ) .|. > ( if center then (2::Int) else (0::Int) ) .|. > ( if right then (1::Int) else (0::Int) ) Recall that we can use automatic currying to make a rule-applying function like so: >rule_30 = genNextBit 30 We can ask GHCi for the type: :type rule_30 rule_30 :: (Bool, Bool, Bool) -> Bool I've put it off while I work on the rules, but it is time to figure out how to actually represent our CA universe. Let's start by using a list. I know that I'm going to write a number of inefficient functions, and do evil things like take the length of lists a lot, but let's suspend all concerns about efficiency over to a future discussion and consider this purely a proof-of-concept. Our inital universe at time zero has one cell set to True: >initial_universe = [True] But that isn't quite the right representation for the universe, because it implies that our whole universe is one cell in size. We can't even apply our rule once because there is no left cell and right cell! Really, we want to pretend that we have an _infinite_ universe; at time zero, all the cells to the left and right hold False. Remember, Haskell is so powerful that it can traverse an infinite list in only 0.0003 seconds! Well, if you don't evaluate the whole thing, that is. Taking advantage of lazy evaluation, you can define all kinds of infinite structures. This construct will give us an infinite list of False values: >allFalse :: [Bool] >allFalse = False : allFalse We don't want to evaluate allFalse, but we can partially evaluate it using a function like take. So can we represent our universe like this? >genInfiniteUniverse :: [Bool] -> [Bool] >genInfiniteUniverse known_universe = allFalse ++ known_universe ++ allFalse Let's try it: take 10 ( genInfiniteUniverse initial_universe ) [False,False,False,False,False,False,False,False,False,False] Nope! Since the left-hand side of the universe is infinite, we will never reach the middle element, no matter how far we travel from the start of the list! That's no good. However, we can do it another way. We'll allow our universe to be expanded on demand on the left and right sides: >expandUniverse :: Int -> [Bool] -> [Bool] >expandUniverse expand_by known_universe = > ( take expand_by allFalse ) ++ known_universe ++ ( take expand_by allFalse ) expandUniverse 3 initial_universe [False,False,False,True,False,False,False] We can use the expandUniverse function to expand our initial universe out to a standardized width before we start applying the rules. First, here's a routine to stringify a universe for display: >boolToChar :: Bool -> Char >boolToChar True = '#' >boolToChar False = ' ' >stringifyUniverse :: [Bool] -> String >stringifyUniverse ls = map boolToChar ls Now our infrastructure is in place, so let's figure out how to apply our generator rule. We know that we want to start with our initial universe. Let's expand it to a fixed size. This will give us enough elements to start making left/center/right tuples out of each consecutive set of three cells. Each tuple is then used to look up the next state of the cell at the center; this will become an element in our next universe. Then we move to the next cell (not three cells down). This means that the tuples overlap. Let's make the tuples. We have to do some thinking here and consider all the cases; the behavior isn't immediately obvious. The following almost works: universeToTuples :: [Bool] -> [(Bool, Bool, Bool)] universeToTuples universe | length universe >= 3 = ( universe !! 0, universe !! 1, universe !! 2 ) : universeToTuples ( tail universe ) universeToTuples universe = [] universeToTuples [False, True, True, True, False] [(False,True,True), (True,True,True), (True,True,False)] But it isn't quite right; it leaves off the end cases; when we apply our rules, the intermediate representation of the universe as a list of tuples to look up cell mappings will shrink. We actually want the following tuples: [(False,False,True), (False,True,True), (True,True,True), (True,True,False), (True,False,False)] where the first element of the list is considered as if it was just to the right of an implied False, and the last element is considered as if it was just to the left of another implied False. This sounds like another place we can use our universe expander: >universeToTuples :: [Bool] -> [(Bool, Bool, Bool)] >universeToTuples [] = [] >universeToTuples universe = tupleize $ expandUniverse 1 universe > where > tupleize xs = > if length xs > 3 then tuple3 xs : tupleize ( tail xs ) > else [ tuple3 xs ] > tuple3 xs = ( xs !! 0, xs !! 1, xs !! 2 ) Why did I write it that way? Well, I tried to write tupleize using guards, special-casing length xs > 3 followed by an unguarded case for all other possibilities, but GHC didn't like it -- it told me I had non-exhaustive patterns. There is probably a smarter way to write this, but note that we definitely don't want this version: universeToTuples universe = ( xs !! 0, xs !! 1, xs !! 2 ) : universeToTuples ( tail xs ) where xs = expandUniverse 1 universe In that version, the universe keeps expanding as we walk down the list, and we never get to the end! OK, now that we have our tuples, we want to turn them into our new universe, given a cellular rule number: >tuplesToUniverse :: Int -> [(Bool, Bool, Bool)] -> [Bool] >tuplesToUniverse rule [] = [] >tuplesToUniverse rule (tup:tups) = genNextBit rule tup : tuplesToUniverse rule tups Note that we don't have to explicitly take the tail since we provide a name for it in the pattern. We're ready to define our genUniverses function that applies a given CA rule. We can express a given generation like this: >nextUniverse :: Int -> [Bool] -> [Bool] >nextUniverse rule universe = tuplesToUniverse rule $ universeToTuples universe Now, let's generalize it: >genUniverses :: Int -> Int -> Int -> [[Bool]] >genUniverses rule width count = take count > ( iterate ( nextUniverse rule ) ( expandUniverse ( width `div` 2 ) initial_universe ) ) (You could also use a fold, and I'm sure there are lots of other ways to do it, but iterate seems to work fine). And now, witness the unfolding of a universe! Note that the parameters that go to genUniverses are the rule number, the width for display, and the number of generations: putStr $ unlines $ map stringifyUniverse $ genUniverses 222 19 10 # ### ##### ####### ######### ########### ############# ############### ################# ################### In general, a width of twice the number of generations - 1 will show all the transitions we are interested in; you could consider the diagonal area above to be the "light cone" of events causally connected to that single point (although some rules will generate True cells outside of that "light cone" based on the other False values in the initial universe). Let's make a helper function to choose a width for us: >showRule rule gens = > putStr $ unlines $ map stringifyUniverse $ > genUniverses rule ( gens * 2 - 1 ) gens Let's try a few of the other rules: showRule 252 15 # ## ### #### ##### ###### ####### ######## ######### ########## ########### ############ ############# ############## ############### showRule 78 15 # ## ### ## # ### # ## # # ### # # ## # # # ### # # # ## # # # # ### # # # # ## # # # # # ### # # # # # ## # # # # # # ### # # # # # # And finally, my all-time favorite, which simulates a Sierpinski gasket: showRule 82 32 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Wow!

Followup: I had mentioned that my code had a bug, because some pictures, such as this one:

showRule 29 11 # ######### ########### # # ######### ########### # # ######### ########### # # ######### ########### # # ######### ########### # #

look different than the way Wolfram's book and web site shows them, which is like this:

# ######### ########### # ######### ########### # ######### ########### # ######### ########### # ######### ########### #

After a little investigation this seems to be because Wolfram's implementation wraps around; the left neighbor of the leftmost cell of a given universe is taken from the rightmost cell, and vice-versa, while my implementation pretends that there is always more empty space available to the left and right.

Whether you consider this a bug or not is up to you. The wraparound behavior is probably considered more "canonical." You can compare the results from my program to the pictures at Wolfram's MathWorld site here. If you replace my universeToTuples function with this one:

universeToTuples :: [Bool] -> [(Bool, Bool, Bool)] universeToTuples [] = [] universeToTuples universe = tupleize $ wrapUniverse universe where wrapUniverse xs = ( last xs ) : ( xs ++ [ head xs ] ) tupleize xs = if length xs > 3 then tuple3 xs : tupleize ( tail xs ) else [ tuple3 xs ] tuple3 xs = ( xs !! 0, xs !! 1, xs !! 2 )

you will get the wraparound behavior.

Thanks for reading and as always, I appreciate your comments.

## 4 comments:

Hi Paul,

I guess the bug is the truncation of the list at the boundaries? Rule 29 seems to behave something like

r29 (False,True,_) = True

r29 (_,_,True) = False

r29 (_,False,_) = True

so with the extended universe having a [..False,True,True..] at the boundary, it becomes True. Not sure if this makes too much sense, though I get (what seems to be) the proper answer by expanding one step more, and then taking the tail of the list before stringify.

Wonderful stuff, though: I've been learning haskell off and on for quite some time now, but never really had this kind of motivation by example through examples :)

I experimented with adding in extra False values to the left and right, but I was not able to get my code to generate results that look like Wolfram's. Now I know why.

It appears that Wolfram's implementation actually wraps at the boundary. According to Wolfram's book A New Kind of Science "we effectively use a cyclic array, in which the left neighbor of the leftmost cell is taken to be rightmost cell, and vice versa."

I'll take a shot at implementing that behavior; I'm not sure I would actually call that solution more correct than pretending we have infinite space available, but it does seem to be more canonical.

Now that your program is getting more sophisticated, it could benefit from rolling your own types. After all, stringifyUniverse shouldn't accept

any oldlist of Bool, it should accept a Universe!> type Cell = Bool

> type Universe = [Cell]

> type Neighborhood = (Cell, Cell, Cell)

> type Rule = Neighborhood -> Cell

Give some helpers to abstract away the Boolness of your Cells:

> alive = True :: Cell

> dead = False :: Cell

Then type your functions accordingly:

> rule :: Int -> Rule

> applyRule :: Rule -> Neighborhood -> Cell

> allDead :: Universe

> neighborhoodAt :: Universe -> Int -> Neighborhood

> universeToNeighborhoods :: Universe -> [Neighborhood]

> neighborhoodsToUniverse :: Rule -> [Neighborhood] -> Universe

> nextUniverse :: Rule -> Universe -> Universe

That way, your program should be more resilient to underlying type changes. You could change Universe to an Array, or Cell to:

> data Cell = Dead | Alive deriving (Eq)

And the compiler will tell you what you need to change (which should only be the definitions of alive and dead)! Not to mention that the code reads like natural language!

The bug in your code is not obvious to me, so I would probably rewrite universeToTuples in terms of this neighborhoodAt:

> u `neighborhoodAt` i = (u' !! i, u' !! i + 1, u' !! i + 2)

> where u' = [dead] ++ u ++ [dead]

One more thing, if you find yourself writing (a -> String) functions a lot, consider making an instance of Show:

> instance Show Cell where

> show cell = if cell == alive then "#" else " "

>

> instance Show Universe where

> show = concat . map show

Then printing a Universe at the top level will automatically stringify it.

Nicholas, thanks for the wonderful suggestions! That is a lot of new techniques; they will take me a while to digest.

I have added an alternate version of universeToTuples that makes my CA generation behave like Mathematica's.

I think I am going to take a break from this for at least 48 hours so I can get some sleep! I want to think over just what I'm going to try next.

Post a Comment