janos
CT
Registered: Nov 2004
Posts: 23 
Steven Wolfram visited Yale on this Monday, and "Manipulate" looks promising. His lecture started this classification issue in me as I was driving home. I started some explorations yesterday. I did not look yet into the NKS book to see if Wolfram did similar ones or not, so please correct me id I am on secret ground.
I looked only the k=2, r=1 cases. I tried to recreate his page from the book where he shows all of them in a page, but GraphicsArray just did not want to cooperate with me. So I created a Table like this:
ca = Table[CellularAutomaton[{i, k, r}, Join[Table[0, {l, 255}], {1}], 255], {
i, 1, 255}];
Note that my initial conditions are 255 white on the left and one black cell on the right.
Then I created an entropy like quantity  its is entropy like only because it contains the Log of some other quantity.
lp = Table[Map[N[Log[FromDigits[Reverse[#]]]] &, ca[[i]] ], {i, 255}];
One element in lp is a list of the Logs of numbers where the number was created from the status of the automata at a given step. I wanted to see how these numbers are for all the elementary rules.
As you can see I am back in the "looking with the eye" stage. One has to start somewhere :). Then I was thinking that it might be interesting to see a similar value for the Transpose of the CA, that is looking every cell "down" from the top and take the value it is created as that position changed its value from step to step, so I created another table:
tp = Table[Map[N[Log[
FromDigits[Reverse[#]]]] &, Transpose[ca[[i]] ] ], {i, 255}];
Then I was thinking it might be interested to see these two tables in relation to each other and look if any clustering is happening there. I had to make sure that the two tables are equal lengths. So, I created a fourth table:
tl = Table[Thread[List[lp[[i]], tp[[i]] ] ], {i, 255}];
and plotted all these side by side. Then it came to me that it would be nice if I can see how the different values on a graph would look like, so I created a fifth table:
tlgp = Table[Map[#[[1]] > #[[2]] &, Partition[tl[[i]], 2, 1]], {i, 255}];
and plotted one automata in a row with all their created table elements with:
Table[Show[
GraphicsArray[{ArrayPlot[ca[[i]], DisplayFunction > Identity], \
ListPlot[lp[[
i]], AspectRatio > 1, PlotRange > All,
AxesOrigin > Automatic, DisplayFunction > Identity],
ListPlot[tp[[i]], AspectRatio > 1,
PlotRange > All, AxesOrigin > Automatic, DisplayFunction >
Identity], ListPlot[tl[[
i]], AspectRatio > 1, PlotRange > All,
AxesOrigin > Automatic, DisplayFunction > Identity],
GraphPlot[tlgp[[i]], "RootPosition" >
Center, Method > "Automatic", DisplayFunction > Identity]}],
DisplayFunction > $DisplayFunction, PlotLabel > {i}], {i,
255}];
At the end I through in
<<RealTime3D
and looked the particulary interested graphs with GraphPlot3D, like:
GraphPlot3D[tlgp[[3]], "RootPosition" > Center, Method > "Automatic"]
Now I know why rule 110 is universal. It has two ears to hear and a nice necktie to be member of the intelligentia !!
GraphPlot3D[tlgp[[110]], "RootPosition" > Center, Method > "Automatic"]
Looks like all Class 3 shows some interesting triangular clustering pattern in tl[[rule]]  the forth plot in a row. Also all Class 4 type show a different kind of clustering in tl with a wide gap between the cluster elements. It is also interesting that all Class 3 is a straight line in tlgp. On the same time almost all Class 2 and Class 4 has some closed graphs in tlgp.
The reason I wanted to see the GraphPlot of the tlgps is that when you look the Listplot of tl[[45]] and tl[[110]] with PlotJoined>True, it shows some structure. So I wanted to see which point on it is connected to another and that was why I ended up to create the tlgp table.
Interestingly the tlgp[102] is a perfect 16 sided polygon.
With the best,
J‡nos
__________________

"..because Annushka has already bought
sunflower oil, and not only bought it, but
spilled it too."
Bulgakov: Master and Margarita
Report this post to a moderator  IP: Logged
