color assignment in an Mathematica IFS
- To: mathgroup at smc.vnet.net
- Subject: [mg79324] [mg79324] color assignment in an Mathematica IFS
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Tue, 24 Jul 2007 06:12:58 -0400 (EDT)
A problem that was partially solved by Bob Hanlon in a
post a while back on color in IFS.
The Wellin type IFS in Mathematica or the McClure digraph method
are both black and white. I do a lot of work on IFS fractals of
different types.
I found a dreadfully slow Do loop code that maybe someone
can speed up.
I put a color privative in a point array, so that the point comes out
having color.
I make a "data structure" of color and Point.
I found the starting Mathematica code at Dr. Frame's ( the Mandelbrot
course at Yale)
web pages.
Mathematica:
(* from Symbol Driven IFS - Four Bins : Dr. Frame - Yale *)
Off[General::spell];
Off[General::spell1];
(* Random table on {1, 2, 3, 4}*)
dlst = Table[Random[Integer, {1, 4}], {n, 10000}];
Length[dlst]
(* paste the data between the {} in dlst = {}, comma separated
numbers, 1 through 4 *)
(*Sierpinski space fill in four squares*)
f[1, x_, y_] := {0.5*x, 0.5*y}
f[2, x_, y_] := {0.5*x + 0.5, 0.5*y}
f[3, x_, y_] := {0.5*x, 0.5*y + 0.5}
f[4, x_, y_] := {0.5*x + 0.5, 0.5*y + 0.5}
ptlst = {PointSize[.01]};
pt = {0.5, 0.5};
(* color privative assignment function*)
cr[n_] := If[n - 1 == 0, RGBColor[0, 0, 1], If[n - 2 == 0, RGBColor[0,
1, 0],
If[n - 3 == 0, RGBColor[1, 0, 0], RGBColor[0, 0, 0]]]];
(* color, Point structure Do loop iterated: instead of the Nest usually
used in the Wellin code*)
Do[{x = pt[[1]], y =
pt[[2]], pt[[1]] = f[dlst[[j]], x, y][[1]], pt[[2]] = f[dlst[[j]], x,
y][[2]], ptlst = Flatten[{ptlst, cr[dlst[[j]]],
Point[pt]}]}, {j, 1, Length[dlst]}]
Show[Graphics[ptlst], AspectRatio -> Automatic, PlotRange -> All]
- Follow-Ups:
- Re: color assignment in an Mathematica IFS
- From: Daniel Lichtblau <danl@wolfram.com>
- Re: color assignment in an Mathematica IFS