markovchainmontecarlosimulationusingthemetropolisalgorithm-source.nb

simulation de montre carlo

             RowBox[{"\"\<y\>\"", ",", "Italic"}], "]"}]}], "}"}]}]}], 
        "]"}]}], ";"}], "\[IndentingNewLine]", "}"}]}]}], "]"}]], "Input",
 CellChangeTimes->{
  3.35696210375764*^9, 3.399918040520858*^9, {3.399920270217003*^9, 
   3.399920302954077*^9}, {3.399921812534747*^9, 3.3999218248224163`*^9}, {
   3.3999219814876895`*^9, 3.3999220225166864`*^9}, 3.400014587699805*^9, {
   3.400014638002136*^9, 3.400014658982304*^9}, {3.4000147190687037`*^9, 
   3.4000147348914557`*^9}, {3.4000148620242643`*^9, 3.400014889764152*^9}, {
   3.400014936010651*^9, 3.400014988656352*^9}, {3.4000151806324*^9, 
   3.4000151849786496`*^9}, {3.4000153018567123`*^9, 
   3.4000153032086563`*^9}, {3.4000154694376817`*^9, 3.400015500692624*^9}, {
   3.400049914685727*^9, 3.400049960091017*^9}, {3.400063581859375*^9, 
   3.400063628765625*^9}, {3.400063678953125*^9, 3.40006372696875*^9}, {
   3.400063770890625*^9, 3.400063921578125*^9}, {3.400064146171875*^9, 
   3.400064203953125*^9}, {3.40006426190625*^9, 3.400064284921875*^9}, {
   3.400064365734375*^9, 3.40006443459375*^9}, {3.400243653980127*^9, 
   3.400243685917627*^9}, {3.4002437164332523`*^9, 3.400243721698877*^9}, {
   3.4002437795270023`*^9, 3.400243897823877*^9}, {3.400244194198877*^9, 
   3.4002442118082523`*^9}, {3.400337346839972*^9, 3.4003373469180965`*^9}, {
   3.4003377510118465`*^9, 3.4003378217305965`*^9}},
 CellID->201174388]
}, Open  ]],

