(* Content-type: application/vnd.wolfram.mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 8.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 157, 7] NotebookDataLength[ 30296, 756] NotebookOptionsPosition[ 29029, 707] NotebookOutlinePosition[ 29674, 732] CellTagsIndexPosition[ 29631, 729] WindowTitle->Buffon's Needle Problem - Source WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Buffon's Needle Problem", "Section", CellFrame->{{0, 0}, {0, 0}}, ShowCellBracket->False, FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[BoxData[ GraphicsBox[RasterBox[CompressedData[" 1:eJztnVuSozgWQDNiPqa3MJ+zpVlCbaB3WlGVNV9dvYH6TQRUph/ZGIHQmwvG xoZzQu3Aku7VfUj4Nk53//fLn//78q+Xl5f/NP/88e+Xl8v154Xj5+fp89y0 4+X63L7VnQu02XqOt9FzjRK5qtRMoYZFpk11/Ji+WDye92+r7+fFfbnGkuu9 eIQ4LBVJ+YRo5DPnRdITDp0TLRg6m/62nY/n08f5+H461G37fWqum57z4Xy2 jby0prMZOh4/jodLOx2bt6fzRSEA3B/KMKGSBy/DSKVcyYOn8krHqajvqed6 G6iol4qkfAIVNQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADsizPA/lj72AEA AMCmWLu0AXh01j6jAAAAcdb+hNwUJ5e1zZnPDEeey/e1jx0AAABsirVLm03x XFVlhs1X1JNY+4wCAAB02B9PJ4BdsvYpBAAAgOeGihpADo9GAUDIr+Lnr7ef a9vw16/i73VtMPx6+2v1gGwMijeAE89FAQA2DRW1BxX14lBRA0wi+lx0baMA AAAAAAAAAAAAbkj0uegR4L4cDoe1TYA1YQMAbIaDy9rm3JU9+w4AjwB3np3D BgDYDHuuKu/su3k0ynNRACGLHMy93dm2ijCPpHvD7LliAQAAmA0VNRioqIGK GlYk9Vz0AAAAAAAAAAAAALBR9KPR8Kf0a9sFAAAAAAAAAAAAcCt4LgoAAAAA AAAAAAB7I/Vc9ONheH9/X9uEzUJsZ0PoAGBZ3gNuLQgggR21GUjl7SC2syF0 ALAsVNQgxMv14XAI/xOja9sIAAAAT0lYWM5jbT/msGffAQAAAGAp9lxV3sF3 b1r0uehSZgAAAAAAAAAAAAA8Ar9b6rpuXpu3+tf0PBcFWJcFvxYBAAAAANgh VNQAADCK5LnobwAAAAAAAAAAAIANUbcPRav+wehH7LmoUqpsqKqmNTSXRVE0 by593mtRXlrfo7mImTlVN6ebUOhR07q3jmxVWXqquqxVOUjZq1eDVNe662ro Nxe1Xr5o2lt5cUc7VWr3BpGindNL6TkDl5nVIGWtbuaXWbwJo/OVKjSX68oL shMTO4ylHf+yy5GbhU5EubJJPeWgx5ayBfvOIR2qD5QJXWmFtJs2pLsLvu40 4oOesh/tJ3TKW/3DomZONgVdVPtNXvVXYWydyBRl/NWNWNW62L06G344TcNW L/SVpaTqcmeOWGWOm3W+TFPWsbL8dE1yklUal73ghDtBH+Hu1dE/HBM7/t7h sjNoN29Calrl2GadWfsMeoc0elcR584clrm5qzO5a+5mQe4imy2Tu1qcu+g2 7od7mkvVtqJtajgInQuqzUrRtWFCzIAkzQdK0/RR1U33JEhtgOhosnmLKtX0 DArVhaJHtZOlmgPbVN+mWZhRGzNvEc13MD61kIRcEPS2WciRp/C97a0ow569 DCOVRurZU0lFnUoBFbWkKiv7I0xFLc4dFXUAFfVUtVTUYRD2V1EnfTd7u920 v+va/NXoSXM86qXVwFtzgNvS7vJG3730Ga76Wkq/6lFz3dlWOa+69XpUOSix ixQtrrVV1pxBleO+uesMsv6QjenXF+bViFjGO5rtObaUp7bVoENe21Kqy1Un 1M8xOaxNftysOh61q5joKStQpbkIQ2p54HRWXcqsOsbVU7oZNBr8Fbv+yotk GBkvbuFbu9/LkY6DF3ZvTvqtOVXdBi0dlN6WZekEsHfQ2flmjpnQ+25vfn// 2yH1eswnokp/tNkpsJNrTqJruX4tzAkKBJXJVdUbbJmtrwtrUfuoGm2Ru5S3 AcrEGQyPld3jzbFTH+oP+is3d+XVuev2wI1zN9w8rZM1I3dFf203xxKvuUyT TevJkd8JSzF7iVHBzJa+D0vFZJLapawNh6xiQ91ixaf03R+lDHvaMqwPCKl8 +lRGgkZF3W3Q0oGKmoq685yKmoo6L5jZ0vdhqZhMUruUteEQFfUk37VU98C8 qRvq+uPjQz8UPZ/P+snoZYIqVAwtaFY0r+E0+8l8VIM3Gs70JkelUoLR0XBm 2X5dldcmWS5lQ2r1jDue+DBaRvrzvidVpc2WOKJicRvVZu+HaFqjgpngC/MS Fek2rRvSjKCy9rnxfepWFFKokVMzWaEsU9GDbEYnbfuoYOpGkdcwql/Sv+fc CVdJcY1a+Yo3WuUaZsfE+9S+j3mTRuFZoAxL9eTtFK6ecccTH0bnlmGkMtXz dKnMLCTpifZTUUfnyNOR4QGrstQuHTXGFqSiXiV3wlVSXKNWvuKNVrmG2TGh ooZb0+T0rUWf/br9e1HvuWjR/z1/+JOUIujKPxYu+l9YCEX0kGVARDxjjHxa ygZv6ejF6KiE0cfp0eUk6JMrmVamQx1qkPTIRzNSo4LC0OnbV7S/tD7WRw32 ElFYP1/y7EkZn09lPhHedej7vDiHSkbzq79YsWcWfUUUzYgXf7mdqa04eiK0 ebYxe86d9yE+T3n+OzuVqHbMx01Up/kkCud7Q0ZJ5uvCRQhNGvVCoueayK9O mKP8qDDd9szol7b5AM5LSup0P7LvxXBX8dWGvlCGTTJm1IBwianK3QySyo2k clR/KtShBkmPfDQjNSpIRS0xexJRy8NjS0UtMfVBcmegoh6FijrkEarKPVfU Gd89w+rwd/Tt34uq/kuT6C2xsG5WhXvLsu+KUb+8/kxsvQMryUIxdp8PLc/c FiblXaJEcgvKuODFf54N8yYXwYejZ2fUbO8i5b7kXwRSPfJtFu1JWZ7BtlZu eRg9XXJEbcuriorIU2xkjYjQi2hJFjXeFvFmhjeNUWu9HhO3/LQoe8tdSKqC ys+f+tE5aZVoBSU0T87U+sr2emq4Ur7k9eQrhydiaqiF3LqSX4QFfacMk684 yaT7l2GkUr7iJJOoqKMrUlGPritxZ9RyT9aIUFHn133e3IVQUQvVUlHPhor6 1r6r/k9G9X1A/47+dDrZ/9+lb9++vbr8+PHDe7X7w077rafHU+JNTo1GF/Wu U52hhtCjqGEZJVGdoZsp5ZmZoRe2kc3Fd0tnKGKvJQ9UKr8pRh15dY0MZTOO e/pTa43OSUmFpn5Pbzzv7agveTNCJRnZ70FCX4OU5ZWn9KfiELrpLZ3aIZn0 RYmGN+NRPsIpd7y19pa7qIhQZ15coicVmamMLjpb1SLmLUgmzlOtzau6RRAm bYxFTJoh9Vy+U4aNKonqDN1MKc/MDL2wjXydWIaRylElz5LKVExSS2Scigqm HHl1jQxlM457+lNrjc5JSYWmUlF7jqQ2RmqHZNIXJRrejEf5CKfc8dbaW+6i IkKdeXGJnlRkpjK66GxVi5i3IJk4T7U2r+oWQZi0MRYxaYbUZnyPLvH/lte2 FP/69esnAAAAAAAAAAAAwM74B4thROM= "], {{0, 0}, {1800, 25}}, {0, 255}, ColorFunction->RGBColor], ImageSize->{1800, 25}, PlotRange->{{0, 1800}, {0, 25}}]], "Section", CellFrame->{{0, 0}, {0, 0}}, ShowCellBracket->False], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"BuffonsNeedle", "[", RowBox[{"r_", ",", RowBox[{"{", RowBox[{"x_", ",", "y_"}], "}"}], ",", "n_"}], "]"}], ":=", RowBox[{"Module", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"data", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", RowBox[{"Random", "[", "Real", "]"}]}], ",", RowBox[{"y", " ", RowBox[{"Random", "[", "Real", "]"}]}]}], "}"}], ",", RowBox[{"\[Pi]", " ", RowBox[{"Random", "[", "Real", "]"}]}]}], "}"}], ",", RowBox[{"{", "n", "}"}]}], "]"}]}], ",", "\[IndentingNewLine]", "lines", ",", "hits", ",", "misses"}], "\[IndentingNewLine]", "}"}], ",", "\[IndentingNewLine]", RowBox[{"Graphics", "[", RowBox[{ RowBox[{ RowBox[{"lines", "=", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Function", "[", RowBox[{"s", ",", RowBox[{ RowBox[{"First", "[", "#", "]"}], "+", RowBox[{"s", " ", RowBox[{"r", "/", "2"}], " ", RowBox[{"Through", "[", RowBox[{ RowBox[{"{", RowBox[{"Cos", ",", "Sin"}], "}"}], "[", RowBox[{"Last", "[", "#", "]"}], "]"}], "]"}]}]}]}], "]"}], "/@", RowBox[{"{", RowBox[{"1", ",", RowBox[{"-", "1"}]}], "}"}]}], ")"}], "&"}], "/@", "data"}]}], ";", "\[IndentingNewLine]", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"#", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"#", ",", "y"}], "}"}]}], "}"}], "]"}], "&"}], "/@", RowBox[{"Range", "[", RowBox[{"0", ",", RowBox[{"Ceiling", "[", "x", "]"}]}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{"PointSize", "[", ".01", "]"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"misses", ",", "hits"}], "}"}], "=", RowBox[{"Map", "[", RowBox[{"Last", ",", RowBox[{"Split", "[", RowBox[{ RowBox[{"Sort", "[", RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{ RowBox[{"Abs", "[", RowBox[{ RowBox[{ RowBox[{"Subtract", "@@", RowBox[{"(", RowBox[{"Floor", "/@", RowBox[{"First", "/@", "#"}]}], ")"}]}], "&"}], "/@", "lines"}], "]"}], ",", "lines"}], "}"}], "]"}], "]"}], ",", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"First", "[", "#1", "]"}], "==", RowBox[{"First", "[", "#2", "]"}]}], "&"}], ")"}]}], "]"}], ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Transpose", "[", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"RGBColor", "[", RowBox[{"1", ",", ".47", ",", "0"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{".67", ",", ".75", ",", ".15"}], "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"Line", "/@", "#"}], "}"}], "&"}], "/@", RowBox[{"{", RowBox[{"hits", ",", "misses"}], "}"}]}]}], "\[IndentingNewLine]", "}"}], "]"}]}]}], "\[IndentingNewLine]", "}"}]}], ",", " ", RowBox[{"PlotLabel", "\[Rule]", " ", RowBox[{"Column", "[", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"Style", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"ToString", "[", RowBox[{"TraditionalForm", "[", RowBox[{"\"\\"", "/", "\"\\""}], "]"}], "]"}], ",", "\"\< = \>\"", ",", RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"a", "=", RowBox[{"Length", "[", "hits", "]"}]}], ",", RowBox[{"b", "=", "n"}]}], "}"}], ",", RowBox[{"HoldForm", "[", RowBox[{"a", "/", "b"}], "]"}]}], "]"}], ",", "\"\< \[TildeTilde] \>\"", ",", RowBox[{"ToString", "[", RowBox[{"Round", "[", RowBox[{"100", RowBox[{ RowBox[{"Length", "[", "hits", "]"}], "/", "n"}]}], "]"}], "]"}], ",", "\"\<%\>\""}], "}"}], "]"}], ",", "\"\\""}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Style", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"Row", "[", RowBox[{"{", RowBox[{"\"\<\[Pi]\>\"", ",", "\"\< \[TildeTilde] \>\"", ",", RowBox[{"ToString", "[", RowBox[{"TraditionalForm", "[", RowBox[{ RowBox[{"(", "\"\<2 \[Times] L \[Times] N\>\"", ")"}], "/", "\"\\""}], "]"}], "]"}], ",", "\"\< = \>\"", ",", RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"a", "=", RowBox[{"Length", "[", "hits", "]"}]}], ",", RowBox[{"b", "=", "n"}], ",", " ", RowBox[{"c", "=", "r"}]}], "}"}], ",", RowBox[{"HoldForm", "[", RowBox[{ RowBox[{"(", RowBox[{"2", "c", " ", "b"}], ")"}], "/", "a"}], "]"}]}], "]"}], ",", "\"\< \[TildeTilde] \>\"", ",", RowBox[{"ToString", "[", RowBox[{"N", "[", RowBox[{"2", "n", " ", RowBox[{"r", "/", RowBox[{"Length", "[", "hits", "]"}]}]}], "]"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", "\"\\""}], "]"}]}], "}"}], "]"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"-", "1"}], "/", "2"}], ",", RowBox[{"x", "+", RowBox[{"1", "/", "2"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"-", "1"}], "/", "2"}], ",", RowBox[{"y", "+", RowBox[{"1", "/", "2"}]}]}], "}"}]}], "}"}]}], ",", RowBox[{"ImageSize", "\[Rule]", RowBox[{"{", RowBox[{"400", ",", "300"}], "}"}]}]}], "]"}]}], "\[IndentingNewLine]", "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.371567935977227*^9, 3.3715679361574955`*^9}, { 3.3715680118000355`*^9, 3.371568026632102*^9}, {3.3715683750104136`*^9, 3.371568461699388*^9}, {3.371568506696334*^9, 3.3715685322743883`*^9}, { 3.3715696990502977`*^9, 3.3715697121998615`*^9}, {3.37157008190991*^9, 3.371570089100608*^9}, {3.371570221016871*^9, 3.371570221978301*^9}, { 3.371570971613596*^9, 3.3715710176320615`*^9}, {3.3715710538058805`*^9, 3.3715710748572006`*^9}, {3.3715716266681757`*^9, 3.371571649131596*^9}, { 3.3715719146265955`*^9, 3.371571915017176*^9}, {3.371572088294976*^9, 3.3715720989307995`*^9}, 3.3715727538652*^9, {3.3715731991977587`*^9, 3.371573206849142*^9}, {3.3715734730952587`*^9, 3.3715734816079235`*^9}, { 3.371573520926421*^9, 3.3715735215172997`*^9}, {3.3718265049862957`*^9, 3.371826507690319*^9}, 3.37744412861034*^9, 3.377444329248325*^9, { 3.3774443597321587`*^9, 3.3774444238143044`*^9}, {3.3774444701409187`*^9, 3.3774444974802303`*^9}, 3.3774445335020275`*^9, {3.3793425221408863`*^9, 3.3793425616096067`*^9}, {3.379348050802926*^9, 3.3793480936867275`*^9}, { 3.3793481682777033`*^9, 3.379348218852948*^9}, {3.379348260114336*^9, 3.3793483248806944`*^9}, {3.3793483825164437`*^9, 3.3793483842490215`*^9}, {3.379348538959197*^9, 3.37934864277365*^9}, { 3.3793490003456397`*^9, 3.3793490609758444`*^9}, 3.3793491017565174`*^9, { 3.3793491834781013`*^9, 3.3793491878746424`*^9}, {3.3793492333723326`*^9, 3.3793492482144146`*^9}, {3.3793493447352147`*^9, 3.3793494018267393`*^9}, {3.3793494675806327`*^9, 3.379349589594864*^9}, { 3.3793496379358892`*^9, 3.379349644465539*^9}, {3.3793496904535007`*^9, 3.3793497711627736`*^9}, {3.379349806755373*^9, 3.379349850359812*^9}, { 3.37934990581176*^9, 3.379349910158183*^9}, {3.3793499433572445`*^9, 3.379349945420294*^9}, {3.379448252823655*^9, 3.379448260444994*^9}, { 3.38136316559375*^9, 3.381363169328125*^9}, 3.3822959134576645`*^9, { 3.3822962365926437`*^9, 3.3822962688480597`*^9}, {3.382384193194062*^9, 3.382384207740937*^9}}, CellID->23332973], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{ RowBox[{"SeedRandom", "[", "sr", "]"}], ";", RowBox[{"BuffonsNeedle", "[", RowBox[{"length", ",", RowBox[{"{", RowBox[{"10", ",", "6"}], "}"}], ",", "needles"}], "]"}]}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"needles", ",", "200", ",", "\"\\""}], "}"}], ",", "20", ",", "1000", ",", "1", ",", RowBox[{"Appearance", "\[Rule]", " ", "\"\\""}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"length", ",", ".6", ",", "\"\\""}], "}"}], ",", ".25", ",", "1", ",", RowBox[{"Appearance", "\[Rule]", " ", "\"\\""}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"sr", ",", "12", ",", "\"\\""}], "}"}], ",", "1", ",", "100", ",", "1"}], "}"}], ",", RowBox[{"SaveDefinitions", "\[Rule]", "True"}]}], "]"}]], "Input", CellChangeTimes->{ 3.35696210375764*^9, {3.371573322841714*^9, 3.3715733232022505`*^9}, 3.3715733807278357`*^9, {3.371573739782031*^9, 3.371573750648197*^9}, { 3.379342666675923*^9, 3.37934267644045*^9}, {3.3793428161382904`*^9, 3.379342845401828*^9}, {3.379348006436919*^9, 3.379348029471189*^9}, { 3.379349973251423*^9, 3.3793499744732285`*^9}, {3.380731648875*^9, 3.3807316495*^9}, 3.382296136201291*^9}, CellID->9893883] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`length$$ = 0.6, $CellContext`needles$$ = 200, $CellContext`sr$$ = 12, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`needles$$], 200, "number of needles (N)"}, 20, 1000, 1}, {{ Hold[$CellContext`length$$], 0.6, "needle length (L)"}, 0.25, 1}, {{ Hold[$CellContext`sr$$], 12, "random seed"}, 1, 100, 1}}, Typeset`size$$ = {400., {148., 152.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`needles$525205$$ = 0, $CellContext`length$525206$$ = 0, $CellContext`sr$525207$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`length$$ = 0.6, $CellContext`needles$$ = 200, $CellContext`sr$$ = 12}, "ControllerVariables" :> { Hold[$CellContext`needles$$, $CellContext`needles$525205$$, 0], Hold[$CellContext`length$$, $CellContext`length$525206$$, 0], Hold[$CellContext`sr$$, $CellContext`sr$525207$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> ( SeedRandom[$CellContext`sr$$]; \ $CellContext`BuffonsNeedle[$CellContext`length$$, {10, 6}, $CellContext`needles$$]), "Specifications" :> {{{$CellContext`needles$$, 200, "number of needles (N)"}, 20, 1000, 1, Appearance -> "Labeled"}, {{$CellContext`length$$, 0.6, "needle length (L)"}, 0.25, 1, Appearance -> "Labeled"}, {{$CellContext`sr$$, 12, "random seed"}, 1, 100, 1}}, "Options" :> {}, "DefaultOptions" :> {ControllerLinking -> True}], ImageSizeCache->{445., {219., 224.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>(({$CellContext`BuffonsNeedle[ Pattern[$CellContext`r, Blank[]], { Pattern[$CellContext`x, Blank[]], Pattern[$CellContext`y, Blank[]]}, Pattern[$CellContext`n, Blank[]]] := Module[{$CellContext`data = Table[{{$CellContext`x Random[Real], $CellContext`y Random[Real]}, Pi Random[ Real]}, {$CellContext`n}], $CellContext`lines, \ $CellContext`hits, $CellContext`misses}, Graphics[$CellContext`lines = Map[Map[ Function[$CellContext`s, First[#] + ($CellContext`s ($CellContext`r/2)) Through[ {Cos, Sin}[ Last[#]]]], {1, -1}]& , $CellContext`data]; { Map[Line[{{#, 0}, {#, $CellContext`y}}]& , Range[0, Ceiling[$CellContext`x]]], PointSize[ 0.01], {$CellContext`misses, $CellContext`hits} = Map[Last, Split[ Sort[ Transpose[{ Abs[ Map[Apply[Subtract, Map[Floor, Map[ First, #]]]& , $CellContext`lines]], \ $CellContext`lines}]], First[#] == First[#2]& ], {2}]; Transpose[{{ RGBColor[1, 0.47, 0], RGBColor[0.67, 0.75, 0.15]}, Map[{ Map[ Line, #]}& , {$CellContext`hits, $CellContext`misses}]}]}, PlotLabel -> Column[{ Style[ Row[{"hit ratio: ", ToString[ TraditionalForm["hits"/"N"]], " = ", With[{$CellContext`a = Length[$CellContext`hits], $CellContext`b = \ $CellContext`n}, HoldForm[$CellContext`a/$CellContext`b]], " \[TildeTilde] ", ToString[ Round[100 (Length[$CellContext`hits]/$CellContext`n)]], "%"}], "Label"], Style[ Row[{"\[Pi]", " \[TildeTilde] ", ToString[ TraditionalForm["2 \[Times] L \[Times] N"/"hits"]], " = ", With[{$CellContext`a = Length[$CellContext`hits], $CellContext`b = \ $CellContext`n, $CellContext`c = $CellContext`r}, HoldForm[(( 2 $CellContext`c) $CellContext`b)/$CellContext`a]], " \[TildeTilde] ", ToString[ N[(2 $CellContext`n) ($CellContext`r/ Length[$CellContext`hits])]]}], "Label"]}], PlotRange -> {{(-1)/2, $CellContext`x + 1/2}, {(-1)/ 2, $CellContext`y + 1/2}}, ImageSize -> {400, 300}]]}; Typeset`initDone$$ = True); ReleaseHold[ HoldComplete[{$CellContext`BuffonsNeedle[ Pattern[$CellContext`r, Blank[]], { Pattern[$CellContext`x, Blank[]], Pattern[$CellContext`y, Blank[]]}, Pattern[$CellContext`n, Blank[]]] := Module[{$CellContext`data = Table[{{$CellContext`x Random[Real], $CellContext`y Random[Real]}, Pi Random[Real]}, {$CellContext`n}], $CellContext`lines, \ $CellContext`hits, $CellContext`misses}, Graphics[$CellContext`lines = Map[Map[ Function[$CellContext`s, First[#] + $CellContext`s ($CellContext`r/2) Through[ {Cos, Sin}[ Last[#]]]], {1, -1}]& , $CellContext`data]; { Map[Line[{{#, 0}, {#, $CellContext`y}}]& , Range[0, Ceiling[$CellContext`x]]], PointSize[ 0.01], {$CellContext`misses, $CellContext`hits} = Map[Last, Split[ Sort[ Transpose[{ Abs[ Map[Apply[Subtract, Map[Floor, Map[ First, #]]]& , $CellContext`lines]], \ $CellContext`lines}]], First[#] == First[#2]& ], {2}]; Transpose[{{ RGBColor[1, 0.47, 0], RGBColor[0.67, 0.75, 0.15]}, Map[{ Map[ Line, #]}& , {$CellContext`hits, $CellContext`misses}]}]}, PlotLabel -> Column[{ Style[ Row[{"hit ratio: ", ToString[ TraditionalForm["hits"/"N"]], " = ", With[{$CellContext`a = Length[$CellContext`hits], $CellContext`b = \ $CellContext`n}, HoldForm[$CellContext`a/$CellContext`b]], " \[TildeTilde] ", ToString[ Round[100 (Length[$CellContext`hits]/$CellContext`n)]], "%"}], "Label"], Style[ Row[{"\[Pi]", " \[TildeTilde] ", ToString[ TraditionalForm["2 \[Times] L \[Times] N"/"hits"]], " = ", With[{$CellContext`a = Length[$CellContext`hits], $CellContext`b = \ $CellContext`n, $CellContext`c = $CellContext`r}, HoldForm[( 2 $CellContext`c $CellContext`b)/$CellContext`a]], " \[TildeTilde] ", ToString[ N[ 2 $CellContext`n ($CellContext`r/ Length[$CellContext`hits])]]}], "Label"]}], PlotRange -> {{(-1)/2, $CellContext`x + 1/2}, {(-1)/ 2, $CellContext`y + 1/2}}, ImageSize -> {400, 300}]]; Null}]]; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellID->88524803], Cell[CellGroupData[{ Cell["CAPTION", "Section", CellFrame->{{0, 0}, {1, 0}}, CellFrameColor->RGBColor[0.87, 0.87, 0.87], FontFamily->"Helvetica", FontSize->12, FontWeight->"Bold", FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[TextData[{ "Toss a box of ", StyleBox["N", FontSlant->"Italic"], " needles onto a floor with parallel lines. Count the number of hits\ \[LongDash]that is, the number of times that a needle crosses a line. This \ turns out to be a method for estimating ", Cell[BoxData[ FormBox["\[Pi]", TraditionalForm]], "InlineMath"], "." }], "Text"] }, Close]] }, Open ]], Cell[CellGroupData[{ Cell["THIS NOTEBOOK IS THE SOURCE CODE FROM", "Text", CellFrame->{{0, 0}, {0, 0}}, CellMargins->{{48, 10}, {4, 28}}, CellGroupingRules->{"SectionGrouping", 25}, CellFrameMargins->{{48, 48}, {6, 5}}, CellFrameColor->RGBColor[0.87, 0.87, 0.87], FontFamily->"Helvetica", FontSize->10, FontWeight->"Bold", FontColor->RGBColor[0.597406, 0, 0.0527047]], Cell[TextData[{ "\"", ButtonBox["Buffon's Needle Problem", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/BuffonsNeedleProblem/"], None}, ButtonNote->"http://demonstrations.wolfram.com/BuffonsNeedleProblem/"], "\"", " from ", ButtonBox["the Wolfram Demonstrations Project", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/"], None}, ButtonNote->"http://demonstrations.wolfram.com/"], "\[ParagraphSeparator]\[NonBreakingSpace]", ButtonBox["http://demonstrations.wolfram.com/BuffonsNeedleProblem/", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/BuffonsNeedleProblem/"], None}, ButtonNote->"http://demonstrations.wolfram.com/BuffonsNeedleProblem/"] }], "Text", CellMargins->{{48, Inherited}, {0, Inherited}}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.5]], Cell[TextData[{ "Contributed by: ", ButtonBox["Ed Pegg Jr", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/author.html?author=Ed+Pegg+Jr"], None}, ButtonNote-> "http://demonstrations.wolfram.com/author.html?author=Ed+Pegg+Jr"], " and ", ButtonBox["Eric W. Weisstein", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/author.html?author=Eric+W.+\ Weisstein"], None}, ButtonNote-> "http://demonstrations.wolfram.com/author.html?author=Eric+W.+Weisstein"] }], "Text", CellDingbat->"\[FilledSmallSquare]", CellMargins->{{66, 48}, {2, 4}}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.6], CellID->179514607], Cell[CellGroupData[{ Cell[TextData[{ "A full-function Wolfram ", StyleBox["Mathematica", FontSlant->"Italic"], " system (Version 6 or higher) is required to edit this notebook.\n", StyleBox[ButtonBox["GET WOLFRAM MATHEMATICA \[RightGuillemet]", BaseStyle->"Hyperlink", ButtonData->{ URL["http://www.wolfram.com/products/mathematica/"], None}, ButtonNote->"http://www.wolfram.com/products/mathematica/"], FontFamily->"Helvetica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[1, 0.42, 0]] }], "Text", CellFrame->True, CellMargins->{{48, 68}, {8, 28}}, CellFrameMargins->12, CellFrameColor->RGBColor[0.87, 0.87, 0.87], CellChangeTimes->{3.3750111182355957`*^9}, ParagraphSpacing->{1., 1.}, FontFamily->"Verdana", FontSize->10, FontColor->GrayLevel[0.411765], Background->RGBColor[1, 1, 1]], Cell[TextData[{ "\[Copyright] ", StyleBox[ButtonBox["Wolfram Demonstrations Project & Contributors", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/"], None}, ButtonNote->"http://demonstrations.wolfram.com/"], FontColor->GrayLevel[0.6]], "\[ThickSpace]\[ThickSpace]\[ThickSpace]|\[ThickSpace]\[ThickSpace]\ \[ThickSpace]", StyleBox[ButtonBox["Terms of Use", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/termsofuse.html"], None}, ButtonNote->"http://demonstrations.wolfram.com/termsofuse.html"], FontColor->GrayLevel[0.6]], "\[ThickSpace]\[ThickSpace]\[ThickSpace]|\[ThickSpace]\[ThickSpace]\ \[ThickSpace]", StyleBox[ButtonBox["Make a new version of this Demonstration \ \[RightGuillemet]", BaseStyle->"Hyperlink", ButtonData->{ URL["http://demonstrations.wolfram.com/participate/upload.jsp?id=\ BuffonsNeedleProblem"], None}, ButtonNote->None], FontColor->GrayLevel[0.6]] }], "Text", CellFrame->{{0, 0}, {0, 0.5}}, CellMargins->{{48, 10}, {20, 50}}, CellFrameMargins->{{6, 0}, {6, 6}}, CellFrameColor->GrayLevel[0.6], FontFamily->"Verdana", FontSize->9, FontColor->GrayLevel[0.6]] }, Open ]] }, Open ]] }, Editable->True, Saveable->False, ScreenStyleEnvironment->"Working", CellInsertionPointCell->None, WindowSize->{710, 650}, WindowMargins->{{Inherited, Inherited}, {Inherited, 0}}, WindowElements->{ "StatusArea", "MemoryMonitor", "MagnificationPopUp", "VerticalScrollBar", "MenuBar"}, WindowTitle->"Buffon's Needle Problem - Source", DockedCells->{}, CellContext->Notebook, FrontEndVersion->"8.0 for Microsoft Windows (32-bit) (November 7, 2010)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[625, 23, 143, 3, 70, "Section"], Cell[771, 28, 3700, 64, 70, "Section"], Cell[4474, 94, 9929, 224, 70, "Input", CellID->23332973], Cell[14406, 320, 1466, 36, 70, "Input", CellID->9893883] }, Open ]], Cell[CellGroupData[{ Cell[15909, 361, 8446, 191, 70, "Output", CellID->88524803], Cell[CellGroupData[{ Cell[24380, 556, 209, 6, 70, "Section"], Cell[24592, 564, 349, 10, 70, "Text"] }, Close]] }, Open ]], Cell[CellGroupData[{ Cell[24989, 580, 355, 9, 70, "Text", CellGroupingRules->{"SectionGrouping", 25}], Cell[25347, 591, 900, 24, 70, "Text"], Cell[26250, 617, 716, 23, 70, "Text", CellID->179514607], Cell[CellGroupData[{ Cell[26991, 644, 815, 24, 70, "Text"], Cell[27809, 670, 1192, 33, 70, "Text"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *) (* NotebookSignature ISNoohKi@S5i1D0TazeF8zOg *)