Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

[Date Index] [Thread Index] [Author Index]

Search the Archive

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




  • Prev by Date: Re: Surprising DSolve problem
  • Next by Date: Re: Rule replacement doesn't work after NDSolve?
  • Previous by thread: problem calculating a square simplex IFS triangularization
  • Next by thread: How can I rasterize the selection in a notebook, preserving In/Out labels when appropriate?