17
$\begingroup$

Given the definition: The frontier of Brownian motion is the boundary of the unbounded component of the complement of Brownian motion.

Graphically, the frontier is in red:

The frontier is in red

How can one isolate the frontier of the Brownian motion from the rest of a Brownian walk?

Thus far, I have used heuristics and photo editing software to determine the set of points that define the boundary. However, this is not consistent and reliable.

Is there any algorithmic approach in Mathematica I could use?

*A simple code snippet to generate the walk I have is:

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];
Improve this question
$\endgroup$
3
  • 3
    $\begingroup$ Side note, it's not efficient to do AppendTo in a Do loop. Try this instead: SeedRandom[10]; brownian = Transpose[RandomFunction[WienerProcess[], {0, 1, .0001}, 2]["ValueList"]]; ListLinePlot[brownian, AspectRatio -> 1, PlotRange -> 1.6 {{-1, 1}, {-1, 1}}] $\endgroup$ Commented Oct 29, 2024 at 21:50
  • 1
    $\begingroup$ Convex hull doesn't help here and I can't think of a way to do this with "continuous" geometry so it's a very interesting problem. But if you discretize the walk so it's happening on a grid, you could get the frontier by finding the pixels on the "outside" with a flood fill at a starting position sufficiently far away, then do an edge detect on the resulting image. $\endgroup$ Commented Oct 29, 2024 at 21:53
  • 1
    $\begingroup$ It’s amazing how much the frontiers look like coastlines. $\endgroup$ Commented Oct 31, 2024 at 19:59

3 Answers 3

Reset to default
16
$\begingroup$
  • ConcaveHullMesh with some α-shapes.
  • then union the interior of the boundary of the ConnectedMeshComponents and extract the 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}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ That's looking a lil sketchy over there on the mid-right. Another artifact is visible top left. $\endgroup$ Commented Oct 30, 2024 at 15:43
  • $\begingroup$ lines = MeshPrimitives[bd, 1, "Multicells" -> True][[;; , 1]][[1]]; bounds = RegionBounds[bd]; Manipulate[ Graphics[{Darker@Cyan, AbsolutePointSize[1], Point@somme, Arrowheads[.01], Red, Take[Arrow /@ lines, k]}, PlotRange -> bounds], {k, 1, Length@lines, 1}] $\endgroup$ Commented Oct 31, 2024 at 3:36
14
$\begingroup$

Edit

Using ImageMeasurements with the "PerimeterPositions" property together with the Nearest function to mark the frontier on the original coordinates :

xyRange = MinMax /@ Transpose[somme]; image = Graphics[{RGBColor[0, 0.78, 0.78], PointSize[Small] , Point[somme]}, PlotRange -> xyRange, AspectRatio -> 1]; perimeter = ImageMeasurements[ColorNegate@Binarize@image, "PerimeterPositions"][[1]]; imgDims = ImageDimensions[image]; rescale[coord_] := MapThread[Rescale, {coord, Transpose[{{1, 1}, imgDims}], xyRange}]; nearest = Nearest[somme]; frontier = Flatten[nearest@*rescale /@ perimeter, 1]; Graphics[{RGBColor[0, 0.78, 0.78], PointSize[Small], Point[somme] , Lighter@Red, AbsoluteThickness[1], BSplineCurve[frontier] , Red, AbsoluteThickness[1], Point[frontier]}, Axes -> True]

frontier

Original Post

Using ImageMeasurements with the "Contours" property:

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

border

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Hi, this seems to be the best answer but often time it does not work (I only get a tiny red island if at all). I am using Mathematica 12 could that be the culprit? Is there a way to make it more stable? $\endgroup$ Commented Jan 24 at 15:40
11
$\begingroup$

If you can accept a discretized form of the brownian motion (random walk), then I've been able to do this with image morphology as below. In the limit it should behave like the continuous brownian motion.

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]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Nice answer, although it will take time for me to understand how it works :) But the frontier so generated does not seem to (always) belong to set itself (which should be the case). Btw for unknown reasons AspectRatio->1 doesn't do what one expects. One should rather use AspectRatio->Automatic. $\endgroup$ Commented Oct 30, 2024 at 13:15
  • $\begingroup$ @lcv it does work, it's just a visualization problem and going back and forth between the list-of-lists/sparse-array and image representations of which pixels were visited introduces a {0.5,0.5} offset. vindobona's answer is the better way to achieve this. I don't think the concave hull answer is necessarily correct. $\endgroup$ Commented Nov 1, 2024 at 11:01

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.