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]}}]
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.
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
Edit
Moved previous edit to separate answer.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With