(* 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[     16649,        600]
NotebookOptionsPosition[     13349,        484]
NotebookOutlinePosition[     13859,        504]
CellTagsIndexPosition[     13816,        501]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["PwM`Chap01Introduction`", "Section",
 InitializationGroup->True],

Cell[TextData[{
 StyleBox["From",
  FontWeight->"Bold"],
 ": ",
 StyleBox[ButtonBox["Programming with Mathematica: An Introduction",
  BaseStyle->"Hyperlink",
  ButtonData->{
    URL["http://www.cambridge.org/wellin"], None},
  ButtonNote->"http://www.cambridge.org/wellin"],
  FontSlant->"Italic",
  FontVariations->{"Underline"->True}]
}], "Text",
 CellMargins->{{28, 10}, {7, 7}},
 FontSize->14],

Cell[CellGroupData[{

Cell["Metadata", "Subsection"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Name", ":", " ", "PwM`Chap01Introduction`"}]}], " ", 
  "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Book", ":", " ", 
    RowBox[{"Programming", " ", "with", " ", 
     RowBox[{"Mathematica", ":", " ", 
      RowBox[{"An", " ", "Introduction"}]}]}]}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Author", ":", " ", 
    RowBox[{"Paul", " ", "Wellin"}]}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{
   RowBox[{":", 
    RowBox[{"Summary", ":", " ", 
     RowBox[{
     "This", " ", "package", " ", "contains", " ", "the", " ", "functions", 
      " ", "defined", " ", "in", " ", "Chapter", " ", "1"}]}]}], ",", " ", 
   RowBox[{"An", " ", "introduction", " ", "to", " ", 
    RowBox[{"Mathematica", "."}]}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Context", ":", " ", "PwM`Chap01Introduction`"}]}], " ", 
  "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Package", " ", 
    RowBox[{"Version", ":", " ", "1.0"}]}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{
   RowBox[{":", 
    RowBox[{"Copyright", ":", " ", 
     RowBox[{"Copyright", " ", "2012"}]}]}], ",", " ", 
   RowBox[{"Cambridge", " ", "University", " ", "Press"}]}], " ", 
  "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{
   RowBox[{":", 
    RowBox[{"History", ":", " ", 
     RowBox[{
     "Version", " ", "1.0", " ", "by", " ", "Paul", " ", "Wellin"}]}]}], ",", 
   " ", 
   RowBox[{"Dec", " ", "2012"}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{
   RowBox[{":", 
    RowBox[{"Keywords", ":", " ", 
     RowBox[{"regular", " ", "polygons"}]}]}], ",", " ", 
   RowBox[{"percolation", "."}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Source", ":", " ", 
    RowBox[{"Chap01Introduction", ".", "nb"}]}]}], " ", "*)"}]], "Input"],

Cell[BoxData[
 RowBox[{"(*", " ", 
  RowBox[{":", 
   RowBox[{"Mathematica", " ", 
    RowBox[{"Version", ":", " ", 
     RowBox[{"8.0", ".4"}]}]}]}], " ", "*)"}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["BeginPackage", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"BeginPackage", "[", "\"\<PwM`Chap01Introduction`\>\"", 
  "]"}]], "Input"],

