Re: problem calculating a square simplex IFS triangularization
- To: mathgroup at smc.vnet.net
- Subject: [mg123968] Re: problem calculating a square simplex IFS triangularization
- From: Roger Bagula <roger.bagula at gmail.com>
- Date: Tue, 3 Jan 2012 05:25:58 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <jdrnmg$935$1@smc.vnet.net>
This set is the triangulation analog of the tic tac toe set in pentagons done as a level like L system ( by guess and by golly). Dr. McWorter's pentagree and Penrose's pattern are probably related. This result is a 5th type Simplex self-similar fractal. I had a hard time just getting an approximation of the third level. There should be some simple recursive pattern here! Mathematica: Clear[v, x, y, g, g1, g2, vv, s, x1, y1] x[n_] := N[Cos[n*2*Pi/5]]; y[n_] := N[Sin[n*2*Pi/5]]; x1[n_] := N[Cos[n*2*Pi/5 + 2*Pi/5]]; y1[n_] := N[Sin[n*2*Pi/5 + 2*Pi/5]]; x2[n_] := N[Cos[n*2*Pi/5 + Pi/10]]; y2[n_] := N[Sin[n*2*Pi/5 + Pi/10]]; x3[n_] := N[Cos[n*2*Pi/5 + 3*Pi/20 + 0.01]]; y3[n_] := N[Sin[n*2*Pi/5 + 3*Pi/20 + 0.01]]; v = Join[{{0, 0}}, Table[{x[n], y[n]}, {n, 1, 5}]]; v1 = Join[{{0, 0}}, Table[{-x1[n], y1[n]}, {n, 1, 5}]]; s = Sqrt[5*Sqrt[5]] - 0.05; vv[n_] := v1/s^(n) g = Table[Line[{1, n}], {n, 2, 6}]; vv1[n_] := v/s^(n) g1 = Table[ Graphics[ GraphicsComplex[Table[vv[1][[m]] + {-x1[n], y1[n]}/2, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; g2 = Graphics[ GraphicsComplex[v, Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]] Show[{g1, g2}] g3 = Table[ Graphics[ GraphicsComplex[ Table[vv1[2][[m]] + {-x[n], -y[n]}/2.9, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; g4 = Table[ Graphics[ GraphicsComplex[ Table[vv1[2][[m]] + {x2[n], y2[n]}/2.1, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; g5 = Table[ Graphics[ GraphicsComplex[ Table[vv1[2][[m]] - {x2[n], y2[n]}/2.1, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; g6 = Table[ Graphics[ GraphicsComplex[ Table[vv1[2][[m]] + {x3[n], y3[n]}/1.59, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; g7 = Table[ Graphics[ GraphicsComplex[ Table[vv1[2][[m]] + {x3[n], -y3[n]}/1.58, {m, 1, 6}], Join[g, {Line[{2, 3, 4, 5, 6, 2}]}]]], {n, 1, 5}]; Show[{g1, g2, g3, g4, g5, g6, g7}]