Registered: Aug 2003
Posts: 712

I received a question through email about the finance section of chapter 8 of NKS, particularly wanting to reproduce the result on page 432. I thought I would post the response I sent here, as others may have the same question or be generally interested in this stuff.

First, the rule used in the section of the book is effectively rule 90.

The size of the array will indirectly tune the size of the fluctuations typically seen, as those scale roughly as the square root of the width. Wider <=> Higher "Volatility".

The one step that may cause some confusion is the "running total" bit, and the "difference in black and white cells". One can of course just count the black cells, which is Mathematica terms is simply the function Total mapped over the list of rows. Instead Wolfram counted the difference between black and white cells, the whites effectively counting as -1. That is also trivial to do in Mathematica - you can just multiply the whole array
by 2, and then subtract 1, and Mathematica automatically does that to each element of the array. Or you could use a rule assignment, /. 0->-1 (read "ReplaceAll 0s with -1s") which is even easier.

These gave Wolfram not the absolute value of the price but its series of first differences. His price series is then the running total of those numbers. In Mathematica, that is the function FoldList with the function Plus and a base of 0. Last you want to ListPlot the results - he used a fancy tickmark to replicate a stock market ticker, but I won't worry about that.

As for the initial condition he used, it can be read right out of the book. It is -


bookinitial = 
{1,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,0,0,1};

That stores that list in the variable bookinitial. Now we just need to run all the above operations with it as the CellularAutomaton's starting point. So we write -


ListPlot[FoldList[Plus, 0, Total/@ (CellularAutomaton[90,bookinitial,63]/. 0->-1) ] ]


And there it is.

There are 2^35 possible initial conditions of that width - 34 billion of them. Of course you can change the width and see how it changes the typical series you get.

That uses an arithmetic running total. You can also take the first
differences geometrically, as percentage changes in effect. You just need to use a slightly more complicated function in the FoldList. Here I've written a function to do it either way, with the same arguments as CellularAutomaton - rule, initial, steps - and an optional 4th argument, which does the arithmetic version with a 0 and the geometric version for 1.


CAseries[rule_, init_, steps_, type_:0] :=
FoldList[If[type == 0, Plus, #1(1 + .01 #2) &], type,
Total /@ (CellularAutomaton[rule, init, steps] /. 0 -> -1)]


Then I'd just ListPlot the results of that function, as follows -


ListPlot[CAseries[90, bookinitial, 63,1]


The "1" as 4th argument tells CAseries to use the geometric difference method instead of the arithmetic.

I've attached a notebook that contains all of the above. To use it you need Mathematica obviously. Just evaluate (shift-return) each of the cells with code rather than text commentary, and you will see all the results.

Then you can try different rules, initial conditions, widths, steps,
arithmetic vs. geometric series - to your heart's content.

I wrote the routines so the function first gives you the data, and then the second built in function ListPlot shows it to you. That way you can assign the data itself to a variable e.g. -


mydata = CAseries[90,bookinitial, 63]


And then use all the other built in functions in Mathematica
on mydata - just a list of numbers. So you can ask for e.g.


{Mean[mydata], StandardDeviation[mydata]}


Or use any of the other built in statistics functions, etc.

I hope this is interesting.

Attachment: timesseriesfromcas5.nb
This has been downloaded 1640 time(s).

Report this post to a moderator | IP: Logged