(***********************************************************************

                    Mathematica-Compatible Notebook

This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook 
starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do one of 
the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the 
word CacheID, otherwise Mathematica-compatible applications may try to 
use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info@wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
***********************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[     12818,        400]*)
(*NotebookOutlinePosition[     13663,        427]*)
(*  CellTagsIndexPosition[     13619,        423]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Markov Chains", "Subtitle"],

Cell[CellGroupData[{

Cell["MarkovQ", "Section"],

Cell[TextData[
"Source of statement on which code is based: M\[ARing]rten Blix, 1997, \
\[OpenCurlyDoubleQuote]Rational Expectations in a VAR with Markov Switching\
\[CloseCurlyDoubleQuote], Sveriges Riksbank Working Paper No. 42, October \
1997, p.4."], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ::usage\  = \ "\<MarkovQ[x_MatrixQ] tests whether the supplied \
matrix x is of an appropriate form to be a matrix of Markov transition \
probabilities. Specifically, it tests that the matrix is square, the elements \
are numerical and non-zero and that it returns a column of ones when \
multiplied by a column of ones (ie, that the last transition probability in a \
column equals 1 minus the sum of all the other probabilities in the column so \
that the probabilities are exhaustive).\>"\)], "Input"],

Cell[BoxData[
    \("MarkovQ[x_MatrixQ] tests whether the supplied matrix x is of an \
appropriate form to be a matrix of Markov transition probabilities. \
Specifically, it tests that the matrix is square, the elements are numerical \
and non-zero and that it returns a column of ones when multiplied by a column \
of ones (ie, that the last transition probability in a column equals 1 minus \
the sum of all the other probabilities in the column so that the \
probabilities are exhaustive)."\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ::notsq\  = \ "\<This matrix is not square.\>"\)], "Input"],

Cell[BoxData[
    \("This matrix is not square."\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ::negprob\  = \ "\<This matrix contains negative or complex \
numbers which cannot be probabilities.\>"\)], "Input"],

Cell[BoxData[
    \("This matrix contains negative or complex numbers which cannot be \
probabilities."\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(MarkovQ[x_?MatrixQ] := \n\t
      If[Equal\  @@ \ Dimensions[x]\  (*\ matrix\ is\ square*) , \n\t\tIf[
          And\  @@ \ \((NonNegative\  /@ \ Flatten[\ x])\)\  (*\ 
            matrix\ only\ contains\ non - negative\ elements*) , \n\t\tIf[
            Table[1, {Length[x]}] . x\  == Table[1. , {Length[x]}], True, \ 
            False], Message[MarkovQ::negprob]], 
        Message[MarkovQ::notsq]]\)], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["MarkovErgodicProbabilities", "Section"],

Cell[TextData[
"Source of statement on which code is based: M\[ARing]rten Blix, 1997, \
\[OpenCurlyDoubleQuote]Rational Expectations in a VAR with Markov Switching\
\[CloseCurlyDoubleQuote], Sveriges Riksbank Working Paper No. 42, October \
1997, p.4.\n\nFor a given matrix of Markov transition probabilities, P, finds \
the column vector \[ScriptP] such that \nP.\[ScriptP] = \[ScriptP], bearing \
in mind that the elements of \[ScriptP] must sum to one. Depends on the \
MarkovQ function as it tests the matrix to ensure it is a proper matrix of \
Markov transition probabilities."], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities::usage\  = \ 
      "\<For a given matrix of transition probabilities P, gives the vector \
of stationary probabilities, ie the vector p such that P.p = p.\>"\)], "Input"],

Cell[BoxData[
    \("For a given matrix of transition probabilities P, gives the vector of \
stationary probabilities, ie the vector p such that P.p = p."\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(MarkovErgodicProbabilities[x_?MatrixQ] := 
      If[MarkovQ[x], 
        With[{n = Length[x], vars = Table[z[i], {i, 1, Length[x]}]}, 
          Flatten[vars\  /. \ 
              Solve[Join[x, {Table[1, {n}]}] . vars\  == \ Join[vars, {1}], 
                vars]]],  (*\ if\ MarkovQ\ returns\ False\ *) \ 
        Message[MarkovErgodicProbabilities::notmark],  (*\ 
          if\ MarkovQ\ returns\ error\ *) \ 
        Message[MarkovErgodicProbabilities::notmark]]\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities::notmark = 
      "\<Can't find ergodic (stationary) probabilities because this is not a \
properly constructed matrix of Markov transition probabilities.\>"\)], "Input"],

Cell[BoxData[
    \("Can't find ergodic (stationary) probabilities because this is not a \
properly constructed matrix of Markov transition probabilities."\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["MakeMarkovChain", "Section"],

Cell[TextData[{
  "This is based on code by Pedro J F de Lima for GAUSS, translated into ",
  StyleBox["Mathematica.  ",
    FontSlant->"Italic"],
  "Depends on the MarkovErgodicProbabilities function."
}], "Text"],

Cell["Needs[\"Statistics`Common`DistributionsCommon`\"]", "Input"],

Cell[BoxData[
    \(Needs["\<Statistics`ContinuousDistributions`\>"]\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(?Statistics`Common`DistributionsCommon`*\)\)], "Input"],

Cell["\<\
CDF                    DomainQ                RandomArray
CharacteristicFunction ParameterQ             RegionProbability
Domain                 PDF\
\>", "Print"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(cumulcounts::notsort = "\<Vector x should be in ascending order.\>"\)], 
  "Input"],

Cell[BoxData[
    \("Vector x should be in ascending order."\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(cumulcounts::domain\  = \ 
      "\<Scalar Y isn't within the bounds defined by the elements of X.\>"\)],
   "Input"],

Cell[BoxData[
    \("Scalar Y isn't within the bounds defined by the elements of X."\)], 
  "Output"]
}, Open  ]],

Cell[BoxData[
    \(cumulcounts[x_?VectorQ, y_Real] := \n\t
      If[Sort[x] === x\ \ , \n\t\t\t
        If[y <= Max[x], 
          \(Flatten[Position[x, Min[Select[x, # >= y\ &]]]]
              \)\[LeftDoubleBracket]1\[RightDoubleBracket], 
          Message[cumulcounts::domain]], \nMessage[cumulcounts::notsort]]\)], 
  "Input"],

Cell[BoxData[
    \(makeMarkovChain[n_Integer, \ P_?MatrixQ]\  /; \ MarkovQ[P] := \n\t
      Module[{ergodic, cumergodic, \ u, s}, \n\t\t
        ergodic\  = MarkovErgodicProbabilities[P]; \n\t\t
        cumergodic = 
          FoldList[#1\  + \ #2\ &, First[ergodic], Rest[ergodic]]\ ; \n\t\t
        u\  = Table[Random[], {n - 1}]; \n\t\t
        s\  = \ FoldList[
            cumulcounts[
                FoldList[#1\  + \ #2\ &, 
                  First[P\[LeftDoubleBracket]#1\[RightDoubleBracket]], 
                  Rest[P\[LeftDoubleBracket]#1\[RightDoubleBracket]]], #2]
                \ \ &, cumulcounts[cumergodic, Random[]], u]; \n
        \t\t{s, ergodic}]\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(Table[Random[], {100000}];\) // Timing\)], "Input"],

Cell[BoxData[
    \({0.766666666666666607`\ Second, Null}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["testing these functions", "Section"],

Cell[BoxData[
    \(\(test\  = \ {{0.5, 0.25, 0.25}, {0.25, 0.5, 0.25}, {0.25, 0.25, 0.5}}; 
    \)\)], "Input"],

Cell[BoxData[
    \(\(test2\  = 
      \ {{0.5, 0.25, 0.25}, {0.25, \(-0.5\), 0.25}, {0.25, 0.25, 0.5}}; \)\)],
   "Input"],

Cell[BoxData[
    \(\(test3\  = \ {{0.5, 0.25, 0.25}, {0.25, 15, 0.25}, {0.25, 0.25, 0.5}}; 
    \)\)], "Input"],

Cell[BoxData[
    \(\(test4\  = \ {{0.5, 0.25, 0.25}, {0.25, 0.5, 0.25}}; \)\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(FoldList[#1\  + \ #2\ &, 
      First[test\[LeftDoubleBracket]2\[RightDoubleBracket]], 
      Rest[test\[LeftDoubleBracket]2\[RightDoubleBracket]]]\)], "Input"],

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{
        StyleBox["0.25`",
          StyleBoxAutoDelete->True,
          PrintPrecision->2], ",", "0.75`", ",", "1.`"}], "}"}]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(makeMarkovChain[200, test] // Timing\)], "Input"],

Cell[BoxData[
    \({0.116666666666660034`\ 
        Second, {{2, 2, 1, 1, 1, 1, 1, 2, 1, 2, 3, 2, 1, 1, 1, 2, 2, 2, 1, 1, 
          3, 3, 3, 2, 1, 1, 3, 3, 3, 3, 3, 2, 3, 1, 2, 3, 3, 3, 3, 1, 1, 1, 
          1, 3, 3, 2, 2, 2, 2, 1, 2, 2, 2, 2, 1, 1, 2, 2, 2, 1, 3, 3, 3, 1, 
          1, 1, 2, 1, 3, 3, 1, 3, 2, 2, 2, 2, 3, 1, 1, 1, 1, 2, 3, 3, 2, 1, 
          1, 3, 3, 3, 3, 3, 3, 1, 1, 3, 2, 2, 3, 3, 2, 2, 2, 2, 2, 3, 3, 3, 
          1, 2, 2, 3, 1, 2, 1, 1, 1, 1, 2, 2, 1, 3, 3, 3, 3, 1, 1, 1, 1, 1, 
          1, 2, 1, 3, 3, 3, 1, 1, 3, 3, 3, 3, 2, 2, 2, 1, 2, 2, 1, 3, 3, 2, 
          3, 2, 1, 3, 3, 3, 2, 3, 3, 2, 2, 2, 3, 2, 1, 1, 1, 1, 2, 2, 1, 1, 
          3, 1, 1, 2, 2, 2, 3, 1, 1, 1, 1, 3, 3, 1, 1, 2, 2, 3, 1, 1, 1, 1, 
          3, 2, 1, 1}, {0.333333333333333436`, 0.333333333333333303`, 
          0.333333333333333303`}}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ[test] // Timing\)], "Input"],

Cell[BoxData[
    \({0.`\ Second, True}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ[test2] // Timing\)], "Input"],

Cell[BoxData[
    \(MarkovQ::"negprob" \( : \ \) 
      "This matrix contains negative or complex numbers which cannot be \
probabilities."\)], "Message"],

Cell[BoxData[
    \({0.`\ Second, Null}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ[test3] // Timing\)], "Input"],

Cell[BoxData[
    \({0.`\ Second, False}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovQ[test4] // Timing\)], "Input"],

Cell[BoxData[
    \(MarkovQ::"notsq" \( : \ \) "This matrix is not square."\)], "Message"],

Cell[BoxData[
    \({0.`\ Second, Null}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities[test] // Timing\)], "Input"],

Cell[BoxData[
    \({0.`\ Second, {0.333333333333333436`, 0.333333333333333303`, 
        0.333333333333333303`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities[test2]\)], "Input"],

Cell[BoxData[
    \(MarkovQ::"negprob" \( : \ \) 
      "This matrix contains negative or complex numbers which cannot be \
probabilities."\)], "Message"],

Cell[BoxData[
    \(MarkovErgodicProbabilities::"notmark" \( : \ \) 
      "Can't find ergodic (stationary) probabilities because this is not a \
properly constructed matrix of Markov transition probabilities."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities[test3]\)], "Input"],

Cell[BoxData[
    \(MarkovErgodicProbabilities::"notmark" \( : \ \) 
      "Can't find ergodic (stationary) probabilities because this is not a \
properly constructed matrix of Markov transition probabilities."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MarkovErgodicProbabilities[test4]\)], "Input"],

Cell[BoxData[
    \(MarkovQ::"notsq" \( : \ \) "This matrix is not square."\)], "Message"],

Cell[BoxData[
    \(MarkovErgodicProbabilities::"notmark" \( : \ \) 
      "Can't find ergodic (stationary) probabilities because this is not a \
properly constructed matrix of Markov transition probabilities."\)], "Message"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"4.0 for Macintosh",
ScreenRectangle->{{0, 1152}, {0, 850}},
WindowSize->{676, 747},
WindowMargins->{{10, Automatic}, {Automatic, 10}},
MacintoshSystemPageSetup->"\<\
00X00000000006US00000PI=IF@000000007h00<9Q`02P000000000000406P41
01`10@00000000O000`VD00:0000000000010P2E0B`0U@9=000000001j00U`:O
0?H00@3f00<0m`030?L0XP7U0:81i@2T\>"
]


(***********************************************************************
Cached data follows.  If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of 
the file.  The cache data will then be recreated when you save this file 
from within Mathematica.
***********************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1739, 51, 33, 0, 61, "Subtitle"],

Cell[CellGroupData[{
Cell[1797, 55, 26, 0, 50, "Section"],
Cell[1826, 57, 262, 4, 46, "Text"],

Cell[CellGroupData[{
Cell[2113, 65, 531, 7, 155, "Input"],
Cell[2647, 74, 507, 7, 116, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[3191, 86, 86, 1, 27, "Input"],
Cell[3280, 89, 62, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[3379, 95, 143, 2, 59, "Input"],
Cell[3525, 99, 117, 2, 26, "Output"]
}, Open  ]],
Cell[3657, 104, 435, 7, 107, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[4129, 116, 45, 0, 50, "Section"],
Cell[4177, 118, 593, 8, 110, "Text"],

Cell[CellGroupData[{
Cell[4795, 130, 218, 3, 75, "Input"],
Cell[5016, 135, 168, 2, 41, "Output"]
}, Open  ]],
Cell[5199, 140, 499, 9, 123, "Input"],

Cell[CellGroupData[{
Cell[5723, 153, 217, 3, 75, "Input"],
Cell[5943, 158, 169, 2, 41, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[6161, 166, 34, 0, 50, "Section"],
Cell[6198, 168, 214, 5, 48, "Text"],
Cell[6415, 175, 66, 0, 27, "Input"],
Cell[6484, 177, 81, 1, 27, "Input"],

Cell[CellGroupData[{
Cell[6590, 182, 77, 1, 27, "Input"],
Cell[6670, 185, 173, 4, 50, "Print"]
}, Open  ]],

Cell[CellGroupData[{
Cell[6880, 194, 103, 2, 27, "Input"],
Cell[6986, 198, 74, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[7097, 204, 137, 3, 43, "Input"],
Cell[7237, 209, 101, 2, 26, "Output"]
}, Open  ]],
Cell[7353, 214, 332, 7, 107, "Input"],
Cell[7688, 223, 684, 13, 155, "Input"],

Cell[CellGroupData[{
Cell[8397, 240, 73, 1, 27, "Input"],
Cell[8473, 243, 71, 1, 26, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[8593, 250, 42, 0, 50, "Section"],
Cell[8638, 252, 112, 2, 27, "Input"],
Cell[8753, 256, 123, 3, 27, "Input"],
Cell[8879, 261, 112, 2, 27, "Input"],
Cell[8994, 265, 89, 1, 27, "Input"],

Cell[CellGroupData[{
Cell[9108, 270, 180, 3, 27, "Input"],
Cell[9291, 275, 184, 5, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[9512, 285, 69, 1, 27, "Input"],
Cell[9584, 288, 859, 12, 146, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10480, 305, 56, 1, 27, "Input"],
Cell[10539, 308, 53, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10629, 314, 57, 1, 27, "Input"],
Cell[10689, 317, 154, 3, 35, "Message"],
Cell[10846, 322, 53, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10936, 328, 57, 1, 27, "Input"],
Cell[10996, 331, 54, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11087, 337, 57, 1, 27, "Input"],
Cell[11147, 340, 90, 1, 21, "Message"],
Cell[11240, 343, 53, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11330, 349, 75, 1, 27, "Input"],
Cell[11408, 352, 127, 2, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11572, 359, 66, 1, 27, "Input"],
Cell[11641, 362, 154, 3, 35, "Message"],
Cell[11798, 367, 225, 3, 49, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12060, 375, 66, 1, 27, "Input"],
Cell[12129, 378, 225, 3, 49, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12391, 386, 66, 1, 27, "Input"],
Cell[12460, 389, 90, 1, 21, "Message"],
Cell[12553, 392, 225, 3, 49, "Message"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}
]
*)




(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)