wolframscience.com

A New Kind of Science: The NKS Forum : Powered by vBulletin version 2.3.0 A New Kind of Science: The NKS Forum > Applied NKS > Picture on Page 172 or 180
  Last Thread   Next Thread
Author
Thread Post New Thread    Post A Reply
Ayhan


Registered: Dec 2004
Posts: 4

Picture on Page 172 or 180

Ich would like to create the picture on page 172 or 180 with Mathematica,
unfortunately I do not have a good knowledge so well.

I would be thankful for every help.

Ayhan

Report this post to a moderator | IP: Logged

Old Post 12-16-2004 10:07 AM
Ayhan is offline Click Here to See the Profile for Ayhan Click here to Send Ayhan a Private Message Click Here to Email Ayhan Edit/Delete Message Reply w/Quote
Jason Cawley
Wolfram Science Group
Phoenix, AZ USA

Registered: Aug 2003
Posts: 712

The key bit of code to make 3D pictures of CAs is shown in the implimentation note on page 927, at the very end of the note. For clarity, you can use a function like -

displayCA3D[array_] := Show[Graphics3D[Map[Cuboid[-Reverse[#]] &, Position[array, 1]]]]

- to display data from a 2 color, 2D CA in three dimensions. That will just show a block ("cuboid") at the position of every "1" in the pattern. You might make that an initialization cell in a notebook to investigate these, for example.

Then any of the 2D CA evolutions we've already talked about - provided it is 2 color - can be stored in a variable as "data", and passed to the above to display it. (For more than 2 colors, you need to modify the function above, because it just stacks cubes where it sees 1s in the underlying data, ignoring everything else).

The picture on page 180 comes from outer totalistic, 9 neighbor CA number 174826. The picture on page 172 comes from outer totalistic, 5 neighbor rule 942. So, using what we discussed in the previous thread, you can get the underlying data from -

data = CellularAutomaton[{174826, 
{2, {{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}}, {1, 1}}, 
ReplacePart[Table[0, {100}, {100}]
1, Table[{50, 44 + i}, {i, 1, 11}]]
30];

or
data = CellularAutomaton[{942, 
{2, {{0, 2, 0}, {2,1, 2}, {0,2, 0}}}, {1, 1}}, 
ReplacePart[Table[0, {80}, {80}]
1, {40, 40}]
30];

Then show either one with
displayCA3D[data]

I'll explain the lines in the "data =" parts again. The first bit is just the call to CellularAutomaton and the rule number. The next bit specifies 2 color, outer totalistic and either 9 or 5 neighbors, using the "kernel" matrix for cell weights (and range 1 in each of 2 dimensions, the {1,1} at the end of that line). The next bit sets up an empty array, 100x100 or 80x80, and says to insert the part that comes next, into that blank array, as an initial condition. The next bit says what black cells to start with, where - a row 11 cells long in the first case, a single black cell in the second, in either case centered in the blank array. The last bit just says to evolve the CA for 30 steps.

I recommend only doing one of these 3D graphics in a single notebook, because you will tax your memory when actually rendering the 3D graphic. The data is a snap. But your CPU will have to work to render the 3D graphs of stacked cubes, and your memory will probably start paging - and thus slow down considerably - if you try to do two of them at once. Also, keep the number of steps low and the size of the background array managable. If you've pushed your machine too far, try aborting the evaluation and then retry with a smaller number of steps. Once the evaluation has finished, grab the corner of the graphic and drag it to expand the picture. You will see a lot more of the pattern, clearly, when you have a modest number of steps expanded to fill half the screen.

I hope this helps. Fine questions, by the way.

Report this post to a moderator | IP: Logged

Old Post 12-16-2004 04:18 PM
Jason Cawley is offline Click Here to See the Profile for Jason Cawley Click here to Send Jason Cawley a Private Message Edit/Delete Message Reply w/Quote
Ayhan


Registered: Dec 2004
Posts: 4

I thank you many times for your detailed reply,
you helped me very further.

I wish you a beautiful weekend.

Greetings

Ayhan

Report this post to a moderator | IP: Logged

Old Post 12-17-2004 10:00 AM
Ayhan is offline Click Here to See the Profile for Ayhan Click here to Send Ayhan a Private Message Click Here to Email Ayhan Edit/Delete Message Reply w/Quote
Post New Thread    Post A Reply
  Last Thread   Next Thread
Show Printable Version | Email this Page | Subscribe to this Thread


 

wolframscience.com  |  wolfram atlas  |  NKS online  |  web resources  |  contact us

Forum Sponsored by Wolfram Research

© 2004-14 Wolfram Research, Inc. | Powered by vBulletin 2.3.0 © 2000-2002 Jelsoft Enterprises, Ltd. | Disclaimer | Archives