提高 RegionPlot（或替代方案）的速度

发布于 2024-12-20 01:27:41 字数 1083 浏览 1 评论 0原文

我想将一些区域图包含在 Manipulate 结构中，但是渲染速度几乎慢得令人望而却步。代码是

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}]]}]

生成类似

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

circles from above!

的图形在我的计算机上计算和渲染上述内容大约需要 40 秒。谁能建议一种方法来更快地获得类似质量的图形？

注 1：我已经记住了图形对象，因此不需要在演示中每次都重新计算它 - 但即使是第一次也太慢了。
注 2：我对光栅化图像很满意，因此也许可以选择洪水填充类型解决方案...
注 3：我需要类似 Manipulate[ rplot[n, o], {n, 2, 10, 1, 外观 -> “标记”}，{{o，1}，范围[1，(n+1)/2]，控制类型-> RadioButtonBar}] 可用。

原文

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.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

平定天下 2024-12-27 01:27:41

你可以这样做

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}}]}]
 ]

然后 GraphicsGrid[{{rplot[3, 2], rplot[5, 3]}, {rplot[7, 2], rplot[4, 1]}}]产生类似

crosssections of Circles

编辑

将之前的编辑移至单独的答案。

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.

回复收藏 0 原文

安静被遗忘 2024-12-27 01:27:41

我之前将此作为我其他答案的补充发布。它的灵感来自 Simon 的分析方法，并进行了一些修改以加快速度。

intersect[n_, o_] :=
  With[{a = Pi/2 - (o-1) Pi/n},
   If[o-1 >= n/2, Return[{}]]; (* intersection is {} *)
   Polygon[
    Join[Table[{Sin[a] + Sin[phi], (-Cos[a] + Cos[phi])}, {phi, -a, a-2 a/10, 2 a/10}], 
     Table[{Sin[a] + Sin[phi], (Cos[a] - Cos[phi])}, {phi, a, -a+2 a/10, -2 a/10}]]]]

