Igla Buffona
Marek Kochanczyk, IS4, 2007

Opis zadania

Przygotować w programie Mathematica notebook pozwalający wyznaczyć przybliżoną wartość liczby π z zadania Buffona o igle.

Dany jest arkusz papieru poliniowany liniami prostymi równoległymi o równych odstępach wynoszących d. Krótką igłę o długości l ≤ d upuszczamy losowo na arkusz papieru. Można pokazać, że prawdopodobieństwo upadku igły na jedną z linii wynosi p=(2/π)(l/d). Stąd widać, że wykonując eksperyment N razy i uzyskując P krotne przecięcie jednej z linii możemy wyznaczyć przybliżoną wartość π. Zatem przybliżona wartość π ≈((2l)/d)(N/P). Zdarzenia polegające na upadku igły wzdłuż liniii, bądź przypadek, że koniec igły będzie dotykał linii jest równe zeru i w rozważaniach je pomijamy.

Notebook powinien się składać z kilku podsekcji. W notebooku powinny znaleźć się następujące rzeczy:
	1) użytkownik notebooka zadaje liczbę rzutów igły n (np. (10^5)razy; eksperymenty przeprowadzać dla małych wartości n ze względu na oszczędność czasu),
	2) rysunek pokazujący upadki igły (użyć różnych kolorów dla igły przecinającej linię i poza liniami),
	3) rysunek ilustrujący wyznaczanie przypliżonej wartości liczby π,
	4) stosować kolory w notebooku w nagłówkach sekcji, prezentacji grafiki, itp.,
	5) komentarze objaśniające.

Literatura pomocnicza:
	1) Martin Aigner, Günter M. Ziegler, Dowody z Księgi Wydawnictwo Naukowe PWN, Warszawa 2002) Rozdział 20
	2) Internet: np. http://www.angelfire.com/wa/hurben/buff.html, http://mathworld.wolfram.com/BuffonsNeedleProblem.html

Rozwiązanie

distanceBetweenLines=10; (* self-exlpanatory *)
needleLength              = 5;  (* self-explanatory *)
numberOfThrows    =100;(* self-explanatory *)

(NeedlesIntersecting={};) (NeedlesNotIntersecting={};) (Convergence={};) For[i=1,i<numberOfThrows,i++,angle=RandomReal[] 2 π;x=plotwidth RandomReal[];y=distanceBetweenLines (RandomReal[]-(1/2));x0=x-(1/2) needleLength Cos[angle];x1=x+(1/2) needleLength Cos[angle];y0=y-(1/2) needleLength Sin[angle];y1=y+(1/2) needleLength Sin[angle];If[y0 y1<0,NeedlesIntersecting=Append[NeedlesIntersecting,{Line[{{x0,y0},{x1,y1}}]}],NeedlesNotIntersecting=Append[NeedlesNotIntersecting,{Line[{{x0,y0},{x1,y1}}]}]];If[Length[NeedlesIntersecting]>0,Convergence=Append[Convergence,Abs[((2 numberOfThrows needleLength)/(Length[NeedlesIntersecting] distanceBetweenLines))-π]],Convergence=Append[Convergence,∞],Null];]

plotwidth=3 distanceBetweenLines;
Show[Graphics[{RGBColor[0.87`,0.87`,0.87`],Rectangle[{-(needleLength/2),-(distanceBetweenLines/2)-(needleLength/2)},{plotwidth+(needleLength/2),(distanceBetweenLines/2)+(needleLength/2)}],RGBColor[0.8`,0.8`,0.8`],Rectangle[{0,-(distanceBetweenLines/2)},{plotwidth,(distanceBetweenLines/2)}],RGBColor[0.8`,0.8`,0.8`],Thickness[0.002`],Line[{{-(needleLength/2),0},{plotwidth+(needleLength/2),0}}],RGBColor[0.5`,0.3`,0.1`],Thickness[0.004`],Line[{{0,0},{plotwidth,0}}],RGBColor[0.5`,0.5`,0.5`],Text["d/2",{plotwidth 1.02`,(distanceBetweenLines/(2 2))}],Text["d/2",{plotwidth 1.02`,-(distanceBetweenLines/(2 2))}],RGBColor[0.8`,0.7`,0.6`],Thickness[0.001`],NeedlesNotIntersecting,RGBColor[1.`,0.2`,0.2`],Thickness[0.001`],NeedlesIntersecting}]]

(* plot the value of π approximated after the last iteration *)
Print [ N[2 * numberOfThrows  * needleLength / Length[NeedlesIntersecting]/ distanceBetweenLines, 10] ]

ListPlot[Convergence,Joined->True,PlotStyle->Hue[0.9`]]