Re: Printing Cellular Automata
- To: mathgroup at smc.vnet.net
- Subject: [mg41640] Re: Printing Cellular Automata
- From: Jens-Peer Kuska <kuska at informatik.uni-leipzig.de>
- Date: Thu, 29 May 2003 08:14:10 -0400 (EDT)
- Organization: Universitaet Leipzig
- References: <bb1u66$9de$1@smc.vnet.net>
- Reply-to: kuska at informatik.uni-leipzig.de
- Sender: owner-wri-mathgroup at wolfram.com
Hi,
have you looked into the help for
?CellularAutomaton
especial into the "Future Examples" ?
Something like
RasterGraphics[(state_)?MatrixQ, colors_Integer:2,
opts___] := Graphics[
Raster[Reverse[255*(1 - state/(colors - 1))],
{{0, 0}, Reverse[Dimensions[state]]}, {0, 255},
ColorFunction -> GrayLevel], AspectRatio ->
(AspectRatio /. {opts} /. AspectRatio -> Automatic),
opts]
gg = Show[RasterGraphics[CellularAutomaton[30, {{1}, 0}, 800]]];
Export["ca.tif", gg, "TIFF", ConversionOptions -> {"ImageScaling" ->
False},
ImageResolution -> 600]
will do what you want.
Regards
Jens
Jeremy Foster wrote:
>
> 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"]