rplot2[n_, o_] := With[{pl = intersect[n, o], opac = .3, col = ColorData[1]},
  Graphics[{{Opacity[opac], 
     Table[{col[k], Rotate[pl, Mod[o - 1, 2] Pi/n + 2 Pi k/n, {0, 0}]}, {k, n}]},
    {Black, Circle[Through[{Re, Im}[Exp[I #]]]] & /@ (Range[n] 2 Pi/n)}}]
 ]

首先，我将其用于 n 和 o 的给定值，即第 i 个圆和第 i+o-1 个圆与第一个圆和第 o 个圆之间的相交区域相同，除了旋转一个角度 2 Pi (i-1)/n，因此只需计算一次区域并使用Rotate来旋转区域即可。

另外，我没有使用 ParametricPlot 来绘制相交区域，而是使用了 Polygon，因此我只需要计算边界上的一些点，从而节省了时间。

GraphicsGrid[{{rplot2[3, 2], rplot2[5, 2]}, {rplot2[7, 3], rplot2[4, 1]}}] 的结果看起来像

Intersecting Circles revisited

我得到的时间与

rplot2[10, 3]; // Timing

(* ==> {0.0016, Null} *)

西蒙解决方案的时间进行了比较

rplot[10, 3]; // Timing

(* ==> {0.16519, Null} *)

I previously posted this as an addition to my other answer. It's inspired by Simon's analytic approach, with some modifications to speed things up

intersect[n_, o_] :=
  With[{a = Pi/2 - (o-1) Pi/n},
   If[o-1 >= n/2, Return[{}]]; (* intersection is {} *)
   Polygon[
    Join[Table[{Sin[a] + Sin[phi], (-Cos[a] + Cos[phi])}, {phi, -a, a-2 a/10, 2 a/10}], 
     Table[{Sin[a] + Sin[phi], (Cos[a] - Cos[phi])}, {phi, a, -a+2 a/10, -2 a/10}]]]]

rplot2[n_, o_] := With[{pl = intersect[n, o], opac = .3, col = ColorData[1]},
  Graphics[{{Opacity[opac], 
     Table[{col[k], Rotate[pl, Mod[o - 1, 2] Pi/n + 2 Pi k/n, {0, 0}]}, {k, n}]},
    {Black, Circle[Through[{Re, Im}[Exp[I #]]]] & /@ (Range[n] 2 Pi/n)}}]
 ]

First of all, I'm using that for given value of n and o, the intersection region between the i-th and i+o-1-th circle is the same as the intersection region between the first and o-th circle except for a rotation over an angle 2 Pi (i-1)/n, so it suffices to calculate the region once and use Rotate to rotate the region.

Also, instead of using a ParametricPlot to plot the intersection region, I'm using a Polygon so I only need to calculate some points on the boundary which saves time.

The result for GraphicsGrid[{{rplot2[3, 2], rplot2[5, 2]}, {rplot2[7, 3], rplot2[4, 1]}}] looks like

Intersecting circles revisited

And the timings I get are

rplot2[10, 3]; // Timing

(* ==> {0.0016, Null} *)

compared to those for Simon's solution

rplot[10, 3]; // Timing

(* ==> {0.16519, Null} *)

回复收藏 0 原文

夏至、离别 2024-12-27 01:27:41

Wizard 先生让我意识到，虽然我有一个可以在 RegionPlot 中使用的区域分析表单，但如果我获得了边界的参数化表单，那么我就可以使用 ParametricPlot代码>.那么，让我们这样做吧！

第 i (i=0,...,n-1) 圆在复平面中参数化为
Exp[I t] + Exp[2 i Pi I / n] 对于 [0, 2 Pi] 中的 t。

我们可以求解第i^th个圆和(i+o-1)^th个圆的交集，其中 o 是重叠数，如问题的原始代码所示。现在我们可以参数

point[n_, o_, i_] := {Cos[(2 i Pi)/n] + Cos[(2 Pi (i + o - 1))/n], 
                      Sin[(2 i Pi)/n] + Sin[(2 Pi (i + o - 1))/n]}

化从原点到点[n,o,i]的弧，并将它们反射到从原点到点[n的线上，o，i]。使用参数 s 在两者之间进行插值给出参数化区域

area[n_, o_, i_, t_, s_] := With[{a = 2 Sin[((2 + n - 2 o) (1 - t) )/(2 n) Pi], 
   b = (2 - 4 i + 2 t + n t - 2 o (1 + t))/(2 n) Pi, 
   c = ((2 + n - 2 o) (1 - t) - 4 i)/(2 n) Pi}, 
   {a (s Cos[b] + (1 - s) Sin[c]) , -a (s Sin[b] - (1 - s) Cos[c])}]

然后我们可以定义

rplot[n_Integer, o_Integer] := ParametricPlot[Evaluate[
  Table[area[n, o, i, t, s], {i, 0, n - 1}]], {t, 0, 1}, {s, 0, 1},
  Mesh -> False, MaxRecursion -> 1, Frame -> False, Axes -> False, 
  PlotRange -> 2.1 {{-1, 1}, {-1, 1}},
  Epilog -> {Table[Circle[{Cos[t], Sin[t]}, 1], {t, 0, 2 Pi (n-1)/n, 2 Pi/n}],
    Red, Point[Table[point[n, o, i], {i, 1, n}]]}]

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

graphics grid

Mr. Wizard made me realize that although I had an analytic form for the areas that I could use in RegionPlot, if I obtained a parametrized form for the boundaries, then I could use ParametricPlot. So, let's do that!

The i^th (i=0,...,n-1) circle is parametrized in the complex plane by
Exp[I t] + Exp[2 i Pi I / n] for t in [0, 2 Pi].

We can solve to find the intersection of the i^th and the (i+o-1)^th circles, where o is the number of overlaps, as in the original code of the question. This gives the points at

point[n_, o_, i_] := {Cos[(2 i Pi)/n] + Cos[(2 Pi (i + o - 1))/n], 
                      Sin[(2 i Pi)/n] + Sin[(2 Pi (i + o - 1))/n]}

Now we can parametrize the arcs going from the origin to a point[n,o,i] and reflect them across the line going from the origin to a point[n,o,i]. Interpolating between the two with a parameter s gives the parametrized regions

area[n_, o_, i_, t_, s_] := With[{a = 2 Sin[((2 + n - 2 o) (1 - t) )/(2 n) Pi], 
   b = (2 - 4 i + 2 t + n t - 2 o (1 + t))/(2 n) Pi, 
   c = ((2 + n - 2 o) (1 - t) - 4 i)/(2 n) Pi}, 
   {a (s Cos[b] + (1 - s) Sin[c]) , -a (s Sin[b] - (1 - s) Cos[c])}]

Then we can define

rplot[n_Integer, o_Integer] := ParametricPlot[Evaluate[
  Table[area[n, o, i, t, s], {i, 0, n - 1}]], {t, 0, 1}, {s, 0, 1},
  Mesh -> False, MaxRecursion -> 1, Frame -> False, Axes -> False, 
  PlotRange -> 2.1 {{-1, 1}, {-1, 1}},
  Epilog -> {Table[Circle[{Cos[t], Sin[t]}, 1], {t, 0, 2 Pi (n-1)/n, 2 Pi/n}],
    Red, Point[Table[point[n, o, i], {i, 1, n}]]}]

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

graphics grid

回复收藏 0 原文

没企图 2024-12-27 01:27:41

解析方法

如果圆总是排列成如图所示的偶数环，则圆与圆的交点应该有解析解。我将从环上列出的每个圆之间的度数开始。

如果时间允许，我将探索这个方法。

栅格方法

在正确位置对一系列磁盘进行二进制栅格化
为每个栅格分配唯一的 2 次幂值来代替各个栅格
>
添加数组
根据总计数组中每个点的值计算唯一的一组重叠
将正确的颜色映射到结果数组并生成输出

栅格方法的第一次粗略传递，仅作为概念证明。您可以看到每个区域都有独特的阴影，它只是该点的栅格之和。

raster = 
  1 - First@Binarize@Rasterize@Graphics[#, PlotRange -> {{-2, 2}, {-2, 2}}] &;

disks =
  Table[raster @ Disk[{Cos[t], Sin[t]}, 1], {t, 2 Pi/#, 2 Pi, 2 Pi/#}] &;

n = 5;

array = disks[n] * 2^Range[0, n - 1] //Total;

ArrayPlot[array]

在此处输入图像描述

第二稿，添加颜色。它仍然相当笨重。

n = 7; o = 2;

sets = Table[
   NestList[RotateLeft, PadLeft[Table[1, {o + i}], n], n - 1],
   {i, 0, n - o}
   ];

colors = NestList[
   Mean /@ Partition[#, 2, 1, 1] &,
   List @@@ Take[ColorData[4, "ColorList"], n],
   n - o
   ];

rules = Append[Rule @@@ Flatten[{sets, colors}, {{2, 3}}], _ -> {1, 1, 1}];

Replace[Transpose[disks[n], {3, 2, 1}], rules, {2}] // Image

在此处输入图像描述

Analytic method

If the circles are always arranged in an even ring with as shown, there should be an analytic solution for the circle-circle intersection. I would start with the number of degrees between each circle as laid out on the ring.

I shall explore this method as time allows.

Raster method

Binary rasterize a series of disks in the correct locations
Assign unique power-of-2 values to each raster in place of ones
Add arrays
Compute unique set of overlaps from the value at each point in the totals array
Map correct colors onto resulting array and generate output

First rough pass of the raster method, simply as a proof of concept. You can see that each region has a unique shading, which is just the sum of rasters at that point.

raster = 
  1 - First@Binarize@Rasterize@Graphics[#, PlotRange -> {{-2, 2}, {-2, 2}}] &;

disks =
  Table[raster @ Disk[{Cos[t], Sin[t]}, 1], {t, 2 Pi/#, 2 Pi, 2 Pi/#}] &;

n = 5;

array = disks[n] * 2^Range[0, n - 1] //Total;

ArrayPlot[array]

enter image description here

Second draft, adding colors. It's still rather clunky.

n = 7; o = 2;

sets = Table[
   NestList[RotateLeft, PadLeft[Table[1, {o + i}], n], n - 1],
   {i, 0, n - o}
   ];

colors = NestList[
   Mean /@ Partition[#, 2, 1, 1] &,
   List @@@ Take[ColorData[4, "ColorList"], n],
   n - o
   ];

rules = Append[Rule @@@ Flatten[{sets, colors}, {{2, 3}}], _ -> {1, 1, 1}];

Replace[Transpose[disks[n], {3, 2, 1}], rules, {2}] // Image

enter image description here

回复收藏 0 原文

~没有更多了~