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

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

โปรแกรมที่เขียนนี้จะวาดเส้นแนวนอนที่มีระยะห่างตามที่กำหนดและก็สุ่มวางเข็มตามขนาดและจำนวนที่ต้องการลงไปแล้วนับดูว่าที่กี่เล่มที่ทับเส้น

สำหรับวาดเส้น


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

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

สำหรับ simulation


run[nl_, nfl_, ll_, diff_] := Module[{fls, ls, outls, pnts},
fls = fixLine[diff, 10, {0, 0}, nfl];
ls = Table[
genLine[{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];
Graphics[{fls, ls, Red, PointSize[Medium],
If[Length@Flatten[outls, 2] > 0, pnts]},
PlotLabel ->
Style["จำนวนที่ทับเส้น:" <> ToString@Length@Flatten[outls, 2],
FontFamily -> "TH Krub", FontSize -> 20, Bold]
]
];

ทดลองเล่นดู