How to throw $n$ random noodles of equal length?

Question

I've been meaning to modify some code given in the the Region Disjoint documentation for the Buffon's Needle problem to instead model Buffon's Noodle Problem.
In Buffon's Needle problem you randomly toss $n$ straight lines (i.e. needles) of length $l$ in between parallel lines of width $t$. The probability that the needle lies across a line is given by,
$${displaystyle p={frac {2}{pi }}{frac {l}{t}}.}$$
In Buffon's Noodle problem you instead randomly toss $n$ rigid plane curves (i.e. noodles) of length $l$ in between parallel lines of width $t$ and the probability is the same.
My question is, how can I modify the code shown below to throw $n$ noodles instead of needles?
Input:
d = 0.2; n = 1000;
lines = MeshRegion[
Join @@ Table[{{-1 - d, y}, {1 + d, y}}, {y, -1 - d, 1 + d, d}], 
Line[Partition[Range[2 Floor[2/d + 3]], 2]]];
needles =  Table[Line[{pt, RandomPoint[Circle[pt, d]]}], {pt, RandomReal[{-1, 1}, {n,2}]}];
overlap = Select[needles, ! RegionDisjoint[lines, #] &];
Show[lines, Graphics[{Red, overlap, Black, Complement[needles, overlap]}]]
N[(2 n)/Length[overlap]]

Output:

bRost03 · Accepted Answer

Having given no indication of what kinds of noodles you're interested in - here's a quick hack to make a noodle that's easy to work with:
generateNoodle[l_, np_, cent_] := Block[{ls = l/np, pts},
  pts = RandomPoint[Circle[{0, 0}, ls], np];
  Line /@ Partition[(cent+#)&/@ Accumulate[pts],2,1]]

Just connect together np randomly oriented line segments of length l/np with the first segment beginning at cent.
Unlike needles, noodles can intersect a given line multiple times. So we need to change the RegionDisjoint to take into account multiple crossings. This is easy enough, just check each segment in the noodle. If you really want your noodle to be a smooth curve, more thought needs to be given here. Counting the number of points in RegionIntersection should work. Then we color red any noodle where at least one segment intersects a line and otherwise black. Finally we count the number of intersections and compare against theory.
d = 0.2; l = 0.1; n = 1000;
lines = MeshRegion[Join @@ Table[{{-1-d,y},{1+d,y}}, {y,-1-d,1+d,d}], 
   Line[Partition[Range[2 Floor[2/d+3]],2]]];
noodles = Table[generateNoodle[l,10,pt], {pt, RandomReal[{-1, 1}, {n, 2}]}];
ints = With[{nood = #}, RegionDisjoint[#, lines] & /@ nood] & /@ noodles;
overlap = Extract[noodles, Position[And @@ # & /@ ints, False]];
Show[lines,Graphics[{Red, overlap, Black, Complement[noodles, overlap]}]]
{N[Count[ints, False, 2]/n], 2. t/([Pi] d)}

Output: {0.299, 0.31831} - not too bad!

$l=1/2$, $np=15$, $n=1000to$ theory $approx 1.59$, exp $=1.53$

kglr · Answer

randomNoodle[start_: {0, 0}, angle_: Pi/4, length_: 1, pieces_: 20] :=
  Line[AnglePath[start, Thread[{length/pieces, RandomReal[{-angle, angle}, pieces]}]]]

Examples:
SeedRandom[4444]
noodles = Table[randomNoodle[RandomReal[1, 2]], 20];

MinMax[ArcLength /@ noodles]

{1., 1.}

g = Graphics[{RandomColor[], Thick, #} & /@ noodles, ImageSize -> Large]

intersections = Graphics`Mesh`FindIntersections[g];
Show[g, Epilog -> {Red, PointSize[Large], Point @ intersections}, 
 ImageSize -> Large]

How to throw $n$ random noodles of equal length?

2 Answers

Add your own answers!

Ask a Question