NKS Time Series

({{, }})

Jason Cawley

Wolfram Research, Inc.

Initialization

$TextStyle={FontSize->18};

Off[General::spell1];

GetFredSeries[seriesname_]:=With[{list=First/@Import["http://research.stlouisfed.org/fred2/series/"<>seriesname<>"/downloaddata/"<>seriesname<>".txt","TSV"]},ToExpression[{StringSplit[#[[1]],"-"],#[[2]]}&/@StringSplit/@Drop[list,
Position[list,_?(StringMatchQ[#,"DATE"~~Whitespace~~"VALUE"]&),Heads->False][[1,1]]]]]/.{year_,month_,day_}->{year,month,day,0,0,0}

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

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

AccCAseries[rule_, init_, steps_]:= FoldList[Plus,0,FoldList[Plus,0, Total/@(CellularAutomaton[rule,init,steps]/. 0->-1)]]

WeightedCAseries[rule_, init_, steps_, scale_:.01,type_:0]:= With[{weights =Ceiling[Reverse[Range[Length[init]]]^.5]}, FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale*Abs[#2])]&], type, Total/@((weights/Mean[weights]) * CellularAutomaton[rule,init,steps]/. 0->-1)]]

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

CAseries3ColorWtd[{rule_, init_, steps_, scale_:.01,type_:0},{wt0_,wt1_,wt2_}]:= FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale* Abs[#2])]&], type, Total/@(CellularAutomaton[rule,init,steps]/.{0->wt0,1->wt1,2->wt2})]

norm[data_]:= Transpose[ {First/@data,Last/@data/(First[Last/@data])}]

lognorm[data_]:= Transpose[ {First/@data,Log[Last/@data/(First[Last/@data])]/Log[2]}]

datedivide[data_,series_]:= Transpose[ {First/@data,(Last/@data)/Take[series,Length[data]]}]

dateapply[data_, func_]:= Transpose[ {First/@data,func[Last/@data]}]

datemap[data_, func_]:= Transpose[ {First/@data,func/@(Last/@data)}]

rl[num_]:= MapThread[Rule,{Tuples[{1,0},3],IntegerDigits[num,2,2^3]},1]

ICAStep[rules_List, init_, choice_]:= #&@Partition[init,3,1,2]/.  rl[  rules[[choice+1]] ]

ICA[rules_List,init_List, interact_List]:= FoldList[ICAStep[rules,#1,#2]&,init, interact]

ICAseries[data_, scale_:.005, type_:0]:= FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale* Abs[#2])]&], type, Total/@(data/. 0->-1)]

ICAinitials = Table[RandomInteger[{0,1},100],{100}];

GCAinitials = Table[RandomInteger[{0,1},100],{100}];

ICAinteracts = Table[Random[BernoulliDistribution[0.01 i]],{i,0,100},{400}];

GCAStep[rules_List,init_]:= #&@Partition[init,3,1,2]/.  rl[  rules[[If[Total[init/. 0->-1]≥ 0,1,2]]] ]

GCA[rules_List, init_List, steps_]:= NestList[GCAStep[rules,#]&, init, steps]

GCAseries[data_, scale_:.005, type_:0]:= FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale* Abs[#2])]&], type, Total/@(data/. 0->-1)]

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};

The standard model - random walks

With[{sample = Table[Random[],{100},{100}]},Manipulate[ListPlot[FoldList[If[#2-0.5>0,#1(1+changescale (#2-0.5)),#1/(1+changescale Abs[#2-0.5])]&, 1, sample[[i]]],PlotRange->{0,4},GridLines->Automatic,PlotLabel->"Arithmetic Random Walks, No Trend",Filling->Bottom],{{changescale,.2},0,.5,.01},{i,1,100,1},SaveDefinitions->True]]

Adding a trend

With[{sample = Table[Random[],{100},{100}]},Manipulate[ListPlot[FoldList[If[#2-0.5>0,#1(1+trendrate + changescale (#2-0.5)),#1 (1+trendrate)/(1+ changescale Abs[#2-0.5])]&, 1, sample[[i]]],GridLines->Automatic,Filling->Bottom,PlotLabel->"Geometric Random Walks with Trend Rate"],{{trendrate,.01},0,.05,.0025},{{changescale,.2},0,.50,.01},{i,1,100,1}]]

All the randomness we see is explicitly added to the system every step from outside - in economic terms, it is "new information".  By construction, only an exponential trend and standard deviation are predictable.  Independence of each random bit means no "runs", no "mean reversion", no serial correlations or local patterning.  Randomness in, Gaussian statistics out.  Still, a good simple model of some economic phenomena.  This model (or the continuous limit based on it), is by far the most widespread model of financial times series in general use.

Wolfram's proposal and example

Wolfram's idea is to have a simple program generate the randomness we see intrinsically, instead.  A plausible, if simple and idealized, microbehavior, is shown to produce in the aggregate, intrinsically random behavior similar to that seen in price series.

First let's reproduce the picture on page 432 of the NKS book, and explain the basic idea.

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};

TableForm[{ArrayPlot[CellularAutomaton[90,bookinitial,60], Mesh->True,ImageSize->250,PlotLabel->"Microstate: Black Buy, White Sell"],ListPlot[FoldList[Plus, 0, Total/@(CellularAutomaton[90,bookinitial,60]/. 0->-1)],Frame->True,ImageSize->500, Axes->False, PlotLabel->"Macrostate: Resultant Price Series"]}, TableDirections->Row]

What is attractive about this idea?

Here, there is randomness in the initial conditions of the CA, to be sure.  That still comes from outside the model.  But the subsequent evolution of the system is deterministic.  No new information need enter, for ongoing variations to be seen in the resultant price behavior.  There is a micro-economic interpretation of the forces driving the price.  There may be recurrent patterns in the data.  In principle, if the model were accurate, there might be local predictability to the price series.  There are numerous model aspects that might be modified or extended to model different empirical cases (change the rule, add a third color, etc.  We will see more later on).  We may get Gaussian randomness out, but for some choices of those modifications, we also might not.  We haven't set that in stone, right at the outset, as we effectively do with standard random walks.  So instead of forcing every phenomena into a single model and treating everything else as random, we get a range of possible models, some of which might apply better to some real world series while others apply to others, etc.

Geometric version

An early superficial criticism of Wolfram's proposal was that real financial series are known to behave more like geometric than arithmetic series.  It is trivial to incorporate that suggestion into the model - we just multiply successive terms of the series to get the next, instead of adding.  This introduces a scaling parameter, effectively what percentage change a single cell in the underlying CA can be expected to impart to the price series on one time step.

Let' s write a general function that will accept any ECA rule and either use Wolfram' s original addition or the more traditional geometric series, multiplying each step by the previous, and including such a scaling parameter.

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

We can continue the book initial series.  Now the step to step changes are still driven by the excess of black over white cells, but each translates to a 1% change in the price, rather than a single absolute unit of price.  For modest series length the result looks very similar to an arithmetic series.

ListPlot[CAseries[90,bookinitial, 100,.01,1],ImageSize->300, Frame->True]

Let' s look at a sample of the typical behavior from random initial conditions.

With[{sampleinits = Table[RandomInteger[{0,1},50],{100}]},Manipulate[ListPlot[CAseries[90,sampleinits[[i]], 100,scale,1],ImageSize->400,GridLines->Automatic,Filling->Bottom,PlotRange->{0,4}],{i,1,100,1},{{scale,.01},.005,.03,.0025},SaveDefinitions->True]]

4

The initial conditions here are random, but the time evolution is not.  Each is the same deterministic system, just starting from a different point.  If you start from the exact same initial, you will get the same series.  The randomness we see step to step above, is internally generated by the system, not added to it at each step from outside.

Notice the clear runs.  In this model, the time series have "memory" - where it goes next is not independent of what just happened.  It is not trivial to see what will happen next, because the series itself is only a symptom of the microstate, and equal levels of the series may correspond to different microstates, which will each have their own deterministic continuation.

Other ECA rules

Rule 225

The geometric version of Rule 225 trends nicely, with believable local variations.  It thus approximates "noisy exponentials" reasonably well.

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListPlot[CAseries[225,sampleinits[[i]], steps,scale,1],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->{0,yscale}],ArrayPlot[CellularAutomaton[225,sampleinits[[i]],steps],ImageSize->400]},TableDirections->Row],{i,1,100,1},{{scale,.004},.001,.02,.001},{{yscale,4},2,40,1},{{steps,40},10,100,1},SaveDefinitions->True]]

Rule 45

The arithmetic version of Rule 45 gives local noise, diffusion like variations from one initial condition to another, occasional "runs", and predictably limited long run variance.

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListLinePlot[Table[CAseries[45,sampleinits[[i+j]], steps],{j,1,3}],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->{-25 Round[steps^.5],25 Round[ steps^.5]},Filling->Bottom],Sequence@@Table[ArrayPlot[Take[CellularAutomaton[45,sampleinits[[i+k]],steps],-Min[steps,120]],ImageSize->200],{k,0,2}]},TableDirections->Row],{i,1,95,1},{{steps,100},50,400,10},SaveDefinitions->True]]

Rule 30

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListPlot[CAseries[30,sampleinits[[i]], steps,scale,1],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->{0,yscale}],ArrayPlot[CellularAutomaton[30,sampleinits[[i]],steps],ImageSize->400]},TableDirections->Row],{i,1,100,1},{{scale,.004},.001,.02,.001},{{yscale,4},2,40,1},{{steps,40},10,100,1},SaveDefinitions->True]]

Longer ranges and more colors

The ECA rule space is limited, with only a modest number of rules giving plausible sequence behaviors.  We can easily expand the rule space either by looking at longer range rules, or by expanding the number of colors we allow on the array.  3 color CAs in particular have a natural "interpretation" for series generation - instead of +1 or -1 contributions for "buy" and "sell", now we also have 0, or "hold".  The 3 color range 1 totalistic rules give a modestly larger rule space, with 2187 possible rules.  A fair portion of these aren't useful because they strongly favor one or two of their possible colors.  But many can be found with interesting series behavior.  Note that you can always find a rule with a "reciprocal" trend, by interchanging the +1 and -1 colors throughout its entire rule table.

2 color range 2 rules

When we go from range 2 to range 3, the number of possible rules jumps from 256 to 4.3 billion.  There are a number that will be equivalent and many of them show class 2 behavior too simple to be useful as generators of time series.  It can be harder to find plausible rules in so large a space.  Here are some I've found that give reasonable series, from 3 basic types of pattern (well mixed, and slanted or symmetric large white triangles).  I am sure there are literally thousands more rules useful for series generation, though the number of distinct types of behavior is of course more modest.

2^2^5

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListPlot[CAseries[{rule,2,2},sampleinits[[i]], steps,.0005,0],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All],ArrayPlot[CellularAutomaton[{rule,2,2},sampleinits[[i]],steps],ImageSize->400]},TableDirections->Row],{i,1,100,1},{rule,{1221225743,1221225759,1221225775,2147483472,2147483488,2147483528,2147483578,2147483582,2147483592,2147483594,2147483596,2147483610}},{{steps,40},10,100,1},SaveDefinitions->True]]

3 color totalistic rules

We can keep the space of 3 colors rules to a modest size if we consider totalistic rules, which do not depend on the exact configuration in their neighborhood but only an overall count.  There are 2187 range 1 rules of this type.

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

somegoodk3rules = {132,145,146,147,150,156,184,187,468,480,529,534,1510,1522,1526,1531,1541,1556,1562,1598};

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListLinePlot[CAseries3Color[{rulenum,{3,1}},sampleinits[[i]], steps,.01,0],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All],ArrayPlot[CellularAutomaton[{rulenum,{3,1}},sampleinits[[i]],steps],ImageSize->400,ColorRules->{0->Red,1->White,2->Green}]},TableDirections->Row],{i,1,100,1},{rulenum,{132,145,146,147,150,156,184,187,468,480,529,534,1510,1522,1526,1531,1541,1556,1562,1598}},{{steps,40},10,100,1},SaveDefinitions->True]]

3 color general rules, changing color weights

Those rules were all totalistic.  General 3 color rules can give a wider variety of behaviors, but it can be harder to search through all of them for interesting examples.  The space is much larger, 7.6 trillion possible rules, as you can see from the much larger rule numbers.  They also tend to have average concentrations that can dominate them with a too-strong trend.  Instead of looking for the rules that switch the roles of each color in this large space, it is easier to adjust for such trends by having the series routine "weight" the original 0s, 1s, and 2s in the CA array with different values.

Here are a few rules Kovas Boguta considered interesting for other reasons, used to generate series.

3^3^3

CAseries3ColorWtd[{rule_, init_, steps_, scale_:.01,type_:0},{wt0_,wt1_,wt2_}]:= FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale* Abs[#2])]&], type, Total/@(CellularAutomaton[rule,init,steps]/.{0->wt0,1->wt1,2->wt2})]

kovasrules = {1618526094,3635262236,2573331611,1652677715,1407112772,3383419825,1753244537};

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListLinePlot[CAseries3ColorWtd[{{rulenum,3,1},sampleinits[[i]], steps,.01,0},{wt0,wt1,wt2}],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All],ArrayPlot[CellularAutomaton[{rulenum,3,1},sampleinits[[i]],steps],ImageSize->400,ColorRules->{0->Red,1->White,2->Green}]},TableDirections->Row],{i,1,100,1},{rulenum,{1618526094,3635262236,2573331611,1652677715,1407112772,1753244537}},{{steps,40},10,100,1},{wt0,{-2,-1,0,1,2}}, {wt1,{-2,-1,0,1,2}},{wt2,{-2,-1,0,1,2}},SaveDefinitions->True]]

The first rule works best with {1,0,-2} weights.  The second works with {0,1,-1}.   The third with {0,1,-2}.   The fourth works with {1,-1,0}.   The fifth works with {-1,0,2}, as does the sixth, same weights.  Of course you can get series that flip the typical direction of their trend by reversing the sign of the weights different from 0.

Uneven cell weights

In our micro interpretation of CA generated series, we are adding up buys and sells from distinct entities, treating each cell as exactly like the others.  In real financial or economic systems, it is common for one trader to have more weight in the market and another to have less.  We can readily explore the effect of allowing varying cell weights.  Here I weight the left side of the array more heavily than the right side - imagine right to left the traders are sorted by the size of their typical trades.  Then we can see the original series without weights, and how adding weights changes it.

WeightedCAseries[rule_, init_, steps_, scale_:.01,type_:0, weightexponent_:0.5]:= With[{weights =Ceiling[Reverse[Range[Length[init]]^weightexponent]]}, FoldList[If[type==0, Plus, If[#2>0,#1(1+scale* #2),#1/(1+scale* Abs[#2])]&], type,
(Dot[#,( weights/Mean[weights])]&)/@ (CellularAutomaton[rule,init,steps]/. 0->-1)]]

weightsgraph =#/Mean[#]&/@ (1.Ceiling[Reverse[Range[100]^#]]&/@{0.25,0.5,1,2});

ListLinePlot[weightsgraph, Filling->Bottom]

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListLinePlot[{WeightedCAseries[rule,sampleinits[[i]], steps,.01,1,wtexpon],CAseries[rule,sampleinits[[i]], steps,.01,1]},ImageSize->400,GridLines->Automatic,PlotRange->All],ArrayPlot[CellularAutomaton[rule,sampleinits[[i]],steps],ImageSize->400]},TableDirections->Row],{i,1,100,1},{rule,{90,30,45,225}},{wtexpon,{0.5,0.25,1.,2.}},{{steps,40},10,100,1},SaveDefinitions->True]]

It is a plausible way of tuning series generated from CAs.  The basic characteristics remain, but some movements are amplified.  I also note that the differences in series look a lot like the differences between related indices e.g. high "beta" small caps compared to large caps, and the like.  If you think of how indices are constructed from weighted subholdings, there may be some formal correspondence.

Second difference or acceleration series, for smooth signals

If we use CA data to get the second differences of a list instead of the first differences - in programming terms, doing the "FoldList" operation twice - then we get series that effectively have "momentum", with the CA series giving the "accelerations".  These series are plausible for a variety of physical systems, perhaps more than for economics or finance.   It shows one possible model of smoother data.

AccCAseries[rule_, init_, steps_]:= FoldList[Plus,0,FoldList[Plus,0, Total/@(CellularAutomaton[rule,init,steps]/. 0->-1)]]

With[{sampleinits = Table[RandomInteger[{0,1},100],{100}]},Manipulate[TableForm[{ListLinePlot[AccCAseries[rule,sampleinits[[i]], steps],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All],ArrayPlot[Take[CellularAutomaton[rule,sampleinits[[i]],steps],-Min[steps,100]],ImageSize->400]},TableDirections->Row],{i,1,100,1},{rule,{90,30,45,225}},{{steps,40},10,200,1},SaveDefinitions->True]]

Think you can guess the continuation of this rule 90 series, as I increase the number of steps?

In all the cases we have looked at so far, we have used a single CA rule for an entire run.  Another possible extension is to allow the rule applied on each step to vary from step to step.  There are two obvious ways of doing this that are already well developed - the Global Cellular Automaton or GCA, and the Interactive Cellular Automaton or ICA.  In a GCA, the rule applied depends on the current state in some global way - e.g. is the series increasing or decreasing?  In an ICA, the rule applied is specified by an external sequence, thought of as arising outside the system and influencing its evolution.

GCA rationale and example

The idea of the GCA examined here is to apply a different rule when the total of the previous step is positive or zero, than when it  is negative.  While other global functions can be used in GCAs, this is the natural way for global behavior to feed back into and influence the behavior of each cell (trader) across the array.  While we could look at all possible rules, I restrict attention to "crosses" between the 4 we have already seen and a selection of rules that give reasonable behavior for at least some of them.

Manipulate[With[{data = GCA[{rule1,rule2},GCAinitials[[init]],steps]},TableForm[{ListPlot[GCAseries[data,.005,0],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All]
,ArrayPlot@Take[data,-Min[steps,120]]},TableDirections->Row]]
,{rule1,{30,45,90,225}},{rule2,{11,15,19,23,27,30,43,45,50,51,54,55,58,60,62,73,75,81,83,85,86,89,90,94,101,102,105,106,109,110,114,117,118,120,121,122,124,126,129,135,137,147,149,150,153,161,165,169,182,186,188,190,193,195,201,202,206,216,217,218,222,225,227,230,233,234,238,241,242,246,248,250,254}},{init,1,100,1},{steps,40,400,5},SaveDefinitions->True]

The ICA approach and an example

ICA stands for interactive cellular automaton, the "machine with input" version of a CA.  The idea here is to model something like new information entering the system, with immediate global effects on every part of the array.

With the ICA set up, instead of determining the rule used on the next step based on whether the series is increasing or decreasing, we just specify it directly from an external sequence.  When the next term of this sequence - which I call an interaction condition - is 0, we use our first rule.  When the next term of the interaction condition is 1, we use our second rule.  We can then mix the rule applications in any order.  And we can dial between all steps using one rule and all steps using the other, by changing the portion of 1s in our interaction condition.  This idea can be generalized to any number of rules, but to keep things simple, here I look at just the simplest, 2 rule case.

Manipulate[With[{data = ICA[{rule1,rule2},ICAinitials[[init]],Take[ICAinteracts[[portion+1]],steps]]},TableForm[{ListPlot[ICAseries[data,.0015,1],ImageSize->400,GridLines->Automatic,AxesOrigin->{0,0},PlotRange->All]
,ArrayPlot@Take[data,-Min[steps,120]]},TableDirections->Row]]
,{{rule1,90},{30,45,90,225}},{{rule2,110},{11,15,19,23,27,30,43,45,50,51,54,55,58,60,62,73,75,81,83,85,86,89,90,94,101,102,105,106,109,110,114,117,118,120,121,122,124,126,129,135,137,147,149,150,153,161,165,169,182,186,188,190,193,195,201,202,206,216,217,218,222,225,227,230,233,234,238,241,242,246,248,250,254}},{init,1,100,1},{portion,0,100,1},{steps,40,400,5},SaveDefinitions->True]

Fitting a real stock price series with the ICA model

The first series shows the real stock price of Goldman Sachs since the start of 2006.  

The rest are all ICA fits, all using the same mix of 8/9 rule 90 and 1/9 rule 110 applications, chosen from a sample of initial and interaction conditions for good least squares fit to the modeled series.  

The best fits used the following scaling parameters, which are all closely clustered around the 0.001 value (meaning, 10 basis points of daily change per excess black cell in the 100 wide initials used).

Mean[{0.00115, 0.001, 0.0009,0.00107,0.00102,0.0009700, 0.000980, 0.000920, 0.001140,0.0008600,  0.0009400, 0.0011400, 0.001100,0.000900, 0.0012300, 0.0009400, 0.0010300, 0.0009300, 0.0009500, 0.00090300, 0.0010500, 0.0010600, 0.0010400}]

The Plots

({{, , , }, {, , , }, {, , , }, {, , , }, {, , , }, {, , , }})

I have not yet tried further tuning of these promising fits by making point chances to their initials or interaction conditions.  Nor did I search across a wide space of ICA rule mixes - I just estimated a promising concentration for 2 rules only using a Manipulate like the one above, and then generated a sample of initials and interaction conditions, and measured the least squares fits across the sample, retaining the best.  Over 1% of the sample gave fits this good without further tuning.

Return and Net Counterparty Analysis

One of the nice things about having a micromodel is that it immediately implies a number of other signals coming from the same data.  As we consider each vertical column the actions through time of some trading entity, we can sum down the columns to see what buys and sells each entity made, and "Dot" them into the price series to  generate that hypothetical trader's return.  We can also total those and see what net counterparty trades would have to exist - e.g. from market makers or issuers - for both money and the traded item to "clear" over the whole period.  Here is a single simple example using a geometric series from rule 90.

initial = RandomInteger[{0,1},50]

initial = {1,0,0,1,0,0,0,0,0,1,0,1,1,0,0,1,1,1,0,0,1,0,1,1,0,0,0,1,0,0,1,1,0,1,0,0,1,1,1,1,1,0,1,1,0,0,0,0,0,0};

data = CellularAutomaton[90,initial,60]/. 0->-1; series = CAseries[90,initial,60,.01,1]

TableForm[{ArrayPlot[CellularAutomaton[90,initial,60], Mesh->True,ImageSize->300,PlotLabel->"Microstate: Black Buy, White Sell"],ListPlot[CAseries[90,initial,60,.01,1],Frame->True,ImageSize->540, Axes->False, PlotLabel->"Macrostate: Resultant Price Series"]}, TableDirections->Row]

Note the structure of the white triangles.  A uniform black patch sends the next line to uniform white.   If everyone around me is buying at time t1, I try to sell at time t2.  Unfortunately, so does everyone else around me.  So the sharpest upward movements tend to be followed by sharp reversals.  Notice that perfect 1-0-1-0 patterns can also lead to white triangles.  It is rare that those are large, but they do happen, and allow large white patches to form without a previous sharp upward move.  Once a white triangle forms, it takes time for black to spread into it again.  Thus, sharp downward movements increase correlation from one step to the next.  The strength of that correlation - stemming from the portion of the pattern currently within such triangle structures - is highest at the initial, sharpest drop, and declines thereafter.  The overall average density of the pattern is about 50-50.  So there is more black, more buying, outside of such white triangles.  So in the absence of such correlated downdrafts, there is some natural upward tendency.  As regions approach uniform black, however, the chance of a long black row rises, and every such row results in a reversal.

stockheld = Table[ FoldList[Plus,0,data[[All,i]]],{i,Length[data[[1]]]}];

ListLinePlot[stockheld,PlotRange->All]

Let's look at the first column in detail.  The cash position is the negative of whatever was paid for buys.  Sells contribute positively, of course.

cash =Drop[ FoldList[Plus,0,-data[[All,1]] * Drop[series,1]],1]

stockvalue = Drop[stockheld[[1]],1] * Drop[series,1]

ListLinePlot[{cash,stockvalue,cash+stockvalue},PlotLabel->"Blue Cash, Purple Stock, Brown Total",Filling->Axis]

stockheld[[1]]

The first "trader" was heavily "short" twice early on, while the price was rising modestly.  But managed to be slightly long right before the peak around step 48, and lost overall.

Let's use Manipulate to scan through the same graph for the rest of the traders.

allcash = Table[Drop[ FoldList[Plus,0,-data[[All,i]] * Drop[series,1]],1],{i,1,Length[data[[1]]]}]; allstockvalue = Table[ Drop[stockheld[[j]],1] * Drop[series,1],{j,1,Length[data[[1]]]}]; allnet = allcash + allstockvalue;

Manipulate[ListLinePlot[{allcash[[trader]],allstockvalue[[trader]],allnet[[trader]]},PlotLabel->"Blue Cash, Purple Stock, Brown Total",Filling->Axis],{trader,1,Length[data[[1]]],1},SaveDefinitions->True]

Look at traders 2, 12, 20, and 39 as examples.  2 is a typical "long" who gets ahead before the crash but loses in it, for a modest net loss overall.  12 is long throughout the "bull" and well ahead until the crash.  But starts to sell before it, starting around step 36, so cash is back to zero by the time of the crash.  The crash reduces the winnings but it makes money overall.  ("I always sold too soon" said one of the Rothschilds).  20 is long for a portion of the early "bull" but with little net effect.  Basically no net change up to step 38.  Then goes strongly short and wins in the crash.  39 is short during the long early "bull", manages to go long right before the crash, then gets out afterward and is left with large losses.

Let's plot all the net returns together.

TableForm[{ListLinePlot[allnet,PlotLabel->"Total Returns, All Traders",PlotRange->All,GridLines->Automatic,ImageSize->400],ListPlot[Sort[Last/@allnet],PlotLabel->"Sorted Final Returns",PlotRange->All,Filling->Axis, GridLines->Automatic,ImageSize->400]},TableDirections->Row]

Note the massive shift in net winners and losers caused by the crash.  The shape of the sorted final returns is not quite a normal distribution "smile" at mean zero - that would intercept at the midpoint of 25 e.g. - but is reasonably close.

counterpartycash = -Total[allcash,1]

counterpartystock = -Total[data,1]

{Last[counterpartycash],Total[counterpartystock]}

ListLinePlot[counterpartycash]

I submit that this microanalysis describes a more plausible model of a typical financial "bubble" than anything previously offered in the feedback-based literature on "rational bubbles".

Working with FinancialData

FinancialData in Mathematica

The new Mathematica 6 function FinancialData provides a comprehensive sight for financial information, focused on stocks but including indices, currencies, and the like.

Here is an example, Bank of America monthly stock prices for the last 10 years, shown with a moving average of the previous 12 months.

A sample stock price series with a moving average

bac = FinancialData["BAC", {1997,7,1,0,0,0}];bacmov = dateapply[bac,PadLeft[ListConvolve[Table[1/125,{125}],#],Length[#]]&];
Show[DateListPlot[bac,GridLines->Automatic],DateListPlot[bacmov, Joined->True]]

Side by side indices with Tooltip labels

Here is are daily price charts for a number of indices for the year to date, normalized for comparison.

DJIA = {"Dow",norm[FinancialData["^DJI", {2006,1,1,0,0,0}]]};
SP500 = {"SP500",norm[FinancialData["^GSPC", {2006,1,1,0,0,0}]]};
NASDAQ ={"NASDAQ", norm[FinancialData["^IXIC", {2006,1,1,0,0,0}]]};
Russ2000 = {"R2000Small",norm[FinancialData["^RUT", {2006,1,1,0,0,0}]]};
DateListPlot[Tooltip[#[[2]],#[[1]]]&/@{DJIA,SP500,NASDAQ,Russ2000},Joined->True, GridLines->Automatic]

FRED

The Federal Reserve provides a database of economic times series data through a website run by the St. Louis Fed.  It is known at "FRED" for Federal Reserve Economic Database, and can be found at http://research.stlouisfed.org/fred2/  The provide the raw data in text or Excel formats.  It is straightforward to write an importer function that takes any FRED series variable name and goes to the correct URL to retrieve the data, stripping off headers and putting everything in the {date, value} format expected by the Mathematica functions SerialPlot and SerialLinePlot.  FRED data is public and anyone may use it for any purpose, free.   All these series should soon be available through the FinancialData function, but at the moment Import allows us to do it ourselves.

GetFredSeries[seriesname_]:=With[{list=First/@Import["http://research.stlouisfed.org/fred2/series/"<>seriesname<>"/downloaddata/"<>seriesname<>".txt","TSV"]},ToExpression[{StringSplit[#[[1]],"-"],#[[2]]}&/@StringSplit/@Drop[list,
Position[list,_?(StringMatchQ[#,"DATE"~~Whitespace~~"VALUE"]&),Heads->False][[1,1]]]]]/.{year_,month_,day_}->{year,month,day,0,0,0}

Here is an example -

GDP = GetFredSeries["GDP"]; DateListPlot[GDP, PlotLabel->"Nominal US GDP, $ Billions", Joined->True,Filling->Bottom]

Sample economic data series

Some price series data looks like that  - stock prices in particular.  Some economic data series are considerably smoother, however.  Some can be modeled adequately as simple exponentials, some cannot.  Let's look at a few examples of the variety seen in real economic time series.

These are all taken from the Federal Reserve Economic Database at the St. Louis Fed - better known as "Fred".

US GDP

This one is pretty nearly a simple exponential.  Some of it is inflation and some is real growth.

GDP = GetFredSeries["GDP"]; SerialLinePlot[GDP,FrameTicks->{DateTicks[{"ShortYear"},15,TickLabelAlignments->Center],Automatic,None,None}, PlotLabel->"Nominal US GDP, $ Billions"]

With[{constant7 = Transpose[{First/@GDP,Log[Table[1.07^(i/4),{i,0,Length[GDP]-1}]]/Log[2]}],rate6106 = Transpose[{First/@GDP,Log[FoldList[#1 (1+#2)^(1/4)&, 1, Flatten[{Table[.06,{76}],Table[.10,{64}],Table[.06,{96}]}]]]/Log[2]}]},
SerialLinePlot[{lognorm[GDP],constant7,rate6106},FrameTicks->{DateTicks[{"ShortYear"},15,TickLabelAlignments->Center],Automatic,None,None},GridLines->Automatic,PlotLabel->"Log of GDP in Doublings since 1947, with Trends"]]

There is a higher slope in the 1970s, a period of higher than normal inflation rather than higher than normal real growth.  The middle trend line - in purple - is a constant 7%.  The blue line shows actual GDP.  The third, 3-segment line shows 6% from 1947 to 1966, 10% from 1967 to 1982, then 6% again until the present.

Money Supply, M2

M2SL = GetFredSeries["M2SL"]; SerialLinePlot[M2SL,FrameTicks->{DateTicks[{"ShortYear"},15,TickLabelAlignments->Center],Automatic,None,None}, PlotLabel->"M2 Money Stock, $ Billions"]

With[{constant7 = Transpose[{First/@M2SL,Log[Table[1.07^(i/12),{i,0,Length[M2SL]-1}]]/Log[2]}] ,rate6106 = Transpose[{First/@M2SL,Log[FoldList[#1 (1+#2)^(1/12)&, 1, Flatten[{Table[.07,{144}],Table[.10,{156}],Table[.06,{92}],Table[.01,{48}],Table[.06,{127}]}]]]/Log[2]}]} ,
SerialLinePlot[{lognorm[M2SL],constant7 ,rate6106 },FrameTicks->{DateTicks[{"ShortYear"},15,TickLabelAlignments->Center],Automatic,None,None},GridLines->Automatic,PlotLabel->"Log of GDP in Doublings since 1947, with Trends"]]

This time it takes 5 distinct periods to map major changes in M2 with simple exponentials.  While we can always fit the data that way, such a model is becoming implausible.  A better explanation is that M2 is chained to nominal GDP, and that their deviations are damped by restoring forces.  But there is sufficient short term "play" between them that modest differences can and do occur.

SerialLinePlot[{GDP,Transpose[{First/@M2SL,1.92 Last/@M2SL}]},FrameTicks->{DateTicks[{"ShortYear"},15,TickLabelAlignments->Center],Automatic,None,None},PlotLabel->"US GDP vs. Twice M2 Money Supply"]

Corporate Profits

CPATAX = GetFredSeries["CPATAX"]; DateListPlot[CPATAX, Joined->True,Filling->Bottom,PlotLabel->"After Tax Corporate Profits, $ Billions"]

People who remember the late 90s stock market bubble are often surprised by this graph.  That sustained, downward kink in profits runs from mid 1997 to mid 2001, precisely when the stock market had its biggest fling.  Profits peaked 3 years before the market did.  They have done much better since - as we will see next, basically returning to trend.

DateListPlot[{lognorm[CPATAX],Transpose[{First/@CPATAX,Log[Table[1.08^(i/4),{i,0,Length[CPATAX]-1}]]/Log[2]}]},Joined->True,GridLines->Automatic,PlotLabel->"Log of Corporate Profits in Doublings since 1947, with Trend"]

The trend is pronounced - 8% per year - and does not show signs of "wandering" over long time scales, as diffusion would.  On short time scales, however, the variations are much sharper than in the previous examples.  Let's look next at the signal remaining when we remove the trend.

datedivide[norm[CPATAX],Table[1.08^(i/4),{i,0,Length[CPATAX]-1}]]

DateListPlot[datedivide[norm[CPATAX],Table[1.08^(i/4),{i,0,Length[CPATAX]-1}]],GridLines->Automatic,PlotLabel->"Normalized Corporate Profits Divided by Trend"]

Now that is a complex signal, one that calls for either a stochastic or a simple-programs based model.  But pure diffusion would be a poor model of it, as it seems to be anchored to a trend set by smoother exponential processes - GDP or money supply growth or both.  Notice the runs even in the noise portion.

Interest Rates

GS10 = GetFredSeries["GS10"]; DateListPlot[GS10,Joined->True, PlotLabel->"10 Year Treasury Note, Constant Maturity Rate, %"]

This is clearly  a non-stationary process.   The amplitude varies, there are distinct periods of trend, and extreme values related to particular large scale monetary episodes.  Three or more random walks with fundamentally different parameter values, all stapled together, might attempt to model it.  But there is little reason to think this is the result of simple diffusion.

We can however get some clue by comparing the series produced by compounding at those rates to others we have seen.

With[{cumulative = dateapply[GS10, Drop[FoldList[(#1 ((1+#2/100.)^(1/12))&),1,#],1]&],rate4107 = Transpose[{First/@GS10,Log[FoldList[#1 (1+#2)^(1/12)&, 1, Flatten[{Table[.04,{204}],Table[.095,{192}],Table[.06,{254}]}]]]/Log[2]}]},
DateListPlot[{lognorm[cumulative],rate4107 }
,Joined->True,GridLines->Automatic, PlotLabel->"Log 10 Year Treasury Note Compound Return, Doublings"]]

First/@{GS10[[204]],GS10[[396]]}

So in detail, we have a very noisy and non-stationary process driving the geometric differences of a smoother cumulative result.  That smoother result shows similar intrinsic periods to nominal GDP, reflecting large changes in inflation expectations, with a sizable lag (4 years at least).

Exchange Rates

EXUSUK = GetFredSeries["EXUSUK"]; EXJPUS = GetFredSeries["EXJPUS"]; EXSZUS = GetFredSeries["EXSZUS"]; 
EXKOUS = GetFredSeries["EXKOUS"]; EXINUS = GetFredSeries["EXINUS"];EXSFUS = GetFredSeries["EXSFUS"];

DateListPlot[{datemap[EXUSUK,1/#&],datemap[EXJPUS,#/100&], EXSZUS},Joined->True, PlotLabel->"Pound, 100 Yen, SwFr per US Dollar", PlotRange->All]

Last/@First/@{EXJPUS, EXSZUS, EXUSUK}

1/#&/@(Last/@Last/@norm/@{EXJPUS, EXSZUS, EXUSUK} )^(12/Length[EXJPUS])

DateListPlot[norm/@{ EXKOUS , EXINUS, EXSFUS},Joined->True, PlotLabel->"Normalized Won, Rupee, Rand per US Dollar", PlotRange->All]

Last/@Last/@norm/@{EXKOUS , EXINUS, EXSFUS}

Length/@{ EXKOUS , EXINUS, EXSFUS}

Last/@Last/@norm/@{EXKOUS , EXINUS, EXSFUS} ^{12/315, 12/414, 12/438}

Extreme variety is evident.  We see some periods that look like random diffusion, others that are smoother, or have sharp one-time shocks, runs, etc.

Title Page

ListPlot[FoldList[Plus, 0, Total/@(CellularAutomaton[90,bookinitial,60]/. 0->-1)],Frame->True,ImageSize->400, Axes->False, PlotLabel->"Wolfram Rule 90 Price Model"]

shortNASDAQ = FinancialData["^IXIC", {{2006,3,31},{2006,6,30}}];DateListPlot[shortNASDAQ,PlotRange->All, Frame->True,ImageSize->400,Axes->False,PlotLabel->"A few months of NASDAQ"]

Walks with local correlation - Markov Machines

Another way to introduce extra flexibility to standard random walks is to keep a basically random model, but to allow local correlations.  In a Markov chain, one imagines the system has a number of possible states, and at each step transitions to some other possible state according to a list of probabilities, which depend only on the state the system is currently in.  A state transition matrix (STM) specifies the rule.  

An NKS approach to Markov chains is to enumerate them, starting from the simplest.  When the number of states is low and the transition probabilities are all given by rationals with only a few options e.g. {1, 1/2, 0}, or {1, 2/3, 1/3, 0}, or {1, 3/4, 1/2, 1/4, 0}, it is straightforward to assign each STM a number, and then evolve samples of them to see how they typically behave.  I call these enumerated, simple Markov chains "Markov machines", on the analogy of finite state machines.  Indeed, when the probabilities are restricted to {1, 0} you get deterministic finite state machines, which are thus a proper subset of Markov machines.

To get from a Markov machine to a time series, we just need a list of changes to associate with each of the system states.  A Markov machine with 2 states interpreted as +1 and -1, with a 2x2 STM with 1/2 in all 4 places, gives a simple random walk.  I'll show examples below that instead use 6 states corresponding to smaller and larger positive and negative moves, with transition probabilities down to 20% fineness.

I have a bunch of Mathematica code to enumerate small MMs and to generate series data from them, which I can provide to those interested.  I won't try to explain any of it now.

MM Code

SeedRandom[868687897911121]

numrules[chance_Integer,size_Integer]:= Length[Compositions[chance,size]]^size

stm[rn_Integer, chance_Integer, size_Integer]:= With[{big = Compositions[chance,size]},
  Transpose[Part[big,1+IntegerDigits[rn,Length[big],size]]/(1.chance)]]

next[mat_, current_Integer]:= With[{a=Random[Real]},
  For[j=1,j≤  Length[mat],j++,
   If[a< Total[Table[mat[[i,current]],{i,1,j}]],
Return[j]
    ]]]

trajectory[mat_, start_Integer,steps_Integer]:= NestList[next[mat,#]&,start,steps]

SetOptions[ArrayPlot,ColorRules->{0->White, 1->Black,2->Red,3->Blue,4->Green,5->Purple,6->Yellow,7->Cyan,8->Brown,9->Gray}];

imat[size_]:= Table[If[i==j,1,0],{i,1,size},{j,1,size}]

evolveMM[{rn_Integer, chance_Integer, size_Integer}, steps_Integer,sample_Integer]:= With[{mat= With[{mixes= Compositions[chance,size]},
     Transpose[Part[mixes,1+IntegerDigits[rn,Length[mixes],size]]/(1.chance)]]},Table[Sort[Table[trajectory[mat,i,steps],{sample}]],{i,1,size}]]

reportMM[{rn_Integer, chance_Integer, size_Integer},data_]:= With[{samplesize = Length[data[[1]]],matrixsize = Length[data]},TableForm[{AccountingForm[TableForm[stm[rn, chance, size],TableHeadings->Automatic],3],TableForm[Transpose[Table[Count[data[[i]],j,2],{i,1,size},{j,1,size}]- samplesize imat[matrixsize]],TableHeadings->{None,Automatic}]},TableDirections->Row,TableSpacing->10]]

showMM[{rn_Integer, chance_Integer, size_Integer},data_]:= With[{n = If[size==5||size==6||size==9,3,4]},
  TableForm[Partition[Table[ArrayPlot[Transpose[data[[i]]-1],ImageSize->Small],{i,1,size}],n,n,{1,1},{}]]]

longrun[mat_]:= (#/Total[#])&/@Select[Eigenvectors[mat],FreeQ[#,_Complex]&&(SameQ@@Sign/@DeleteCases[Chop[#],0])&]

trend[mat_,changes_]:= Dot[changes,longrun[mat][[1]]]

TSfromStates[traj_List, changes_List, method_Integer:0]:= With[{base = traj/.MapThread[Rule, {Range[Length[changes]],changes}]},Which[method==1,Drop[FoldList[Plus,0,Drop[FoldList[Plus,0,base],1]],1],method==2,FoldList[Times,1.,1+(base/100.)],True, Drop[FoldList[Plus,0,base],1]]
]

oneSeries[{chances_, states_, rulenumber_:0} , changeslist_,steps_, start_:1,changetype_:0]:= With[{rule = If[rulenumber==0,Random[Integer,numrules[chances, states]], rulenumber]},
TSfromStates[trajectory[stm[Sequence@@{rule,chances,states}],start,steps],changeslist,changetype]]

MMseries[chances_, states_, changeslist_, rulenumber_:0]:= With[{rule = If[rulenumber==0,Random[Integer,numrules[chances, states]], rulenumber]},With[{data =Table[trajectory[stm[Sequence@@{rule,chances,states}],1,100],{20}]},
Manipulate[ListLinePlot[Table[Take[TSfromStates[data[[i]],changeslist,changetype/.{"add"->0, "accel"->1,"mult"->2}],steps],{i,1,sample}],PlotRange->All, PlotLabel-> rule],
{{sample,5},1,20,1},{{steps,30},10,100,5},{changetype,{"add","accel","mult"}}]]]

MMserieslong[chances_, states_, changeslist_, rulenumber_:0]:= With[{rule = If[rulenumber==0,Random[Integer,numrules[chances, states]], rulenumber]},With[{data =Table[trajectory[stm[Sequence@@{rule,chances,states}],1,500],{20}]},
Manipulate[ListLinePlot[Table[Take[TSfromStates[data[[i]],changeslist,changetype/.{"add"->0, "accel"->1,"mult"->2}],steps],{i,1,sample}],PlotRange->All, PlotLabel-> rule],
{{sample,5},1,20,1},{{steps,30},10,500,10},{changetype,{"add","accel","mult"}}]]]

<<Histograms`

statreport[{args___},samplesize_]:= With[{data = Last/@Table[oneSeries[args],{samplesize}]},TableForm[{Histogram[data, ImageSize->Medium]," Mean"1.Mean[data]," SD"1.StandardDeviation[data]}]]

MMItrajectory[matrices_, start_Integer,whichmatrix_]:= FoldList[next[matrices[[#2]],#1]&,start,whichmatrix]

evolveMMIs[{rules_List, chance_Integer, size_Integer}, whichrules_List,sample_Integer]:= With[{matrices= stm[#,chance,size]&/@rules},
Table[Sort[Table[MMItrajectory[matrices,i,whichrules],{sample}]],{i,1,size}]]

reportMMIs[{rules_List, chance_Integer, size_Integer},data_]:= With[{samplesize = Length[data[[1]]],matrixsize = Length[data]},TableForm[{AccountingForm[TableForm[stm[#, chance, size]&/@rules,TableHeadings->Automatic],3],TableForm[Transpose[Table[Count[data[[i]],j,2],{i,1,size},{j,1,size}]- samplesize imat[matrixsize]],TableHeadings->{None,Automatic}]},TableDirections->Row,TableSpacing->10]]

showMMIs[{rules_List, chance_Integer, size_Integer},data_]:= With[{n = If[size==5||size==6||size==9,3,4]},
  TableForm[Partition[Table[ArrayPlot[Transpose[data[[i]]-1],ImageSize->Small],{i,1,size}],n,n,{1,1},{}]]]

MMIseries[rules_List, changeslist_,whichrules_List, start_:1,changetype_:0]:= 
TSfromStates[MMItrajectory[rules,start,whichrules],changeslist,changetype]

MM Times Series Examples

Grid[Partition[Tooltip[ListLinePlot[Table[oneSeries[{5,6,#},{-4,-2,-1,1,2,4},50],{5}],PlotLabel->#],stm[#,5,6]//MatrixForm]&/@Table[Random[Integer,numrules[5,6]],{20}],5]]

There are plenty of theorems available about MMs.  We can solve for the drift term by finding an eigenvector of the STM with all signs the same, which gives a mix of system states that is on average stable under repeated application of the STM.  For "well mixed" STMs, we can deduce that the eventual behavior is Gaussian, from the effective independence of long runs that have visited all states.

Notice, however, that long run Gaussian statistics do not preclude trading on local correlations.  Trading is effectively a weight applied to different portions of the series any way one likes.  If you can spot them, you can overweight the more predictable portions.

Pure NKS uses of series data

We can use the idea of totaling across a CA for purposes other than generating time series for modeling.  It can also simply tell us something about the behavior of the CA, in a way sometimes easier to visualize.  A useful feature of lossy mappings is that they maintain or reduce the apparent complexity of the underlying behavior, but do not increase it.  If the CA shows class 1 behavior - reaching a fixed point - then so will the total over it.  If the CA cycles, the total will cycle.  If the CA is quite random, the total is overwhelmingly likely to be random as well - though occasionally you might see an apparent cycle.  

One can also scan through CAs looking for "waveforms" that might appear in some measurement.  It is easy to find involved "sinus rhythm" patterns, for example.  You can also scan through short initial conditions, looking for distinct cycle lengths e.g. to find some initials that take a long time to become strictly periodic in a system of limited size.  You can also explore how rapidly transients disappear and the system seems to "synch" up.  All can be much more apparent in the simplified 1 dimensional graph of concentration through time.

Manipulate[With[{data = CellularAutomaton[rule,IntegerDigits[initial,2,20],{50,All}]},TableForm[{ArrayPlot[data], ListLinePlot[Total/@data,PlotRange->{0,20},ImageSize->400]},TableDirections->Row]],{{rule,54},0,255,1},{{initial,41610},0,2^20-1,1}]

Ideas for Future Extensions

Go 2D and model entire indices

A CA model includes more microdata than a random walk because it generates the overall series from an array of higher dimension.  We might extend this idea to modeling entire tables of prices series - for example, a whole index of stocks - using a single 2 dimensional CA.  Then slices through the array would be treated just as we have done so far, but in addition neighboring slices of the array would correspond to the behavior of a "neighboring" stock.  Index behavior would result from adding up the behavior of all the separate series, or totaling through the array.  Such a model would generate series for the index, for all its components, and trading results for each trader in each stock and overall.  All in one CA run.  The challenge would be to find CA rules that gives reasonable levels of correlation and randomness across index components and across traders.

Fit a data series with a linear combination of CA "basis" series

We showed many ways of altering the single proposed rule 90 model shown in the NKS book.  One obvious use of that variety would be to conduct searches for "closest fits" to some existing data series.   A hybrid approach would be to pick some "basis" of CA rules and some limited sample of initial conditions for each, and then to find the linear combination of those "basis" series that minimizes a least squares difference function, compared to some given data series.  You'd get a result of the form "this series looks like 65% rule 90 from IC X plus 25% rule 225 from IC Y plus 10% rule 45 from IC Z".

Fit a data series with an ICA and iterative search

A more purely NKS approach would be to use an ICA, and fit in pure NKS terms.  First you'd pick a set of rule types based on general characteristics of the data - these 4 rules go into the ICA.  Then search through the arbitrarily involved space of wider initials, different initial conditions, and different interaction conditions.  You'd measure the difference from the data in the same way as the previous, as your "objective function".  Now search the {initial, interaction} space for a best fit, retaining the best several measures so far and making point changes to them.  Initially the changes might be large and then they'd taper off to point changes, in "simulated annealing" fashion.