\begingroup
给出定义:布朗运动的前沿是布朗运动补集的无界分量的边界。
从图形上看,边界是红色的:
如何将布朗运动的边界与布朗运动的其余部分隔离开来?
到目前为止,我已经使用启发式方法和照片编辑软件来确定定义边界的点集。然而,这并不一致和可靠。
Mathematica 中是否有我可以使用的算法方法?
*生成步行的简单代码片段如下:
L = 1;(*Number of iterations*)
Ntot = 100000;(*Number of phases*)
(*Initialize somme as an empty list*)
somme = {};
Do[
(*Generate random phases*)
phases = Exp[I RandomChoice[{0., \[Pi]/2., \[Pi], (3. \[Pi])/2.}, Ntot]];
(*Calculate cumulative sum (FoldList of complex numbers)*)
sommez = FoldList[Plus, 0, phases];
(*Extract real and imaginary parts and append them to somme*)
AppendTo[somme, {Re[#], Im[#]} & /@ sommez];
, {L}];
(*Flatten the list to combine all data into a single table, if desired*)
somme = Flatten[somme, 1];
\endgroup
2
最佳答案
3
\begingroup
ConcaveHullMesh
有一些α-shapes
。- 然后合并的边界内部
ConnectedMeshComponents
并提取RegionBoundary
。
α = 4;
reg = ConcaveHullMesh[somme, α] // RegionBoundary;
regs = ConnectedMeshComponents[reg];
bd = BoundaryMeshRegion[MeshCoordinates[#], MeshCells[#, 1]] & /@
regs // RegionUnion // RegionBoundary;
(*bd=regs//First*)
Graphics[{Darker@Cyan, AbsolutePointSize[1], Point@somme, Red, bd}]
\endgroup
1
-
\begingroup
中右那边看起来有点粗糙。左上角可以看到另一件文物。
\endgroup
–
|
\begingroup
使用带有“ Contours ”属性的:
image = Graphics[{RGBColor[0, .78, .78], PointSize[Small], Point[somme]}];
contour = ImageMeasurements[ColorNegate@Binarize@image, "Contours"][[1, 1]];
HighlightImage[image, {Red, AbsoluteThickness[1.5], BSplineCurve@contour}]
\endgroup
|
\begingroup
如果您可以接受布朗运动(随机游走)的离散形式,那么我可以使用下面的图像形态来实现这一点。在极限情况下,它应该表现得像连续布朗运动。
SeedRandom[1234];
path = Accumulate@
RandomChoice[{{0, 1}, {1, 0}, {-1, 0}, {0, -1}}, 20000];
minx = Min[path[[All, 1]]];
miny = Min[path[[All, 2]]];
offset = {minx - 1, miny - 1};
adjusted = path - Threaded[offset];
mmax = {Max[adjusted[[All, 1]]], Max[adjusted[[All, 2]]]};
arr = SparseArray[# -> 1 & /@ adjusted, mmax, 0];
edges = EdgeDetect[FillingTransform[Image[arr], Padding -> 1], 1];
frontierPos =
Reverse[PixelValuePositions[edges, 1], 2]*Threaded[{-1, 1}] +
Threaded[offset + {mmax[[1]] + 1, 0}];
frontierPath =
Part[frontierPos, Last[FindShortestTour[frontierPos]]];
ListLinePlot[{path, frontierPath}, AspectRatio -> 1]
\endgroup
1
-
\begingroup
不错的答案,尽管我需要一些时间来理解它的工作原理 🙂 但这样生成的边界似乎并不(总是)属于集合本身(应该是这样的)。顺便说一句,由于未知原因,AspectRatio->1 并没有达到预期的效果。应该使用 AspectRatio->Automatic。
\endgroup
–
|
附注:在 Do 循环中执行 AppendTo 效率不高。请尝试以下方法:
SeedRandom[10]; brownian = Transpose[RandomFunction[WienerProcess[], {0, 1, .0001}, 2]["ValueList"]]; ListLinePlot[brownian, AspectRatio -> 1, PlotRange -> 1.6 {{-1, 1}, {-1, 1}}]
\endgroup
–
凸包在这里没有帮助,我想不出用“连续”几何来实现这一点的方法,所以这是一个非常有趣的问题。但是如果你将步行离散化,使其发生在网格上,你可以通过在足够远的起始位置找到“外部”的像素,然后用洪水填充来获得边界,然后对生成的图像进行边缘检测。
\endgroup
–
|