Igła Buffona

Jacek Kwiatkowski,
student IV-go roku Fizyki,
Wydział Fizyki, Astronomii i Informatyki Stosowanej UJ

jacek.kwiatkowski@uj.edu.pl

Igła Buffona

W roku 1733 francuski szlachcic Georges-Louis Leclerc, hrabia de Buffon, postawił problem nazwany później Igłą Buffona. Rozwiązał go 44 lata później w roku 1777.

Jeśli na płaszczyznę pokrytą równoległymi liniami prostymi, odległymi od siebie o odległość d, upuszczamy igłę o długości l < d, to jakie jest prawdopodobieństwo, że igła przetnie którąś z linii?

Rozwiązanie:

Niech x będzie odległością środka igły od najbliższej linii, a θ kątem pomiędzy igłą a liniami. Łatwo zauważyć, że igła przetnie linię, jeśli x ≤(l/2)sin[θ].
Zmienne losowe opisujące odległość x i kąt θ są jednostajne i wzajemnie niezależne: x ~ U[0,(d/2)]  i  θ ~ U[0,(π/2)].
W efekcie prawdopodobieństwo tego zdarzenia wynosi: (∫_0^(π/2))(∫_0^((l/2) sinθ))(2/π)(2/d)dxdθ

Clear["Global`*"]
Assuming[{l > 0, d > 0, θ > 0, d > l}, Integrate[Integrate[(2*2)/(Pi*d), {x, 0, (1/2)*l*Sin[θ]}],{θ, 0, Pi/2}]]

Korzystając z powyższego wyniku i oznaczając przez x stosunek długości igły do odległości pomiędzy liniami:x=(l/d) i zakładając, że po n rzutach igła p-krotnie przecięła którąś z linii można wyznaczyć wartość liczby π:

E[π] = ((2x n)/p)

Dalsza część notebooka służy do wyznaczenia wartości π za pomocą powyższej zależności.

Podajemy długość igły i ilość rzutów

x - stosunek długości igły do odległości pomiędzy liniami l/d, n - liczba rzutów

x=0.5;

n=1000;

Rzucamy igłą

x1 - współrzędna x pierwszego końca igły

x1=Table[RandomReal[{1,10}],{n}];

y1 - współrzędna y pierwszego końca igły

y1=RandomReal[{1,10},{n}];

kat - kąt pomiędzy igłą a liniami

kat=Table[RandomReal[{1,10}],{n}];

igly - obliczone na podstawie wylosowanych powyżej danych współrzędne końców igły po n rzutach

igly=Table[{{Extract[x1,i],Extract[y1,i]},{Extract[x1,i]+x Cos[2π Extract[kat,i]],Extract[y1,i]+x Sin[ 2π Extract[kat,i]]}},{i,1,n}];

poniższe polecenie sprawdza, które igły przecięły równoległe linie

c=Table[If[IntegerPart[Extract[Extract[Extract[igly,i],1],2]]==IntegerPart[Extract[Extract[Extract[igly,i],2],2]],0,1],{i,1,n}];

definicja funkcji obliczającej stosunek liczby przecięć do liczby rzutów po każdym rzucie

funk[j_]:=Count[Take[c,{1,j}],1]

u=Table[funk[i],{i,1,n}];

poniższa lista zawiera estymowane wartości liczby π po każdym rzucie

t=Table[If[Extract[u,i]==0,Infinity,2x i/Extract[u,i]],{i,1,n}];

Kreślimy wykres z wynikami i rysunek z igłami oraz wyznaczamy wartość π

poniższe polecenia definiują obiekty zamieszczone na rysunku przedstawiającym upadające igły

siatka=Table[{{0.5,i},{10.5,i}},{i,1,10}];

jeden=Select[Table[If[Extract[c,i]==1,i,0],{i,1,n}],#≠0&];

zero=Select[Table[If[Extract[c,i]==0,i,0],{i,1,n}],#≠0&];

przeciecie=Table[Extract[igly,Extract[jeden,j]],{j,1,Length[jeden]}];

brakprzeciecia=Table[Extract[igly,Extract[zero,j]],{j,1,Length[zero]}];

Liczb π wynosi:

Extract[t, Length[t]]

wykres przedstawiający estymowaną wartość π po kolejnych rzutach:

Show[ListPlot[t,PlotStyle->{Green}],Plot[π,{x,1,n},PlotStyle->{Red,Thick}]]

rysunek przedstawiający upuszczone igły:

Graphics[{Red,Line[przeciecie],Blue,Line[brakprzeciecia],Black,Thick,Line[siatka],Orange,Line[{{0,0},{0,11},{11,11},{11,0},{0,0}}]}]

Bibliografia

M. Aigner, G. M. Ziegler, Dowody z Księgi, Wydawnictwo Naukowe PWN, Warszawa 2002

http://mathworld.wolfram.com/BuffonsNeedleProblem.html

http://pl.wikipedia.org/wiki/Igła_Buffona

http://en.wikipedia.org/wiki/Buffon's_needle

http://www.cut-the-knot.org/fta/Buffon/buffon9.shtml