ปัญหาเข็มของบึฟฟองBuffon’s Needle

เห็นมีคนพูดถึงปัญหานี้ในกลุ่มผู้ใช้ R ของไทยเราเลยเอามาเขียนโปรแกรมทำบ้างแต่ใช้ภาษา Wolfram แทนเพราะจะเขียนได้สั้นมาก

โปรแกรมที่เขียนนี้จะวาดเส้นแนวนอนที่มีระยะห่างตามที่กำหนดและก็สุ่มวางเข็มตามขนาดและจำนวนที่ต้องการลงไปแล้วนับดูว่าที่กี่เล่มที่ทับเส้น จากนั้นก็คำนวณประมาณค่า pi จากสูตรที่เขียนไว้ที่ https://en.wikipedia.org/wiki/Buffon%27s_needle ซึ่งก็คือ

โดย l คือความยาวเข็ม, n  คือจำนวนเข็ม, t คือระยะห่างระหว่างเส้นบรรทัด และ h คือจำนวนเข็มที่ทับเส้นบรรทัด

สำหรับวาดเส้นของเข็มและเส้นบรรทัด


genNeedle[{x_, y_}, θ_, len_] :=
Line[{{(x + 0.5 len Cos[θ]), (y + 0.5 Sin[θ])}, {(x –
0.5 len Cos[θ]), (y – 0.5 len Sin[θ])}}]

horizontalLine[diff_, len_, {x0_, y0_}, n_] :=
Table[Line[{{x0, y0 + (i diff)}, {len, y0 + (i diff)}}], {i, n}]

สำหรับประมาณค่า pi


estimatedPi[needlelength_, nneedles_, linespace_, ncross_] :=
2.*needlelength*nneedles /(linespace*ncross)

สำหรับ simulation


run[nl_, nfl_, ll_, diff_] :=
Module[{fls, ls, outls, pnts, ncross},
fls = horizontalLine[diff, 10, {0, 0}, nfl];
ls = Table[
genNeedle[{RandomReal[{0, 10}], RandomReal[{0, nfl*diff}]},
RandomReal[π], ll], {nl}];
outls =
Table[Solve[{x, y} ∈ RegionIntersection[fls[[i]], #], {x,
y}] & /@ ls, {i, Length@fls}];
pnts = Point[{x, y}] /. Flatten[outls, 2];
ncross = Length@Flatten[outls, 2];
Graphics[{fls, ls, Red, PointSize[Medium],
If[Length@Flatten[outls, 2] > 0, pnts]},
PlotLabel ->
Style["จำนวนเข็มที่ทับเส้น:" <> ToString@ncross <>
" π≈" <>
ToString@estimatedPi[ll, nl, diff, ncross], FontSize -> 20,
Bold]]];

ทดลองเล่นดู โดยใช้เข็ม 100 เล่ม และกำหนดให้มีเส้นบรรทัด 10 เส้น โดยระยะห่างระหว่างบรรทัดกับความยาวเข็มเท่ากัน


nlines = 10;
nneedles = 100;
linelength = 1;
linespace = 1;
run[nneedles, nlines, linelength, linespace]

สำหรับmathematica notebook สามารถdownloadได้จากhttps://github.com/slphyx/Buffon-s-Needle