Printing Cellular Automata
- To: mathgroup at smc.vnet.net
- Subject: [mg41592] Printing Cellular Automata
- From: jeremyrfoster at hotmail.com (Jeremy Foster)
- Date: Wed, 28 May 2003 04:57:25 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
I have been trying to create cellular automata. I realize that
funtions exist already, but my ultimate goal is to print large posters
of the results and so I am trying to do it manually.
I have two issues: 1. My code takes an enormous amount of time and
memory to run... it doesn't seem like it should be that difficult...
and 2. The resulting bitmap file (TIF) does not come out crisp and
defined... it has imperfections even when very large and thus won't
print perfectly.
Below is my code... please run it and see if you can help me optimize
it and/or give me any clues on how to print it right:
(*BitTest is the rule to see what value a certain cell should be... I
am using the famous rule 30 here*)
BitTest[i_, j_, k_] := If[(i==1 && j==0 && k==0) || (i==0 && j==1 &&
k==1) || (i==0 && j==1 && k==0) || (i==0 && j==0 && k==1), 1, 0]
(*A w value over ~800 takes major resources and usually fails before
finishing*)
w = 400;
h = Floor[w/GoldenRatio];
l1 = Table[1, {i, 1, h}, {j, 1, w}];
l1[[h]] = Table[If[j == w/2, 1, 0], {j, 1, w}];
(*Here's where I actually modify each row based on the previous row*)
Do[Do[l1[[i, j]] = If[j > 1 && j < w, BitTest[l1[[i + 1, j - 1]],
l1[[i + 1, j]], l1[[i + 1, j + 1]]], 0], {j, 1, w}], {i, h - 1, 1,
-1}]
(*Then I have to invert the values to match my logic*)
Do[Do[l1[[i, j]] = If[l1[[i, j]]==0, 1, 0], {j, 1, w}], {i, 1, h}]
(*I export the results as a tif file to avoid lossy compression, but
it still doesn't look very good*)
Export["Rule30.tif", ListDensityPlot[l1, {AspectRatio -> h/w,
ImageSize -> {w, h}, Mesh -> False, Frame -> False}], "TIFF"]
- Follow-Ups:
- Re: Printing Cellular Automata
- From: Tomas Garza <tgarza01@prodigy.net.mx>
- Re: Printing Cellular Automata