Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

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

Search the Archive

Re: Memory usage of a Sierpinski triangle algorithm

  • To: mathgroup at smc.vnet.net
  • Subject: [mg124141] Re: Memory usage of a Sierpinski triangle algorithm
  • From: Roger Bagula <roger.bagula at gmail.com>
  • Date: Wed, 11 Jan 2012 04:18:45 -0500 (EST)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <jeh5po$r6k$1@smc.vnet.net>

Wojciech Morawiec

There are more ways to do a Sierpinski Gasket than about any other
fractal.
The Modulo two of the Pascal's triangle may be the simple one.
An IFS is a pretty simple way.
Many people like L-systems, but I prefer my own Besicovitch-Ursell
(biscuit) function:
Clear[f, g, h, k, s0, ff, ll, kk, mm, a, g3, ga]
f[x_] := 1 /; 0 <= x <= 1/3
f[x_] := 0 /; 1/3 < x <= 2/3
f[x_] := 1 /; 2/3 < x <= 1
ff[x_] = f[Mod[Abs[x], 1]]
Plot[ff[x], {x, 0, 4}]
g[x_] := 0 /; 0 <= x <= 1/3
g[x_] := 1 /; 1/3 < x <= 2/3
g[x_] := 0 /; 2/3 < x <= 1
gg[x_] = g[Mod[Abs[x], 1]]
Plot[gg[x], {x, 0, 4}]
s0 = N[Log[2]/Log[3]]
kk[x_] = N[Sum[ff[3^k*x]/3^(s0*k), {k, 0, 20}]];
Plot[kk[x], {x, 0, 4}]
ll[x_] = N[Sum[gg[3^k*(x)]/3^(s0*k), {k, 0, 20}]];
Plot[ll[x], {x, 0, 4}]
ParametricPlot[{ll[t], kk[t]}, {t, 0, 1}]
hh[x_] = N[Sum[gg[3^k*(x) + 1/2]/3^(s0*k), {k, 0, 20}]];
ParametricPlot[{hh[t], kk[t]}, {t, 0, 1}]
ParametricPlot[{ll[t], hh[t]}, {t, 0, 1}]

Here is the IFS version:
Clear[f, dlst, pt, cr, ptlst, M, p, a, b, c]
dlst = Table[ Random[Integer, {1, 3}], {n, 25000}];
rotate[theta_] := {{Cos[theta], -Sin[theta]}, {Sin[theta],
    Cos[theta]}};
NSolve[x^3 - 1 == 0, x]
an = Join[{N[-Pi/3]},
  Table[Arg[x^n] /. NSolve[x^3 - 1 == 0, x][[1]], {n, 1, 3}]]
M = Table[rotate[an[[n]]].{{0.5, 0}, {0, 0.5}}, {n, 1, 5}]
in = Join[{{0, 0}},
  Table[{Re[x^n] /. NSolve[x^3 - 1 == 0, x][[1]],
    Im[x^n] /. NSolve[x^3 - 1 == 0, x][[1]]}, {n, 1, 3}]]
f[j_, {x_, y_}] := M[[j + 1]]. {x, y} + in[[j + 1]]
Length[in]
f[j_, {x_, y_}] := M[[j + 1]]. {x, y} + in[[j + 1]]
pt = {0.5, 0.5};
cr[n_] :=
  Flatten[Table[
     If[i == j == k == 1, {}, RGBColor[i, j, k]], {i, 0, 1}, {j, 0,
      1}, {k, 0, 1}]][[1 + Mod[n + 1, 7]]];
ptlst[n_] :=
  Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]},
      {j, Length[dlst]}];
Show[Graphics[Join[{PointSize[.001]}, ptlst[n]]],
 AspectRatio -> Automatic, PlotRange -> All]

But the Pascal's triangle gives a oneliner:
ListDensityPlot[Table[Table[If[n >= m, Mod[Binomial[n, m], 2], 0], {m,
0, 64}], {n,  0, 64}]]

Roger Bagula



  • Prev by Date: Re: The domain parameter of Reduce[]
  • Next by Date: Re: MatrixPower problem
  • Previous by thread: Re: Memory usage of a Sierpinski triangle algorithm
  • Next by thread: Generalization of Gauss map not plotting all