Archive for February, 2005

24
Feb
05

Circular Orbit Trap

This animation shows a Circular Orbit Trap transforming into a biomorph.
(* runtime: 12 seconds *)
OrbitTrap[zc_] := Module[{z = 0, i = 0, x}, While[i < 10 && Abs[z] < 2 && (i < 2 || Abs[z] > 0.3), z = z^2 + zc; i++]; x = Abs[z]^2/0.3^2; Hue[Arg[z]/(2Pi), Min[1, 2 x], Max[0, Min[1, 2(1 - x)]]]];
Show[Graphics[RasterArray[Table[OrbitTrap[xc + I yc], {yc, -1.5, 1.5, 3/274}, {xc, -2.0, 1.0, 3/274}]], AspectRatio -> 1]];

24
Feb
05

Mandelbrot Set Pickover Stalks


Pickover stalks are cross-shaped orbit traps invented by Clifford Pickover. See also my 3D Pickover stalks fractals. Here is some Mathematica code:
(* runtime: 33 seconds *)
f[z_] := Min[Abs[{Re[z], Im[z]}]]/0.03;
OrbitTrap[zc_] := Module[{z = 0, i = 0}, While[i < 100 && Abs[z] < 100 && (i < 2 || f[z] > 1), z = z^2 + zc; i++]; Hue[Arg[z]/(2Pi), Min[1, 2 f[z]], Max[0, Min[1, 2(1 - f[z])]]]];
Show[Graphics[RasterArray[Table[OrbitTrap[xc + I yc], {yc, -1.5, 1.5, 3/274}, {xc, -2.0, 1.0, 3/274}]], AspectRatio -> 1]]

Links

18
Feb
05

Cubic Julia Set Fractal

zn+1 = zn3+zc, zc = -0.5-0.05i
This was one of my older favorites.

original version: Java, 6/9/01;
animated version: Mathematica 4.2, 2/18/05

