Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Increasing the speed of (or an alternative to) RegionPlot

I want to include the some region plots in a Manipulate structure, however the rendering is almost prohibitively slow. The code is

ClearAll[regions, rplot]
r:regions[n_Integer, o_Integer] := r = Apply[And, 
    Subsets[Table[(#1 - Cos[t])^2 + (#2 - Sin[t])^2 <= 1, {t, 2 Pi/n, 
       2 Pi, 2 Pi/n}], {o}], {1}] &
r:rplot[n_Integer, o_Integer] := r = Show[{RegionPlot[
     Evaluate[regions[n, o][x, y]], {x, -2, 2}, {y, -2, 2},
     PlotRange -> {{-2, 2}, {-2, 2}}, PlotRangePadding -> .1, 
     Frame -> False, PlotPoints -> 100], 
    Graphics[Table[Circle[{Cos[t], Sin[t]}, 1], {t, 2 Pi/n, 2 Pi, 2 Pi/n}]]}]

Which produces graphics like

GraphicsGrid[{{rplot[3, 2], rplot[5, 3]}, {rplot[7, 2], rplot[4, 1]}}]

circles from above!

The above takes about 40 seconds to calculate and render on my computer. Can anyone suggest a way to get similar quality graphics more quickly?


Note 1: I've memoized the graphics object so that doesn't need to recalculate it each time in my demonstration - but it's too slow even the first time.
Note 2: I'm happy with rasterized images, so maybe a flood fill type solution would be an option...
Note 3: I need something like Manipulate[ rplot[n, o], {n, 2, 10, 1, Appearance -> "Labeled"}, {{o, 1}, Range[1, (n + 1)/2], ControlType -> RadioButtonBar}] to be usable.

like image 591
Simon Avatar asked Dec 07 '11 03:12

Simon


1 Answers

You could do something like this

rplot[n_Integer, o_Integer] :=  Module[{centres, masks, opacity = .3, 
   colours, region, img, createmask},
  centres = Table[Through[{Re, Im}[Exp[I t]]], {t, 2 Pi/n, 2 Pi, 2 Pi/n}];
  createmask[centres_] := Fold[ImageMultiply, #[[1]], Rest[#]] &@ 
     (ColorNegate[ Image[Graphics[Disk[#, 1], PlotRange -> {{-2, 2}, {-2, 2}}, 
          PlotRangePadding -> .1], ColorSpace -> "Grayscale"]] & /@ centres);
  masks = createmask /@ Subsets[centres, {o}];
  colours = PadRight[#, Length[masks], #] & @ (List @@@ ColorData[1, "ColorList"]);
  region[img_, col_] := 
   SetAlphaChannel[ColorCombine[ImageMultiply[img, #] & /@ col, "RGB"], 
    ImageMultiply[img, opacity]];
  img = Fold[ImageCompose, #[[1]], Rest[#]] &@(MapThread[region, {masks, colours}]);
  Overlay[{img, Graphics[Circle[#, 1] & /@ centres, PlotRangePadding -> .1, 
     PlotRange -> {{-2, 2}, {-2, 2}}]}]
 ]

Then GraphicsGrid[{{rplot[3, 2], rplot[5, 3]}, {rplot[7, 2], rplot[4, 1]}}] produces something like

cross sections of circles

Edit

Moved previous edit to separate answer.

like image 174
Heike Avatar answered Oct 08 '22 12:10

Heike