Speeding up this fractal-generating code

Use these 3 components: compile, C, parallel computing.

Also to speed up coloring instead of ArrayPlot use

Graphics[Raster[Rescale[...], ColorFunction -> "TemperatureMap"]]

In such cases Compile is essential. Compile to C with parallelization will speed it up even more, but you need to have a C compiler installed. Note difference for usage of C and parallelization may show for rather greater image resolution and more cores.

mandelComp = 
  Compile[{{c, _Complex}}, 
   Module[{num = 1}, 
    FixedPoint[(num++; #^2 + c) &, 0, 99, 
     SameTest -> (Re[#]^2 + Im[#]^2 >= 4 &)]; num], 
   CompilationTarget -> "C", RuntimeAttributes -> {Listable}, 
   Parallelization -> True];

data = ParallelTable[
   a + I b, {a, -.715, -.61, .0001}, {b, -.5, -.4, .0001}];

Graphics[Raster[Rescale[mandelComp[data]], 
  ColorFunction -> "TemperatureMap"], ImageSize -> 800, PlotRangePadding -> 0]

enter image description here

This is just a prototype - you can figure out a better coloring. Another way is to use LibraryFunction - we have Mandelbrot built in:

mlf = LibraryFunctionLoad["demo_numerical", "mandelbrot", {Complex}, 
   Integer];
n = 501; samples = 
 Table[mlf[x + I y], {y, -1.25, 1.25, 2.5/(n - 1)}, {x, -2., .5, 
   2.5/(n - 1)}];
colormap = 
  Function[If[# == 0, {0., 0., 0.},  Part[r, #]]] /. 
   r -> RandomReal[1, {1000, 3}];
Graphics[Raster[Map[colormap, samples, {2}]], ImageSize -> 512]

enter image description here

Now, if you have a proper NVIDIA graphics card you can do some GPU computing with CUDA or OpenCL. I use OpenCL here because I got the source (from documentation btw):

Needs["OpenCLLink`"]

src = "
  __kernel void mandelbrot_kernel(__global mint * set, float zoom, \
float bailout, mint width, mint height) {
     int xIndex = get_global_id(0);
     int yIndex = get_global_id(1);
     int ii;

     float x0 = zoom*(width/3 - xIndex);
     float y0 = zoom*(height/2 - yIndex);
     float tmp, x = 0, y = 0;
     float c;

     if (xIndex < width && yIndex < height) {
         for (ii = 0; (x*x+y*y <= bailout) && (ii < MAX_ITERATIONS); \
ii++) {
              tmp = x*x - y*y +x0;
              y = 2*x*y + y0;
              x = tmp;
          }
          c = ii - log(log(sqrt(x*x + y*y)))/log(2.0);
          if (ii == MAX_ITERATIONS) {
              set[3*(xIndex + yIndex*width)] = 0;
              set[3*(xIndex + yIndex*width) + 1] = 0;
              set[3*(xIndex + yIndex*width) + 2] = 0;
          } else {
              set[3*(xIndex + yIndex*width)] = ii*c/4 + 20;
              set[3*(xIndex + yIndex*width) + 1] = ii*c/4;
              set[3*(xIndex + yIndex*width) + 2] = ii*c/4 + 5;
          }
      }
  }
  ";

MandelbrotSet = 
  OpenCLFunctionLoad[src, 
   "mandelbrot_kernel", {{_Integer, _, "Output"}, "Float", 
    "Float", _Integer, _Integer}, {16, 16}, 
   "Defines" -> {"MAX_ITERATIONS" -> 100}];

width = 2048;
height = 1024;
mem = OpenCLMemoryAllocate[Integer, {height, width, 3}];

res = MandelbrotSet[mem, 0.0017, 8.0, width, height, {width, height}];

Image[OpenCLMemoryGet[First[res]], "Byte"]

enter image description here

References:

Fractals CDF paper

Compile to C

LibraryFunction

OpenCL

Demonstrations


This might be an excellent candidate for ParallelTable;

MakeFractal[f_, nx_, ny_, {cx_, cy_}, {rx_, ry_}] := Module[{pts},
  DistributeDefinitions[nx, ny, cx, cy, rx, ry, f];
  pts = ParallelTable[f[x + I y], 
    {x, cx - rx, cx + rx, (2 rx)/nx},
     {y, cy - ry, cy + ry, (2 ry)/ny}];
  ArrayPlot[Reverse@pts, ColorFunction -> "TemperatureMap"]
  ]

Note that evaluation time is very fast, but plotting isn't.

You may wish to alternatively adjust the PlotPoints and MaxRecursion parameters of DensityPlot. MaxRecursion controls how far deep Mathematica goes for each plot point to determine the function value to use.

Too high of a value for MaxRecursion can lead to very long evaluation, especially with fractals.

Another way to help speed is to use CompilationTarget->"C" and RuntimeOptions->Speed. These sometimes provide a (small) speedup.


Here's some timing values (Note your value of PlotPoints->250 is a bit excessive):

(* 4.05 seconds on my machine *)
AbsoluteTiming[
 Block[{center = {0.5527, 0.9435}, radius = 0.1},
  DensityPlot[cosineEscapeTime[x + I y],
   {x, center[[1]] - radius, center[[1]] + radius},
   {y, center[[2]] - radius, center[[2]] + radius},
   PlotPoints -> 120, MaxRecursion -> 2,
   AspectRatio -> 1, ColorFunction -> "TemperatureMap"]]
 ]

(* 2.07 seconds on my machine *)
AbsoluteTiming[
 pts = ParallelTable[
   cosineEscapeTime[x + I y], {x, xc - r, xc + r, (2 r)/nx}, {y, 
    yc - r, yc + r, ( 2 r)/ny}];
 ListDensityPlot[pts, AspectRatio -> 1, 
  ColorFunction -> "TemperatureMap"]
 ]

And individually for the ParallelTable approach:

(* 0.753 seconds on my machine *)
AbsoluteTiming[
 pts = ParallelTable[
    cosineEscapeTime[x + I y], {x, xc - r, xc + r, (2 r)/nx}, {y, 
     yc - r, yc + r, ( 2 r)/ny}];
 ]

(* 1.397 seconds on my machine *)
AbsoluteTiming[
 ListDensityPlot[pts, AspectRatio -> 1, 
  ColorFunction -> "TemperatureMap"]
 ]

Using ArrayPlot as Mr.Wizard suggests is much faster:

(* 0.233 seconds on my machine *)
AbsoluteTiming[
 ArrayPlot[Reverse@pts,
  ColorFunction -> "TemperatureMap"
  ]
 ]

As you can see, plotting takes up a rather large amount of time.


Many plots can be speeded up by pre-generating the data set you want and then plotting the resulting list. In any case, it's not coincidence that Table and Plot have similar syntax, only that Plot does additional things like finding out the range to be displayed, the interpolation strength, and so forth. If you're already sure what kind of picture you want to get out, you may want to generate the data set by hand, like mentioned by Mike.

In your case, you can add just a few characters to the block part,

Block[{center = {0.5527, 0.9435}, radius = 0.1, data},
    data = ParallelTable[
        cosineEscapeTime[x + I y],
        {x, center[[1]] - radius, center[[1]] + radius, 2 radius/250},
        {y, center[[2]] - radius, center[[2]] + radius, 2 radius/250}
    ];
    ListDensityPlot[
        data,
        AspectRatio -> 1,
        ColorFunction -> "TemperatureMap"
    ]
]

This speeds up the process by more than an order of magnitude for me, and requires significantly less memory than the automatic plot. However, there's no interpolation in tricky corners of the plot here, so if you want a larger image you may want to change the parameters, i.e. decrease step size etc.