Discussion:
fast fudge flake with color in Mathematica
(too old to reply)
Roger Bagula
2007-07-26 18:57:20 UTC
Permalink
This is a combination of Dr. Frame's driven program,
my color added and Dr. Lichtenbau of Mathematica "tuning" the code.
It is a three part fractile tile.
The code can be used for almost any IFS wanted.

Clear[f, dlst, pt, cr, ptlst]
dlst = Table[ Random[Integer, {1, 3}], {n, 250000}];
in = N[{{1, 0}, {-1/2, Sqrt[3]/2}, {-1/2, -Sqrt[3]/2}}];
f[j_, {x_, y_}] := {-y, x}/N[Sqrt[3]] + in[[j]]
pt = {0.5, 0.5};
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]]]];
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio ->
Automatic, PlotRange -> All]
Roger Bagula
2007-07-27 15:32:12 UTC
Permalink
I had some trouble at first getting old definitions of fractal tiles
into the new
fast color IFS, but I set up an affine matrix and fed in the results.
I tested it here on the Rauzy tile IFS.
It appears to be very good in most cases
that I've tested so far.

Clear[f, dlst, pt, cr, ptlst]
dlst = Table[ Random[Integer, {1, 3}], {n, 20000}];
rotate[theta_] := {{Cos[theta], -Sin[theta]}, {Sin[theta], Cos[theta]}};
NSolve[x^3 - x^2 - x - 1 == 0, x]
an = Table[Arg[x^n] /. NSolve[x^3 - x^2 - x - 1 == 0, x][[1]], {n, 1, 3}];
M = Table[(Abs[x^n] /. NSolve[x^3 - x^2 - x - 1 == 0, x][[1]])*rotate[
an[[n]]], {n, 1, 3}];
in = Table[{Re[x^n] /. NSolve[
x^3 - x^2 - x - 1 == 0, x][[1]], Im[x^
n] /. NSolve[x^3 - x^2 - x - 1 == 0, x][[1]]}, {n, 1, 3}];
f[j_, {x_, y_}] := M[[j]]. {x, y} + in[[j]]

pt = {0.5, 0.5};

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]]]];
ptlst = Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
{j, Length[dlst]}];

Show[Graphics[Join[{PointSize[.001]}, ptlst]], AspectRatio ->
Automatic, PlotRange -> All]


Respectfully, Roger L. Bagula
11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814
:http://www.geocities.com/rlbagulatftn/Index.html
alternative email: ***@sbcglobal.net

Loading...