8
$\begingroup$

I am working on a mathematical problem called "Buffon's Needle". Here is the setup I made:

point[v_, u_] := Normalize[v - u] + u

experiment50 = Show[
  Graphics[
   Table[{
     RGBColor[0, 0, 0],
     Line[{{x, 0}, {x, 10}}]}, {x, 0, 10}]
   ],
  Graphics[
   Table[{
     RGBColor[0.66, 0.38, 0.91],
     u = {RandomReal[{0.5, 9.5}], RandomReal[{0.5, 9.5}]};
     v = {RandomReal[{-100, 100}], RandomReal[{-100, 100}]};
     Line[{point[v, u], u}]},
    {50}]
   ]
  ]

needles

I need to find how many purple segments are crossing the black lines. I thought about using FindRoot or extracting the plotted data points and finding points where the black lines and purple lines overlap, but I wasn't successful.

$\endgroup$
  • 1
    $\begingroup$ Can you add the code how you tried to use FindRoot? Or any other method that you tried. $\endgroup$ – ercegovac Oct 13 '17 at 21:22
  • $\begingroup$ is the base lines are parallel to the coordinate system (as this example) you only need to check if the one coordinate is on opposite sides of lines. This can be implemented much much faster than a geometric calculation. If the base lines are uniformly spaced it simplifies further... $\endgroup$ – george2079 Oct 13 '17 at 22:48
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Michael E2 Oct 13 '17 at 22:53
8
$\begingroup$

Update 3: With a method based RegionIntersection we can have arbitrary regions instead of vertical lines and get the intersection points conveniently. For example, using BezierCurves as the reference regions

cp =  Sort[RandomReal[10, {5,10, 2}]];
vlines = {Thick, RandomColor[], Line[BezierFunction[#] /@ Range[0, 1, .05]]} & /@ cp;

we get

enter image description here

As J.M. noted, if we need just the line segments intersecting vertical lines, this can be done using much simpler methods without the need for RegionIntersection. An alternative method to identify the segments cutting vertical lines with integer horizontal coordinates is

cutsGridQ = Ceiling[#[[1]]] <= Floor[#[[2]]] &@Sort[#[[All, 1]]] &;

SeedRandom[1]
randomcoords = {point[#2, #], #} & @@@ RandomReal[{.5, 9.5}, {50, 2, 2}];

Graphics[{Purple, Line /@ randomcoords, 
 Red, Line /@ Select[randomcoords, cutsGridQ]}, GridLines -> {Range[0, 10], None}]

enter image description here

Update 2: A function that takes two lists,l1 and l2, of lines and produces the points of intersection of each line in l1 with the lines in l2:

lineIntersections[l1_, l2_]:=Module[{tuples = Outer[List, l1, l2]}, 
  DeleteCases[RegionIntersection @@@ # & /@ tuples, _EmptyRegion, 2]]

Original answer:

SeedRandom[1]
point[v_, u_] := Normalize[v - u] + u
vlines = Table[{RGBColor[0, 0, 0], Line[{{x, 0}, {x, 10}}]}, {x, 0, 10}];
randomlines = Table[{RGBColor[0.66, 0.38, 0.91], 
        u = {RandomReal[{0.5, 9.5}], RandomReal[{0.5, 9.5}]};
        v = {RandomReal[{-100, 100}], RandomReal[{-100, 100}]};
        Line[{point[v, u], u}]}, {50}];

Get the Line primitives from the two lists above:

vlinesprims = Cases[vlines, _Line, {0, Infinity}];
rlinesprims = Cases[randomlines, _Line, {0, Infinity}];

Using RegionIntersection find the intersections of each vertical line with each of the random lines:

intersections = Table[DeleteCases[RegionIntersection[v, #]& /@ rlinesprims, _EmptyRegion],
  {v, vlinesprims}]

Display:

Graphics[{vlines, randomlines, PointSize[Large], 
  Transpose[{ColorData[97, "ColorList"][[;; Length@intersections ]], intersections}]}]

enter image description here

Update: For Version 9, you can use Graphics`Mesh`FindIntersections as follows:

Graphics`Mesh`MeshInit[]
intersections = Join @@@ (Table[Graphics`Mesh`FindIntersections[Graphics[{v, #}]] & /@ 
     rlinesprims, {v, vlinesprims}] /. {} -> Sequence[] /. {} -> Sequence[]);

Graphics[{vlines, randomlines, PointSize[Large], 
 Transpose[{ColorData[1, "ColorList"][[;; Length@intersections]], Point/@intersections}]}]

enter image description here

$\endgroup$
6
$\begingroup$

Here's a method that sidesteps fancy region functionality. We exploit your choice of using vertical grid lines at integer positions to make a simplified test for filtering out intersecting "needles":

pt[v_, u_] := Normalize[v - u] + u

(* can use Between instead if your version has it *)
hitGridQ[Line[{p1_, p2_}]] := 
   With[{min = Min[p1[[1]], p2[[1]]], max = Max[p1[[1]], p2[[1]]]}, 
        min <= Round[min + (max - min)/2] <= max]

n = 100;
BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; (* for reproducibility *)
            p1 = Graphics[{Directive[Purple, AbsoluteThickness[1/4]], 
                           segs = Table[With[{u = RandomReal[{0.5, 9.5}, 2], 
                                              v = RandomReal[{-100, 100}, 2]},
                                             Line[{pt[v, u], u}]], {n}]}, 
                          GridLines -> {Range[0, 10], None},
                          GridLinesStyle -> AbsoluteThickness[1]]]

needles

Show[p1, Graphics[{Directive[Red, AbsoluteThickness[1/4]], 
                   hits = Cases[segs, _?hitGridQ]}]]

marked needles

The $\pi$ estimate:

N[2 Length[segs]/Length[hits]]
   3.125

Still a long way off, but you do need to raise the value of n for something reasonable. Here, for instance, is what I get with n = 1000:

1000 needles

$\endgroup$
5
$\begingroup$

There's an example of exactly this in the documentation of RegionDisjoint. I'll copy it here.

Estimate $\pi$ by simulating Buffon's needle problem:

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

Create randomly orientated line segments of length $d$:

needles = Table[
  Line[{pt, RandomPoint[Circle[pt, d]]}], 
  {pt, RandomReal[{-1, 1}, {n, 2}]}
];

Select line segments that overlap the grid of lines:

overlap = Select[needles, !RegionDisjoint[lines, #] &];

Visualize overlapping line segments (red):

Show[lines, Graphics[{Red, overlap, Black, Complement[needles, overlap]}]]

enter image description here

Estimation of $\pi$:

N[2n/Length[overlap]]
3.14465
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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