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).