\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
    附注:在 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


    – 


  • 1
    \begingroup
    凸包在这里没有帮助,我想不出用“连续”几何来实现这一点的方法,所以这是一个非常有趣的问题。但是如果你将步行离散化,使其发生在网格上,你可以通过在足够远的起始位置找到“外部”的像素,然后用洪水填充来获得边界,然后对生成的图像进行边缘检测。
    \endgroup


    – 


最佳答案
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


    –