Cell[BoxData["\<\"PWM`Chap01Introduction`\"\>"], "Output"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["Usage messages for public functions", "Subsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"RegularPolygon", "::", "usage"}], "=", "\"\<RegularPolygon[\!\(\*
StyleBox[\"n\", \"TI\"]\)] creates a regular \!\(\*
StyleBox[\"n\", \"TI\"]\)-gon graphics primitive that can be displayed with \
Graphics.\>\""}], ";"}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"BondPercolation", "::", "baddims"}], "=", 
   "\"\<The arguments `1` and `2`, giving the grid dimensions, should be \
positive integers.\>\""}], ";"}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{
   StyleBox[
    RowBox[{"BondPercolation", "::", "usage"}], "MessageName"], "=", 
   "\"\<BondPercolation[{\!\(\*
StyleBox[\"m\", \"TI\"]\),\!\(\*
StyleBox[\"n\", \"TI\"]\)},\!\(\*
StyleBox[\"prob\", \"TI\"]\)] simulates a bond percolation on an \!\(\*
StyleBox[\"m\", \"TI\"]\)\[Cross]\!\(\*
StyleBox[\"n\", \"TI\"]\) rectangular lattice using 0<\!\(\*
StyleBox[\"prob\", \"TI\"]\)<1 as the probability of a bond forming between a \
site and its neighbors.\>\""}], ";"}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"FindPercolationPath", "::", "usage"}], "=", 
   "\"\<FindPercolationPath[\!\(\*
StyleBox[\"gr\", \"TI\"]\),{\!\(\*
StyleBox[\"dimx\", \"TI\"]\),\!\(\*
StyleBox[\"dimy\", \"TI\"]\)}] returns a connected path (if it exists) for \
the graph \!\(\*
StyleBox[\"gr\", \"TI\"]\) of dimension \!\(\*
StyleBox[\"dimx\", \"TI\"]\)\[Cross]\!\(\*
StyleBox[\"dimy\", \"TI\"]\).\>\""}], ";"}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["Options", "Subsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"Options", "[", "BondPercolation", "]"}], "=", 
   RowBox[{"Options", "[", "Graph", "]"}]}], ";"}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["Private context", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Begin", "[", "\"\<`Private`\>\"", "]"}]], "Input"],

Cell[BoxData["\<\"PWM`Chap01Introduction`Private`\"\>"], "Output"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["Function definitions (public and private)", "Subsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{"vertices", "[", "n_", "]"}], ":=", 
  RowBox[{"Table", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{
      RowBox[{"Cos", "[", 
       RowBox[{"2", "\[Pi]", " ", 
        RowBox[{"\[Alpha]", "/", "n"}]}], "]"}], ",", 
      RowBox[{"Sin", "[", 
       RowBox[{"2", "\[Pi]", " ", 
        RowBox[{"\[Alpha]", "/", "n"}]}], "]"}]}], "}"}], ",", 
    RowBox[{"{", 
     RowBox[{"\[Alpha]", ",", "0", ",", "n"}], "}"}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"RegularPolygon", "/:", 
  RowBox[{"Graphics", "[", 
   RowBox[{"RegularPolygon", "[", "n_", "]"}], "]"}], ":=", 
  "\[IndentingNewLine]", 
  RowBox[{"Graphics", "[", 
   RowBox[{
    RowBox[{"Line", "[", 
     RowBox[{"vertices", "[", "n", "]"}], "]"}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"BondPercolation", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"m_", ",", "n_"}], "}"}], ",", "prob_", ",", 
    RowBox[{"opts", ":", 
     RowBox[{"OptionsPattern", "[", "]"}]}]}], "]"}], ":=", 
  "\[IndentingNewLine]", 
  RowBox[{"Module", "[", 
   RowBox[{
    RowBox[{"{", "gr", "}"}], ",", "\[IndentingNewLine]", 
    RowBox[{"If", "[", 
     RowBox[{
      RowBox[{"Not", "[", 
       RowBox[{
        RowBox[{"IntegerQ", "[", "m", "]"}], "&&", 
        RowBox[{"IntegerQ", "[", "n", "]"}]}], "]"}], ",", 
      "\[IndentingNewLine]", 
      RowBox[{"Message", "[", 
       RowBox[{
        RowBox[{"BondPercolation", "::", "baddims"}], ",", "m", ",", "n"}], 
       "]"}], ",", "\[IndentingNewLine]", 
      RowBox[{
       RowBox[{"gr", "=", 
        RowBox[{"GridGraph", "[", 
         RowBox[{"{", 
          RowBox[{"m", ",", "n"}], "}"}], "]"}]}], ";", "\[IndentingNewLine]", 
       RowBox[{"Graph", "[", 
        RowBox[{
         RowBox[{"Pick", "[", 
          RowBox[{
           RowBox[{"EdgeList", "[", "gr", "]"}], ",", "\[IndentingNewLine]", 
           RowBox[{"RandomVariate", "[", 
            RowBox[{
             RowBox[{"BernoulliDistribution", "[", "prob", "]"}], ",", 
             "\[IndentingNewLine]", 
             RowBox[{"EdgeCount", "[", "gr", "]"}]}], "]"}], ",", "1"}], 
          "]"}], ",", "\[IndentingNewLine]", "opts"}], "]"}]}]}], 
     "\[IndentingNewLine]", "]"}]}], "\[IndentingNewLine]", "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"FindPercolationPath", "[", 
   RowBox[{"gr_Graph", ",", 
    RowBox[{"dims", ":", 
     RowBox[{"{", 
      RowBox[{"dimx_", ",", "dimy_"}], "}"}]}]}], "]"}], ":=", 
  RowBox[{"Module", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"bot", ",", "top", ",", "spFun"}], "}"}], ",", 
    "\[IndentingNewLine]", 
    RowBox[{
     RowBox[{"bot", "=", 
      RowBox[{"Select", "[", 
       RowBox[{
        RowBox[{"VertexList", "[", 
         RowBox[{"GridGraph", "[", "dims", "]"}], "]"}], ",", 
        RowBox[{
         RowBox[{
          RowBox[{"Mod", "[", 
           RowBox[{"#", ",", "dimx"}], "]"}], "\[Equal]", "1"}], "&"}]}], 
       "]"}]}], ";", "\[IndentingNewLine]", 
     RowBox[{"top", "=", 
      RowBox[{"Select", "[", 
       RowBox[{
        RowBox[{"VertexList", "[", 
         RowBox[{"GridGraph", "[", "dims", "]"}], "]"}], ",", 
        RowBox[{
         RowBox[{
          RowBox[{"Mod", "[", 
           RowBox[{"#", ",", "dimx"}], "]"}], "\[Equal]", "0"}], "&"}]}], 
       "]"}]}], ";", "\[IndentingNewLine]", 
     RowBox[{"spFun", "=", 
      RowBox[{"FindShortestPath", "[", 
       RowBox[{"gr", ",", "All", ",", "All"}], "]"}]}], ";", 
     "\[IndentingNewLine]", 
     RowBox[{"Cases", "[", 
      RowBox[{
       RowBox[{"Outer", "[", 
        RowBox[{"spFun", ",", "bot", ",", "top"}], "]"}], ",", 
       RowBox[{"lis_List", "/;", 
        RowBox[{
         RowBox[{"Length", "[", "lis", "]"}], "\[NotEqual]", "0"}]}], ",", 
       RowBox[{"{", "2", "}"}]}], "]"}]}]}], "\[IndentingNewLine]", 
   "]"}]}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["End private context", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"End", "[", "]"}]], "Input"],

