4
$\begingroup$

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:

enter image description here

Improve this question
$\endgroup$
8
  • $\begingroup$ What's your distribution of shapes of your noodles? (You simply cannot solve the problem without such knowledge.) $\endgroup$
    – David G. Stork
    Commented Jun 23, 2021 at 4:43
  • $\begingroup$ The noodles can be any rigid plane curve. So every separate noodle can be any random curve (as long as their arc length is equal). It really would be akin to throwing noodles on a table. $\endgroup$
    – Bhoris Dhanjal
    Commented Jun 23, 2021 at 4:51
  • $\begingroup$ "Any random curve" is meaningless. You simply must state a distribution, otherwise the problem is unsolvable. If all the noodles "happen" to be straight you'll get one answer; if they "happen" to be wound into teeny spirals you'll get another; if they... $\endgroup$
    – David G. Stork
    Commented Jun 23, 2021 at 6:22
  • $\begingroup$ The expected number of crossings does not depend on the shape of the noodles. The problem statement is exactly that it each of the noodles take the form of any possible rigid plane curve. This is written in the linked Wikipedia page. The only constraint is that each noodle must have the same arc length. I've seen it implemented in a Wolfram Demonstrations using truncated Bezier curves but it doesn't count the crossings. demonstrations.wolfram.com/TheBuffonNoodleProblem $\endgroup$
    – Bhoris Dhanjal
    Commented Jun 23, 2021 at 6:30
  • $\begingroup$ The demonstration you link to does count the number of crossings, and displays them. $\endgroup$
    – Szabolcs
    Commented Jun 23, 2021 at 11:28

2 Answers 2

Reset to default
4
$\begingroup$

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!

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks! I was pretty much looking for something like this. I suppose the only way to "solve" this problem is through what you call a quick hack, since there is no well defined shape for the noodle. $\endgroup$
    – Bhoris Dhanjal
    Commented Jun 25, 2021 at 5:28
0
$\begingroup$ 
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]

enter image description here

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

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.