problem calculating a square simplex IFS triangularization
- To: mathgroup at smc.vnet.net
- Subject: [mg123959] problem calculating a square simplex IFS triangularization
- From: Roger Bagula <roger.bagula at gmail.com>
- Date: Mon, 2 Jan 2012 02:47:18 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
A very simple 3 color IFS?
This code is based on a simplex triangularization of a triangle.
Does anybody have simplex triangularizations for other shapes?
Clear[f, dlst, pt, cr, ptlst]
dlst = Table[ Random[Integer, {1, 3}], {n, 50000}];
f[1, {x_, y_}] := {1/2 + x/2 - y/2, 1/2 - x/2 - y/2}
f[2, {x_, y_}] := {y, 0}
f[3, {x_, y_}] := {1/2 - x/2 - y/2, 1/2 - x/2 - y/2}
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]
I call this the tic tac toe simplex...
I found a simplex for square the hard way
and am having a hard time calculating it:
Clear[f, dlst, pt, cr, ptlst, a, r, x, y]
dlst = Table[ Random[Integer, {1, 17}], {n, 20000}];
r = 3.2;
a = Flatten[
Table[{1/2 + n*x/r + m*y/r, 1/2 + l*x/r + k*y/r}, {n, -1, 1,
2}, {m, -1, 1, 2}
, {l, -1, 1, 2}, {k, -1, 1, 2}], 3]
Length[a]
Log[Length[a] + 1]/Log[(1 + 16*r)/17]
f[1, {x_, y_}] := {y, 0}
Table[f[n, {x_, y_}] = a[[n - 1]], {n, 2, Length[a] + 1}]
pt = {0.5, 0.5};
cr[n_] :=
Flatten[Table[
If[i == j == k == 1, {}, RGBColor[i, j, k]], {i, 0, 1, 0.5}, {j,
0, 1, 0.5}, {k, 0, 1, 0.5}]][[1 + Mod[n, 26]]];
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]
The problem is Mathematica hates this code.
I'm trying to find the optimum ratio r such that the square is just
closed.
It might work with fewer transforms as well ( I just threw everything
at it).