Cell[BoxData["\<\"PWM`Chap01Introduction`Private`\"\>"], "Output"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["EndPackage", "Subsection"],

Cell[BoxData[
 RowBox[{"EndPackage", "[", "]"}]], "Input"]
}, Closed]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Examples", "Section"],

Cell[CellGroupData[{

Cell["Load package", "Subsection"],

Cell[BoxData[
 RowBox[{"Quit", "[", "]"}]], "Input"],

Cell[TextData[{
 "Load the package (do ",
 StyleBox["not",
  FontSlant->"Italic"],
 " say \[OpenCurlyDoubleQuote]Yes\[CloseCurlyDoubleQuote] to evaluate init \
cells dialog)."
}], "Text"],

Cell[BoxData[
 RowBox[{"<<", "PWM`Chap01Introduction`"}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["Test usage messages", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"?", "RegularPolygon"}]], "Input"],

Cell[BoxData[
 StyleBox["\<\"RegularPolygon[\\!\\(\\*\\nStyleBox[\\\"n\\\", \\\"TI\\\"]\\)] \
creates a regular \\!\\(\\*\\nStyleBox[\\\"n\\\", \\\"TI\\\"]\\)-gon graphics \
primitive that can be displayed with Graphics.\"\>", "MSG"]], "Print", \
"PrintUsage"]
}, Closed]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"?", "BondPercolation"}]], "Input"],