(* runtime: 10 seconds *)
Julia = Compile[{{z, _Complex}}, Length[FixedPointList[#^3 + zc &, z, 100, SameTest -> (Abs[#] > 2 &)]]];
zc = -0.5 - 0.05 I;
DensityPlot[Julia[x + I y], {x, -1.15, 1.15}, {y, -1.15, 1.15}, PlotPoints -> 275, Mesh -> False, Frame -> False, ColorFunction -> (RGBColor[Min[2#^2, 1], Max[2# - 1, 0], Min[2#, 1]] &)];

This is how you can make this fractal in POV-Ray:
// runtime: 0.5 second
camera{orthographic location <0,0,-1.15> look_at 0 angle 90}
plane{z,0 pigment{julia <-0.5,-0.05>,30 exponent 3 color_map{[0 rgb 0][1/3 rgb <0,0,1>][2/3 rgb <1,0,1>][1 rgb 1]}} finish{ambient 1}}

16
Feb
05

Mandelbrot Set Zoom

zn+1 = zn2+zc
This animation zooms in on the Mandelbrot set by a factor of 1015. At this high resolution, double precision numbers are inadequate. Therefore, this animation was created using “double-double” precision numbers, adapted from Keith Brigg’s double-doubles. See also my Java program and C program.

Mandelbrot Set Zoom – original version: Java, 5/24/01; animated version: C++, 2/16/05 Here is some Mathematica code for this fractal:
(* runtime: 1 minute *)
Mandelbrot[zc_] := Module[{z = 0, i = 0}, While[i < 100 && Abs[z] < 2, z = z^2 + zc; i++]; i];
DensityPlot[Mandelbrot[xc + I yc], {xc, -2, 1}, {yc, -1.5, 1.5}, PlotPoints -> 275, Mesh -> False, Frame -> False, ColorFunction -> (If[# != 1, Hue[#], Hue[0, 0, 0]] &)];

Here is a faster version:
(* runtime: 7 seconds *)
Mandelbrot = Compile[{{zc, _Complex}}, Length[FixedPointList[#^2 + zc &, zc, 100, SameTest -> (Abs[#] > 2 &)]]];
DensityPlot[Mandelbrot[xc + I yc], {xc, -2, 1}, {yc, -1.5, 1.5}, PlotPoints -> 275, Mesh -> False, Frame -> False, ColorFunction -> (If[# != 1, Hue[#], Hue[0, 0, 0]] &)];

POV-Ray has a built-in function for this fractal:
// runtime: 0.5 second
camera{orthographic location <-0.5,0,-1.5> look_at <-0.5,0,0> angle 90}
plane{z,0 pigment{mandel 100 color_map{[0 rgb 0][1/6 rgb <1,0,1>][1/3 rgb 1][1 rgb 1][1 rgb 0]}} finish{ambient 1}}

Links

12
Feb
05

Frequency Filtered Random Noise

Frequency Filtered Random Noise : another variation of frequency filtered random noise.
(* runtime: 20 seconds *)
n = 275; SeedRandom[1]; fourier = Fourier[Table[Random[], {n}, {n}]];
filter = Table[fourier[[i, j]]/((j/n - 0.5)^2 + (i/n - 0.5)^2), {i, 1, n}, {j, 1, n}];
ListDensityPlot[Map[Abs, InverseFourier[filter], {2}], Mesh -> False, Frame -> False, ColorFunction -> (Hue[# + 0.5] &)];

10
Feb
05

Diffusion Limited Aggregation (DLA) Fractal

This fractal simulates a diffusive growth process similar to that often found in nature. It is generated by single points that randomly drift around until they find something to stick to. The title on this page was generated using this technique.

Diffusion Limited Aggregation (DLA) FractalMathematica 4.2, 8/12/04; C++ version: 2/10/05

(* runtime: 1 minute *)
n = 100; ix = iy = n/2; i = 0; SeedRandom[0]; image = Table[0, {n}, {n}];
Do[{ix, iy} = Floor[n(0.5 + 0.1{Cos[theta], Sin[theta]})] + 1; image[[ix, iy]] =1, {theta, 0, 2 Pi, Pi/180}];
While[(ix - n/2)^2 + (iy - n/2)^2 < (n/2)^2, theta = 2 Pi Random[]; {ix, iy} =Floor[n(1 + {Cos[theta], Sin[theta]})/2]; drift =True; While[drift, {ix, iy} = Mod[{ix + Random[Integer, {-1, 1}], iy + Random[Integer, {-1, 1}]}, n]; drift = Plus @@ Flatten[image[[Mod[ix + {-1, 0, 1}, n] + 1, Mod[iy + {-1, 0, 1}, n] + 1]]] == 0]; image[[ix + 1, iy + 1]] = 1 - i/n^1.5; i++];
ListDensityPlot[image, Mesh -> False, Frame -> False];

Links

05
Feb
05

Gravitational Lensing of a Black Hole

Gravitational Lensing of a Black Hole : According to Einstein’s Theory of Relativity, the intense gravity of a black hole can bend light into a circle called an Einstein Ring. See also Event horizon, Schwarzschild radius, photon sphere. The following code is only an approximation:
(* runtime: 30 seconds *)
Clear[stars]; SeedRandom[535]; stars[{x_, y_}] = Sum[Exp[-500((x - Random[])^2 + (y - Random[])^2)/Random[]^2], {10}];
DensityPlot[Module[{r = x^2 + y^2}, If[r 275, PlotRange -> {0, 1}, Mesh -> False, Frame -> False]

Links




Welcome !

You will find here some of my favorite hobbies and interests, especially science and art.

I hope you enjoy it!

Subscribe to the RSS feed to stay informed when I publish something new here.

I would love to hear from you! Please feel free to send me an email : bugman123-at-gmail-dot-com

Archives

Blog Stats

  • 500,534 hits

Follow

Get every new post delivered to your Inbox.