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}]