Cell[BoxData[
 StyleBox["\<\"BondPercolation[{\\!\\(\\*\\nStyleBox[\\\"m\\\", \
\\\"TI\\\"]\\),\\!\\(\\*\\nStyleBox[\\\"n\\\", \
\\\"TI\\\"]\\)},\\!\\(\\*\\nStyleBox[\\\"prob\\\", \\\"TI\\\"]\\)] simulates \
a bond percolation on an \\!\\(\\*\\nStyleBox[\\\"m\\\", \\\"TI\\\"]\\)\
\[Cross]\\!\\(\\*\\nStyleBox[\\\"n\\\", \\\"TI\\\"]\\) rectangular lattice \
using 0<\\!\\(\\*\\nStyleBox[\\\"prob\\\", \\\"TI\\\"]\\)<1 as the \
probability of a bond forming between a site and its neighbors.\"\>", 
  "MSG"]], "Print", "PrintUsage"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["Exercise the functions and options", "Subsection"],

Cell[CellGroupData[{

Cell["RegularPolygon", "Subsubsection"],

Cell[BoxData[
 RowBox[{"Table", "[", 
  RowBox[{
   RowBox[{"Graphics", "[", 
    RowBox[{"RegularPolygon", "[", "n", "]"}], "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"n", ",", "3", ",", "6"}], "}"}]}], "]"}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["BondPercolation", "Subsubsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{"gr", "=", 
   RowBox[{"BondPercolation", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"13", ",", "21"}], "}"}], ",", "0.47"}], "]"}]}], 
  ";"}]], "Input"],