Cell[BoxData[
 TagBox[
  StyleBox[
   DynamicModuleBox[{$CellContext`proposalSigma$$ = 0.2, $CellContext`sr$$ = 
    123, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, 
    Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 
    1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{
       Hold[$CellContext`proposalSigma$$], 0.2, "proposal \[Sigma]"}, 0.2, 
      10.2, 1.}, {{
       Hold[$CellContext`sr$$], 123, "random seed"}, 1, 123456, 1}}, 
    Typeset`size$$ = {360., {178., 182.}}, Typeset`update$$ = 0, 
    Typeset`initDone$$, Typeset`skipInitDone$$ = 
    False, $CellContext`proposalSigma$139015$$ = 0, $CellContext`sr$139016$$ =
     0}, 
    DynamicBox[Manipulate`ManipulateBoxes[
     1, StandardForm, 
      "Variables" :> {$CellContext`proposalSigma$$ = 0.2, $CellContext`sr$$ = 
        123}, "ControllerVariables" :> {
        Hold[$CellContext`proposalSigma$$, \
$CellContext`proposalSigma$139015$$, 0], 
        Hold[$CellContext`sr$$, $CellContext`sr$139016$$, 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`n = 
        1000; $CellContext`x1 = -4; $CellContext`y1 = 9; $CellContext`xy = 
        Table[{0, 0}, {$CellContext`i, 1, $CellContext`n}]; 
       Part[$CellContext`xy, 1, 1] = $CellContext`x1; 
       Part[$CellContext`xy, 1, 2] = $CellContext`y1; $CellContext`na = 
        0; $CellContext`xypts = Table[$CellContext`xm = Part[
             Part[$CellContext`xy, All, 1], $CellContext`i - 
             1]; $CellContext`ym = Part[
             Part[$CellContext`xy, All, 2], $CellContext`i - 
             1]; $CellContext`ndistx = 
           NormalDistribution[$CellContext`xm, $CellContext`proposalSigma$$]; \
$CellContext`ndisty = 
           NormalDistribution[$CellContext`ym, $CellContext`proposalSigma$$]; \
$CellContext`ux = RandomReal[$CellContext`ndistx]; $CellContext`uy = 
           RandomReal[$CellContext`ndisty]; $CellContext`p2 = 
           ReplaceAll[$CellContext`pdf, {$CellContext`x -> $CellContext`ux, \
$CellContext`y -> $CellContext`uy}]; $CellContext`p1 = 
           ReplaceAll[$CellContext`pdf, {$CellContext`x -> $CellContext`xm, \
$CellContext`y -> $CellContext`ym}]; $CellContext`r = \
$CellContext`p2/$CellContext`p1; $CellContext`u2 = RandomReal[]; 
          If[$CellContext`u2 <= $CellContext`r, 
            Part[$CellContext`xy, $CellContext`i] = {$CellContext`ux, \
$CellContext`uy}; $CellContext`na = $CellContext`na + 1, 
            Part[$CellContext`xy, $CellContext`i] = {$CellContext`xm, \
$CellContext`ym}]; 
          Part[$CellContext`xy, $CellContext`i], {$CellContext`i, 
           2, $CellContext`n}]; $CellContext`plgraphics = Graphics[
          Text[
           Style[
            StringJoin["proposal \[Sigma] = ", 
             ToString[$CellContext`proposalSigma$$], "\nacceptance rate = ", 
             ToString[100. ($CellContext`na/$CellContext`n)], "%"], 16, 
            Bold], {-3, 9}, {-1, 0}, {1, 0}]]; $CellContext`points = 
        ListPlot[$CellContext`xypts, PlotRange -> {{-5, 10}, {-5, 10}}, Frame -> 
          True, FrameLabel -> {
            Style["x", Italic], 
            Style["y", Italic]}]; $CellContext`xpoints = ListPlot[
          Part[$CellContext`xy, All, 1], PlotRange -> All, Frame -> True, 
          PlotLabel -> Row[{
             Style["x", Italic], " trace"}], FrameLabel -> {"iteration", 
            Style["x", Italic]}, 
          ImagePadding -> {{35, 10}, {35, 25}}]; $CellContext`ypoints = 
        ListPlot[
          Part[$CellContext`xy, All, 2], PlotRange -> All, Frame -> True, 
          PlotLabel -> Row[{
             Style["y", Italic], " trace"}], FrameLabel -> {"iteration", 
            Style["y", Italic]}, ImagePadding -> {{35, 10}, {35, 25}}]; 
       GraphicsGrid[{{$CellContext`plgraphics, 
           
           Show[$CellContext`plcont, $CellContext`points]}, \
{$CellContext`xpoints, $CellContext`ypoints}}]), 
      "Specifications" :> {{{$CellContext`proposalSigma$$, 0.2, 
          "proposal \[Sigma]"}, 0.2, 10.2, 
         1.}, {{$CellContext`sr$$, 123, "random seed"}, 1, 123456, 1}}, 
      "Options" :> {TrackedSymbols :> Manipulate}, 
      "DefaultOptions" :> {ControllerLinking -> True}],
     ImageSizeCache->{404., {235., 240.}},
     SingleEvaluation->True],
    Deinitialization:>None,
    DynamicModuleValues:>{},
    Initialization:>({$CellContext`pdf = 
        0.087 E^((1/
             2) ((-($CellContext`x - 4)) (0.595 ($CellContext`x - 4) - 
               0.238 ($CellContext`y - 3)) - ((-0.238) ($CellContext`x - 4) + 
              0.595 ($CellContext`y - 3)) ($CellContext`y - 3))) + 
         E^((1/2) (-$CellContext`x^2 - $CellContext`y^2))/(2 
          Pi); $CellContext`plcont = 
        ContourPlot[$CellContext`pdf, {$CellContext`x, -4, 
           10}, {$CellContext`y, -4, 10}, 
          PlotRange -> {{-5, 10}, {-5, 10}, {0, 0.25}}, Contours -> 15, 
          ContourShading -> False, FrameLabel -> {
            Style["x", Italic], 
            Style["y", Italic]}]; Null}; Typeset`initDone$$ = True),
    SynchronousInitialization->True,
    UnsavedVariables:>{Typeset`initDone$$},
    UntrackedVariables:>{Typeset`size$$}], "Manipulate",
   Deployed->True,
   StripOnInput->False],
  Manipulate`InterpretManipulate[1]]], "Output",
 CellID->11367300],

Cell[CellGroupData[{

Cell["THIS NOTEBOOK IS THE SOURCE CODE FROM", "Text",
 CellFrame->{{0, 0}, {0, 1}},
 CellMargins->{{48, 10}, {4, 28}},
 CellGroupingRules->{"SectionGrouping", 25},
 CellFrameMargins->{{48, 48}, {6, 5}},
 CellFrameColor->RGBColor[0.691905, 0.790311, 0.300252],
 FontFamily->"Helvetica",
 FontSize->10,
 FontWeight->"Bold",
 FontColor->RGBColor[0.691905, 0.790311, 0.300252]],

Cell[TextData[{
 "\"",
 ButtonBox["Markov Chain Monte Carlo Simulation Using the Metropolis \
Algorithm",
  BaseStyle->"Hyperlink",
  ButtonData->{
    URL["http://demonstrations.wolfram.com/\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm/"], None},
  ButtonNote->
   "http://demonstrations.wolfram.com/\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm/"],
 "\"",
 " 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/\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm/",
  BaseStyle->"Hyperlink",
  ButtonData->{
    URL["http://demonstrations.wolfram.com/\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm/"], None},
  ButtonNote->
   "http://demonstrations.wolfram.com/\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm/"]
}], "Text",
 CellMargins->{{48, Inherited}, {0, Inherited}},
 FontFamily->"Verdana",
 FontSize->10,
 FontColor->GrayLevel[0.5]],

Cell[" ", "Text",
 CellFrame->{{0, 0}, {0, 1}},
 CellMargins->{{48, 10}, {4, 28}},
 CellGroupingRules->{"SectionGrouping", 25},
 CellFrameMargins->{{48, 48}, {6, 5}},
 CellFrameColor->RGBColor[0.691905, 0.790311, 0.300252],
 FontFamily->"Helvetica",
 FontSize->10,
 FontWeight->"Bold",
 FontColor->RGBColor[0.691905, 0.790311, 0.300252]],

Cell[TextData[{
 "Contributed by: ",
 ButtonBox["Philip Gregory",
  BaseStyle->"Hyperlink",
  ButtonData->{
    URL["http://demonstrations.wolfram.com/author.html?author=Philip+Gregory"]\
, None}],
 " (Physics and Astronomy, University of British Columbia)"
}], "Text",
 CellDingbat->"\[FilledSmallSquare]",
 CellMargins->{{66, 48}, {2, 4}},
 FontFamily->"Verdana",
 FontSize->10,
 FontColor->GrayLevel[0.6]],

Cell[CellGroupData[{

Cell[TextData[{
 "A full-function Wolfram ",
 StyleBox["Mathematica",
  FontSlant->"Italic"],
 " 6 system is required to edit this notebook.\n",
 StyleBox[ButtonBox["GET WOLFRAM MATHEMATICA 6 \[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.865507, 0.90634, 0.680751],
 CellChangeTimes->{3.3750111182355957`*^9},
 ParagraphSpacing->{1., 1.},
 FontFamily->"Verdana",
 FontSize->10,
 FontColor->GrayLevel[0.411765],
 Background->RGBColor[0.986023, 0.991363, 0.969818]],

Cell[TextData[{
 "\[Copyright] ",
 StyleBox[ButtonBox["The 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=\
MarkovChainMonteCarloSimulationUsingTheMetropolisAlgorithm"], 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",
WindowSize->{710, 650},
WindowMargins->{{Inherited, Inherited}, {Inherited, 0}},
WindowElements->{
 "StatusArea", "MemoryMonitor", "MagnificationPopUp", "VerticalScrollBar", 
  "MenuBar"},
WindowTitle->"Markov Chain Monte Carlo Simulation Using the Metropolis \
Algorithm - Source",
DockedCells->{},
CellContext->Notebook,
FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (February 7, 2008)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[590, 23, 266, 6, 70, "Section"],
Cell[859, 31, 12002, 310, 70, "Input",
 CellID->201174388]
}, Open  ]],
Cell[12876, 344, 5586, 106, 70, "Output",
 CellID->11367300],
Cell[CellGroupData[{
Cell[18487, 454, 373, 9, 70, "Text",
 CellGroupingRules->{"SectionGrouping", 25}],
Cell[18863, 465, 1153, 32, 70, "Text"],
Cell[20019, 499, 337, 9, 70, "Text",
 CellGroupingRules->{"SectionGrouping", 25}],
Cell[20359, 510, 408, 13, 70, "Text"],
Cell[CellGroupData[{
Cell[20792, 527, 829, 24, 70, "Text"],
Cell[21624, 553, 1234, 33, 70, "Text"]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
(* NotebookSignature sRNqP@QudB0zdDpcbxK0V4Pd *)