Skip to main content
1 of 3
acl
  • 19.9k
  • 3
  • 66
  • 94

You can certainly draw 2d fractals, eg the Mandelbrot set

ClearAll[mnd]
mnd = Compile[{{m, _Integer}, {n, _Integer}, {steps, _Integer}, \
{maxiter, _Integer}, {xmax, _Real}},
   Block[{z, c, iters = 0},
    z = c = -xmax + 2.*xmax*n/steps - 0.5 + 
       I*(-xmax + 2.*xmax*m/steps);
    While[(iters < maxiter) && (Abs@z < 2),
     iters++;
     z = z^2 + c
     ];
    Sqrt[iters/maxiter]
    ],
   {{z, _Complex}, {c, _Complex}}
   ];

ListContourPlot[
 Table[
  mnd[m, n, 200, 200, 1],
  {m, 1, 200}, {n, 1, 200}
  ],
 Frame \[Rule] False
 ]

Mathematica graphics

or the Hofstadter butterfly

ClearAll[matrix];
matrix[p_,q_,nu_:0]:=Module[
    {sigma},
    sigma=p/q;
    N@SparseArray[
        {{m_,m_}\[Rule]2Cos[2\[Pi]*m*p/q+nu],{i_,j_}/;Abs[i-j]\[Equal]1\[Rule]1},{q,q}]]

ClearAll[attachsigma]
attachsigma[sigma_,lst_]:={sigma,#}&/@lst

fracs = Table[p/q, {q, 2, 40}, {p, 2, q}] // Flatten // 
   DeleteDuplicates;
pq = {Numerator@#, Denominator@#} & /@ fracs;
(ens = Eigenvalues[#] & /@ (matrix[#[[1]], #[[2]]] & /@ pq);) // Timing
pts = Flatten[#, 1] &@MapThread[attachsigma, {fracs, ens}];
plot = Graphics[
  {PointSize \[Rule] .001, Point[pts]},
  AspectRatio \[Rule] 1,
  ImageSize \[Rule] Full
  ]

Mathematica graphics

acl
  • 19.9k
  • 3
  • 66
  • 94