Cell[BoxData[
 RowBox[{"HighlightGraph", "[", 
  RowBox[{
   RowBox[{"GridGraph", "[", 
    RowBox[{"{", 
     RowBox[{"13", ",", "21"}], "}"}], "]"}], ",", "gr", ",", 
   RowBox[{"GraphHighlightStyle", "\[Rule]", "\"\<DehighlightGray\>\""}]}], 
  "]"}]], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["FindPercolationPath", "Subsubsection"],

Cell[BoxData[
 RowBox[{
  RowBox[{"path", "=", 
   RowBox[{"FindPercolationPath", "[", 
    RowBox[{"gr", ",", 
     RowBox[{"{", 
      RowBox[{"13", ",", "21"}], "}"}]}], "]"}]}], ";"}]], "Input"],

Cell[BoxData[
 RowBox[{"HighlightGraph", "[", 
  RowBox[{
   RowBox[{"GridGraph", "[", 
    RowBox[{"{", 
     RowBox[{"13", ",", "21"}], "}"}], "]"}], ",", 
   RowBox[{"Apply", "[", 
    RowBox[{"UndirectedEdge", ",", 
     RowBox[{"Map", "[", 
      RowBox[{
       RowBox[{
        RowBox[{"Partition", "[", 
         RowBox[{"#", ",", "2", ",", "1"}], "]"}], "&"}], ",", "path"}], 
      "]"}], ",", 
     RowBox[{"{", "2", "}"}]}], "]"}], ",", 
   RowBox[{"GraphHighlightStyle", "\[Rule]", "\"\<DehighlightGray\>\""}]}], 
  "]"}]], "Input"]
}, Closed]]
}, Open  ]]
}, Open  ]]
},
AutoGeneratedPackage->Automatic,
WindowSize->{819, 820},
WindowMargins->{{511, Automatic}, {Automatic, 0}},
ShowSelection->True,
Magnification:>FEPrivate`If[
  FEPrivate`Equal[FEPrivate`$VersionNumber, 6.], 1.25, 1.25 Inherited],
FrontEndVersion->"8.0 for Mac OS X x86 (32-bit, 64-bit Kernel) (October 5, \
2011)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[579, 22, 70, 1, 83, "Section",
 InitializationGroup->True],
Cell[652, 25, 398, 13, 34, "Text"],
Cell[CellGroupData[{
Cell[1075, 42, 30, 0, 42, "Subsection"],
Cell[1108, 44, 136, 4, 33, "Input"],
Cell[1247, 50, 239, 6, 33, "Input"],
Cell[1489, 58, 146, 4, 33, "Input"],
Cell[1638, 64, 379, 9, 53, "Input"],
Cell[2020, 75, 139, 4, 33, "Input"],
Cell[2162, 81, 147, 4, 33, "Input"],
Cell[2312, 87, 241, 7, 33, "Input"],
Cell[2556, 96, 256, 8, 33, "Input"],
Cell[2815, 106, 213, 6, 33, "Input"],
Cell[3031, 114, 156, 4, 33, "Input"],
Cell[3190, 120, 173, 5, 33, "Input"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3400, 130, 34, 0, 42, "Subsection"],
Cell[CellGroupData[{
Cell[3459, 134, 98, 2, 51, "Input"],
Cell[3560, 138, 58, 0, 51, "Output"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[3667, 144, 57, 0, 31, "Subsection"],
Cell[3727, 146, 277, 6, 112, "Input"],
Cell[4007, 154, 208, 5, 112, "Input"],
Cell[4218, 161, 518, 12, 171, "Input"],
Cell[4739, 175, 436, 11, 112, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[5212, 191, 29, 0, 31, "Subsection"],
Cell[5244, 193, 155, 4, 51, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[5436, 202, 37, 0, 31, "Subsection"],
Cell[CellGroupData[{
Cell[5498, 206, 74, 1, 51, "Input"],
Cell[5575, 209, 66, 0, 51, "Output"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[5690, 215, 63, 0, 31, "Subsection"],
Cell[5756, 217, 475, 14, 33, "Input"],
Cell[6234, 233, 357, 9, 53, "Input"],
Cell[6594, 244, 1494, 39, 224, "Input"],
Cell[8091, 285, 1586, 45, 148, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[9714, 335, 41, 0, 31, "Subsection"],
Cell[CellGroupData[{
Cell[9780, 339, 51, 1, 51, "Input"],
Cell[9834, 342, 66, 0, 51, "Output"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[9949, 348, 32, 0, 31, "Subsection"],
Cell[9984, 350, 58, 1, 51, "Input"]
}, Closed]]
}, Open  ]],
Cell[CellGroupData[{
Cell[10091, 357, 27, 0, 83, "Section"],
Cell[CellGroupData[{
Cell[10143, 361, 34, 0, 42, "Subsection"],
Cell[10180, 363, 52, 1, 51, "Input"],
Cell[10235, 366, 187, 6, 50, "Text"],
Cell[10425, 374, 67, 1, 51, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[10529, 380, 41, 0, 31, "Subsection"],
Cell[CellGroupData[{
Cell[10595, 384, 57, 1, 51, "Input"],
Cell[10655, 387, 260, 4, 108, "Print"]
}, Closed]],
Cell[CellGroupData[{
Cell[10952, 396, 58, 1, 51, "Input"],
Cell[11013, 399, 531, 8, 140, "Print"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[11593, 413, 56, 0, 31, "Subsection"],
Cell[CellGroupData[{
Cell[11674, 417, 39, 0, 30, "Subsubsection"],
Cell[11716, 419, 219, 6, 51, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[11972, 430, 40, 0, 21, "Subsubsection"],
Cell[12015, 432, 197, 7, 51, "Input"],
Cell[12215, 441, 264, 7, 82, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[12516, 453, 44, 0, 21, "Subsubsection"],
Cell[12563, 455, 198, 6, 51, "Input"],
Cell[12764, 463, 545, 16, 112, "Input"]
}, Closed]]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)
