(************** Content-type: application/mathematica **************
                     CreatedBy='Mathematica 5.0'

                    Mathematica-Compatible Notebook

This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. 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[     37972,       1164]*)
(*NotebookOutlinePosition[     38630,       1187]*)
(*  CellTagsIndexPosition[     38586,       1183]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["\<\
HO Raising and Lowering Operators 
and Their Relation to the Energy Eigenstates
by James Feagin\
\>", "Subsubtitle"],

Cell[CellGroupData[{

Cell["Pure functions and Mathematica operators", "Subsubsection"],

Cell[TextData[{
  "As a warm-up to operator algebra, consider '",
  StyleBox["prefix",
    FontColor->RGBColor[1, 0, 0]],
  "' and '",
  StyleBox["postfix",
    FontColor->RGBColor[0, 0, 1]],
  "' notation. In Mathematica the basic syntax is to 'wrap' functions around \
their arguments, and then wrap additional functions around the results. "
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{"{", 
        RowBox[{
          RowBox[{
            StyleBox["f",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox[" ",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox["@",
              FontColor->RGBColor[1, 0, 0]], " ", 
            StyleBox[\(f\ @\ x\),
              FontColor->RGBColor[1, 0, 0]]}], ",", "  ", 
          StyleBox[\(f\ @\ x\),
            FontColor->RGBColor[1, 0, 0]], ",", "  ", 
          StyleBox[\(x // f\),
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox[",",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox["   ",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox[\(\(x // f\) // f\),
            FontColor->RGBColor[0, 0, 1]]}], "}"}], 
      "  ", \( (*\ all\ four\ ' wrap'\ f\ around\ x\ *) \)}]], "Input"],

Cell[BoxData[
    \({f[f[x]], f[x], f[x], f[f[x]]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{"{", 
        RowBox[{
          RowBox[{"Expand", " ", "@", " ", 
            RowBox[{
              StyleBox["(",
                FontColor->RGBColor[1, 0, 0]], \(\((a + b)\)^3\), 
              StyleBox[")",
                FontColor->RGBColor[1, 0, 0]]}]}], 
          ",", \(\((a + b)\)^3 // Expand\)}], "}"}], 
      StyleBox[\( (*\ note\ parens\ *) \),
        FontColor->RGBColor[1, 0, 0]]}]], "Input"],

Cell[BoxData[
    \({a\^3 + 3\ a\^2\ b + 3\ a\ b\^2 + b\^3, 
      a\^3 + 3\ a\^2\ b + 3\ a\ b\^2 + b\^3}\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "With symbolic computation using a computer algebra system like ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  ", operators are readily introduced using \"pure functions.\" A pure \
function is simply a specified operation with 'slots' ",
  StyleBox["#",
    FontFamily->"Courier",
    FontColor->RGBColor[1, 0, 0]],
  " to locate the argument of the operation. For example, the combination of \
symbols  ",
  StyleBox["#",
    FontFamily->"Courier",
    FontColor->RGBColor[1, 0, 0]],
  StyleBox["^3",
    FontFamily->"Courier"],
  " ",
  StyleBox["& ",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  "is a pure function to cube something. Compare the following equivalent \
forms:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{
        RowBox[{
          RowBox[{
            RowBox[{
              StyleBox["#",
                FontColor->RGBColor[1, 0, 0]], "^", "3"}], " ", 
            StyleBox["&",
              FontColor->RGBColor[0, 0, 1]]}], " ", "@", " ", "x"}], ",", 
        "   ", 
        RowBox[{
          RowBox[{
            RowBox[{
              StyleBox["#",
                FontColor->RGBColor[1, 0, 0]], "^", "3"}], " ", 
            StyleBox["&",
              FontColor->RGBColor[0, 0, 1]]}], 
          StyleBox[" ",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox["[",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox["x",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox["]",
            FontColor->RGBColor[0, 0, 1]]}], ",", "    ", 
        RowBox[{"x", " ", "//", " ", 
          RowBox[{
            RowBox[{
              StyleBox["#",
                FontColor->RGBColor[1, 0, 0]], "^", "3"}], " ", 
            StyleBox["&",
              FontColor->RGBColor[0, 0, 1]]}]}]}], "}"}]], "Input"],

Cell[BoxData[
    \({x\^3, x\^3, x\^3}\)], "Output"]
}, Open  ]],

Cell["\<\
We're already familiar with postfix forms of pure functions to include \
options in mma tools:\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{\(Cos[n\ \[Pi]]\), " ", "//", 
      RowBox[{
        RowBox[{"Simplify", "[", 
          RowBox[{
            StyleBox["#",
              FontColor->RGBColor[1, 0, 0]], ",", \(n \[Element] Integers\)}],
           "]"}], 
        StyleBox["&",
          FontColor->RGBColor[0, 0, 1]]}]}]], "Input"],

Cell[BoxData[
    \(\((\(-1\))\)\^n\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "Pure functions avoid introducing extraneous names, such as ",
  StyleBox["cube",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  StyleBox["[x] = x^3",
    FontFamily->"Courier"],
  ", and are thus also referred to as \"anonymous functions.\""
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{"{", 
        RowBox[{
          RowBox[{
            RowBox[{
              RowBox[{"f", "[", 
                RowBox[{
                  StyleBox["#",
                    FontColor->RGBColor[1, 0, 0]], ",", "y"}], "]"}], 
              StyleBox["&",
                FontColor->RGBColor[0, 0, 1]]}], " ", "@", " ", "peter"}], 
          ",", 
          RowBox[{"linda", "//", 
            RowBox[{
              RowBox[{"f", "[", 
                RowBox[{"y", ",", 
                  StyleBox["#",
                    FontColor->RGBColor[1, 0, 0]]}], "]"}], 
              StyleBox["&",
                FontColor->RGBColor[0, 0, 1]]}]}]}], "}"}], "  "}]], "Input"],

Cell[BoxData[
    \({f[peter, y], f[y, linda]}\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "In ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  ", the symbol ",
  StyleBox["&",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  " marks the end of the pure function and is shorthand for the built-in \
object ",
  StyleBox["Function",
    FontFamily->"Courier"],
  ". The symbols ",
  StyleBox["#",
    FontFamily->"Courier",
    FontColor->RGBColor[1, 0, 0]],
  " and ",
  StyleBox["&",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  " are peculiar to ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " syntax. Compare:",
  StyleBox[" ",
    FontFamily->"Courier"]
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{\(Function[#^3]\), ",", \(\(Function[#^3]\)[x]\), ",", " ", 
        RowBox[{"x", " ", "//", " ", 
          RowBox[{
            RowBox[{
              StyleBox["#",
                FontColor->RGBColor[1, 0, 0]], "^", "3"}], " ", 
            StyleBox["&",
              FontColor->RGBColor[0, 0, 1]]}]}]}], "}"}]], "Input"],

Cell[BoxData[
    \({#1\^3 &, x\^3, x\^3}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Momentum operator", "Subsubsection"],

Cell["\<\
Thus, we can define for example the momentum operator in one of several ways.\
\
\>", "Text"],

Cell[TextData[{
  "(i) Simply wrap ",
  StyleBox["p",
    FontColor->RGBColor[1, 0, 0]],
  " around ",
  StyleBox["\[Psi]",
    FontColor->RGBColor[0, 0, 1]],
  ":"
}], "Text"],

Cell[BoxData[{\(Clear[p]\), "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{
        StyleBox["p",
          FontColor->RGBColor[1, 0, 0]], "[", "\[Psi]_", "]"}], ":=", " ", 
      RowBox[{
        StyleBox[\(-I\),
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox[" ",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox["\[HBar]",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox[" ",
          FontColor->RGBColor[1, 0, 0]], 
        RowBox[{
          StyleBox[\(\[PartialD]\_x\),
            FontColor->RGBColor[1, 0, 0]], " ", 
          StyleBox["\[Psi]",
            FontColor->RGBColor[0, 0, 1]]}]}]}]}], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{
        RowBox[{
          StyleBox["p",
            FontColor->RGBColor[1, 0, 0]], "[", \(E^\((I\ k\ x)\)\), "]"}], 
        ",", 
        RowBox[{
          StyleBox["p",
            FontColor->RGBColor[1, 0, 0]], "[", 
          RowBox[{
            StyleBox["p",
              FontColor->RGBColor[1, 0, 0]], "[", " ", \(\[Psi][x]\), "]"}], 
          "]"}]}], "}"}]], "Input"],

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{\(\[ExponentialE]\^\(\[ImaginaryI]\ k\ x\)\ k\ \[HBar]\), ",", 
        RowBox[{\(-\[HBar]\^2\), " ", 
          RowBox[{
            SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "x", "]"}]}]}], "}"}]], "Output"]
}, Open  ]],

Cell["\<\
Note, the postfix form works here too, but it's a bit strange from the point \
of view of QM:\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{
        StyleBox[\(\[Psi][x]\),
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox["//",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox["p",
          FontColor->RGBColor[1, 0, 0]]}], 
      StyleBox["//",
        FontColor->RGBColor[1, 0, 0]], 
      StyleBox["p",
        FontColor->RGBColor[1, 0, 0]]}]], "Input"],

Cell[BoxData[
    RowBox[{\(-\[HBar]\^2\), " ", 
      RowBox[{
        SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
          MultilineFunction->None], "[", "x", "]"}]}]], "Output"]
}, Open  ]],

Cell["\<\
(ii) Instead, the equivalent prefix notation better segregates operators and \
wavefunctions:\
\>", "Text"],

Cell[BoxData[{\(Clear[p]\), "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{
        StyleBox["p",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox[" ",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox["@",
          FontColor->RGBColor[1, 0, 0]], " ", 
        StyleBox["\[Psi]_",
          FontColor->RGBColor[0, 0, 1]]}], " ", ":=", " ", 
      RowBox[{
        StyleBox[\(-I\),
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox[" ",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox["\[HBar]",
          FontColor->RGBColor[1, 0, 0]], 
        StyleBox[" ",
          FontColor->RGBColor[1, 0, 0]], 
        RowBox[{
          StyleBox[\(\[PartialD]\_x\),
            FontColor->RGBColor[1, 0, 0]], " ", 
          StyleBox["\[Psi]",
            FontColor->RGBColor[0, 0, 1]]}]}]}]}], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{"{", 
        RowBox[{
          RowBox[{
            StyleBox["p",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox["@",
              FontColor->RGBColor[1, 0, 0]], 
            RowBox[{
              StyleBox["(",
                FontColor->RGBColor[0, 0, 1]], \(E^\((I\ k\ x)\)\), 
              StyleBox[")",
                FontColor->RGBColor[0, 0, 1]]}]}], ",", 
          RowBox[{
            StyleBox["p",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox["@",
              FontColor->RGBColor[1, 0, 0]], 
            RowBox[{
              StyleBox["p",
                FontColor->RGBColor[1, 0, 0]], 
              StyleBox["@",
                FontColor->RGBColor[1, 0, 0]], " ", \(\[Psi][x]\)}]}]}], 
        "}"}], 
      StyleBox[\( (*\ note\ parens\ *) \),
        FontColor->RGBColor[0, 0, 1]]}]], "Input"],

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{\(\[ExponentialE]\^\(\[ImaginaryI]\ k\ x\)\ k\ \[HBar]\), ",", 
        RowBox[{\(-\[HBar]\^2\), " ", 
          RowBox[{
            SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "x", "]"}]}]}], "}"}]], "Output"]
}, Open  ]],

Cell["\<\
(iii) Better still, drop altogether direct reference to a wavefunction (= the \
argument or object of the operator) and define the momentum operator as a \
pure function:\
\>", "Text"],

Cell[BoxData[{\(Clear[p]\), "\[IndentingNewLine]", 
    RowBox[{
      StyleBox["p",
        FontColor->RGBColor[1, 0, 0]], " ", ":=", " ", 
      StyleBox[\(\(-I\)\ \[HBar]\ \[PartialD]\_x\ # &\),
        FontColor->RGBColor[1, 0, 0]]}]}], "Input"],

Cell["\<\
Nevertheless, the above various forms still work, although the prefix form is \
preferable.\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{
        RowBox[{
          StyleBox["p",
            FontColor->RGBColor[1, 0, 0]], 
          StyleBox["@",
            FontColor->RGBColor[1, 0, 0]], 
          RowBox[{
            StyleBox["p",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox["@",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox[" ",
              FontColor->RGBColor[1, 0, 0]], \(\[Psi][x]\)}]}], ",", 
        "   ", \(p[p[\ \[Psi][x]]]\), ",", 
        " ", \(\(\[Psi][x]\  // p\) // p\)}], "}"}]], "Input"],

Cell[BoxData[
    RowBox[{"{", 
      RowBox[{
        RowBox[{\(-\[HBar]\^2\), " ", 
          RowBox[{
            SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "x", "]"}]}], ",", 
        RowBox[{\(-\[HBar]\^2\), " ", 
          RowBox[{
            SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "x", "]"}]}], ",", 
        RowBox[{\(-\[HBar]\^2\), " ", 
          RowBox[{
            SuperscriptBox["\[Psi]", "\[Prime]\[Prime]",
              MultilineFunction->None], "[", "x", "]"}]}]}], "}"}]], "Output"]
}, Open  ]],

Cell[TextData[{
  "We can now define other quantum operators, for example, the ",
  StyleBox["K.E.",
    FontColor->RGBColor[1, 0, 0]],
  ":"
}], "Text"],

Cell[BoxData[{\(Clear[K]\), "\[IndentingNewLine]", 
    RowBox[{
      StyleBox["K",
        FontColor->RGBColor[1, 0, 0]], " ", ":=", 
      " ", \(\(1\/\(2  m\)\) p\ @\ \(p\ @\ #\) &\)}]}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  StyleBox["Exercise",
    FontColor->RGBColor[0, 0, 1]],
  " Use ",
  StyleBox["K",
    FontColor->RGBColor[1, 0, 0]],
  " to define the ",
  StyleBox["HO",
    FontColor->RGBColor[0, 0, 1]],
  " ",
  StyleBox["hamiltonian",
    FontColor->RGBColor[0, 0, 1]],
  " operator ",
  StyleBox["H",
    FontColor->RGBColor[0, 0, 1]],
  ". Note the P.E. needs a slot #, too. Hence, show that"
}], "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      StyleBox["H",
        FontColor->RGBColor[0, 0, 1]], 
      StyleBox[" ",
        FontColor->RGBColor[0, 0, 1]], 
      StyleBox["@",
        FontColor->RGBColor[0, 0, 1]], 
      StyleBox[" ",
        FontColor->RGBColor[1, 0, 0]], \(\[Psi][x]\)}]], "Input"],

Cell[BoxData[
    \({{\(\[Omega]\ \[HBar]\)\/2, 0, 0, 0, 0, 
          0}, {0, \(3\ \[Omega]\ \[HBar]\)\/2, 0, 0, 0, 0}, {0, 
          0, \(5\ \[Omega]\ \[HBar]\)\/2, 0, 0, 0}, {0, 0, 
          0, \(7\ \[Omega]\ \[HBar]\)\/2, 0, 0}, {0, 0, 0, 
          0, \(9\ \[Omega]\ \[HBar]\)\/2, 0}, {0, 0, 0, 0, 
          0, \(11\ \[Omega]\ \[HBar]\)\/2}}[\[Psi][x]]\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["HO Raising & Lowering Operators", "Subsubsection"],

Cell[TextData[{
  "The so-called 'raising' (",
  Cell[BoxData[
      StyleBox[\(a\^\[Dagger]\),
        FontColor->RGBColor[1, 0, 0]]]],
  ") and 'lowering' (",
  Cell[BoxData[
      StyleBox["a",
        FontColor->RGBColor[0, 0, 1]]]],
  ") operators allow the HO hamiltonian to be factored and its eigenfunction \
spectrum constructed entirely using operator algebra. These operators are \
identical except for the ",
  StyleBox["\[PlusMinus]I",
    FontFamily->"Courier"],
  ".",
  StyleBox[" (You might have to enter the following cell twice to get things \
to work right.)",
    FontColor->RGBColor[1, 0, 0]]
}], "Text"],

Cell[BoxData[{
    RowBox[{
      RowBox[{
        RowBox[{
          StyleBox[\(a\^\[Dagger]\),
            FontColor->RGBColor[1, 0, 0]], " ", "=", " ", 
          RowBox[{
            RowBox[{\(\@\(\(m\ \[Omega]\)\/\(2  \[HBar]\)\)\), 
              RowBox[{"(", 
                RowBox[{\(x\ #\), " ", 
                  StyleBox["-",
                    FontColor->RGBColor[1, 0, 
                    0]], \(I\/\(m\ \[Omega]\)\ p\ @\ #\)}], ")"}]}], "&"}]}], 
        ";"}], " "}], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{
        StyleBox["a",
          FontColor->RGBColor[0, 0, 1]], "   ", "=", " ", 
        RowBox[{
          RowBox[{\(\@\(\(m\ \[Omega]\)\/\(2  \[HBar]\)\)\), 
            RowBox[{"(", 
              RowBox[{\(x\ #\), " ", 
                StyleBox["+",
                  FontColor->RGBColor[0, 0, 
                  1]], \(I\/\(m\ \[Omega]\)\ p\ @\ #\)}], ")"}]}], "&"}]}], 
      ";"}]}], "Input"],

Cell[TextData[{
  "Note how ",
  StyleBox["\[Psi][x]",
    FontColor->RGBColor[0, 0, 1]],
  " drops in the slots:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      StyleBox[\(a\^\[Dagger]\),
        FontColor->RGBColor[1, 0, 0]], 
      StyleBox[" ",
        FontColor->RGBColor[1, 0, 0]], 
      StyleBox["@",
        FontColor->RGBColor[1, 0, 0]], " ", 
      StyleBox[\(\[Psi][x]\),
        FontColor->RGBColor[0, 0, 1]], " "}]], "Input"],

Cell[BoxData[
    \(\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\
\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\[Psi][x]]\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "These operators factor the HO hamiltonian ",
  StyleBox["H ",
    FontColor->RGBColor[0, 0, 1]],
  "to within an additive constant = the ground-state energy:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{
        RowBox[{
          StyleBox["\[HBar]",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox[" ",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox["\[Omega]",
            FontColor->RGBColor[0, 0, 1]], 
          StyleBox[
            RowBox[{
              StyleBox[" ",
                FontColor->RGBColor[0, 0, 1]], 
              StyleBox[" ",
                FontColor->RGBColor[1, 0, 0]]}]], 
          RowBox[{
            StyleBox[\(a\^\[Dagger]\),
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox[" ",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox["@",
              FontColor->RGBColor[1, 0, 0]], 
            StyleBox[" ",
              FontColor->RGBColor[1, 0, 0]], 
            RowBox[{
              StyleBox["a",
                FontColor->RGBColor[1, 0, 0]], 
              StyleBox[" ",
                FontColor->RGBColor[1, 0, 0]], 
              StyleBox["@",
                FontColor->RGBColor[1, 0, 0]], " ", \(\[Psi][x]\)}]}]}], " ", 
        "//", "Simplify"}], "//", "Expand"}]], "Input"],

Cell[BoxData[
    RowBox[{"\[Omega]", " ", "\[HBar]", " ", 
      RowBox[{\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \
\(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\), "[", 
        FractionBox[
          RowBox[{\(\@\(\(m\ \[Omega]\)\/\[HBar]\)\), " ", 
            RowBox[{"(", 
              RowBox[{\(x\ \[Psi][x]\), "+", 
                FractionBox[
                  RowBox[{"\[HBar]", " ", 
                    RowBox[{
                      SuperscriptBox["\[Psi]", "\[Prime]",
                        MultilineFunction->None], "[", "x", 
                      "]"}]}], \(m\ \[Omega]\)]}], ")"}]}], \(\@2\)], 
        "]"}]}]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"%", " ", "+", 
      RowBox[{
        StyleBox[\(1\/2\),
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox[" ",
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox["\[HBar]",
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox[" ",
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox["\[Omega]",
          FontColor->RGBColor[0, 0, 1]], " ", \(\[Psi][x]\), "  ", 
        StyleBox[\( (*\ add\ the\ grd - state\ energy\ to\ get\ H\ *) \),
          FontColor->RGBColor[0, 0, 1]]}]}]], "Input"],

Cell[BoxData[
    RowBox[{\(1\/2\ \[Omega]\ \[HBar]\ \[Psi][x]\), "+", 
      RowBox[{"\[Omega]", " ", "\[HBar]", " ", 
        RowBox[{\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \
\(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\), "[", 
          FractionBox[
            RowBox[{\(\@\(\(m\ \[Omega]\)\/\[HBar]\)\), " ", 
              RowBox[{"(", 
                RowBox[{\(x\ \[Psi][x]\), "+", 
                  FractionBox[
                    RowBox[{"\[HBar]", " ", 
                      RowBox[{
                        SuperscriptBox["\[Psi]", "\[Prime]",
                          MultilineFunction->None], "[", "x", 
                        "]"}]}], \(m\ \[Omega]\)]}], ")"}]}], \(\@2\)], 
          "]"}]}]}]], "Output"]
}, Open  ]],

Cell["We can thus also define the HO hamiltonian operator as", "Text"],

Cell[BoxData[{\(Clear[H]\), "\[IndentingNewLine]", 
    RowBox[{"H", " ", ":=", " ", 
      RowBox[{
        RowBox[{"\[HBar]", " ", "\[Omega]", " ", 
          RowBox[{"(", 
            RowBox[{
              RowBox[{
                StyleBox[\(a\^\[Dagger]\),
                  FontColor->RGBColor[1, 0, 0]], 
                StyleBox[" ",
                  FontColor->RGBColor[1, 0, 0]], 
                StyleBox["@",
                  FontColor->RGBColor[1, 0, 0]], " ", 
                RowBox[{
                  StyleBox["a",
                    FontColor->RGBColor[0, 0, 1]], 
                  StyleBox[" ",
                    FontColor->RGBColor[0, 0, 1]], 
                  StyleBox["@",
                    FontColor->RGBColor[0, 0, 1]], " ", "#"}]}], " ", 
              "+", \(1\/2\ #\)}], ")"}]}], "&"}]}]}], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(H\ @\ \[Psi][x] // Simplify\) // Expand\)], "Input"],

Cell[BoxData[
    RowBox[{\(1\/2\ \[Omega]\ \[HBar]\ \[Psi][x]\), "+", 
      RowBox[{"\[Omega]", " ", "\[HBar]", " ", 
        RowBox[{\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \
\(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\), "[", 
          FractionBox[
            RowBox[{\(\@\(\(m\ \[Omega]\)\/\[HBar]\)\), " ", 
              RowBox[{"(", 
                RowBox[{\(x\ \[Psi][x]\), "+", 
                  FractionBox[
                    RowBox[{"\[HBar]", " ", 
                      RowBox[{
                        SuperscriptBox["\[Psi]", "\[Prime]",
                          MultilineFunction->None], "[", "x", 
                        "]"}]}], \(m\ \[Omega]\)]}], ")"}]}], \(\@2\)], 
          "]"}]}]}]], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Ladder operators", "Subsubsection"],

Cell[TextData[{
  "Let's introduce (unscaled)",
  " HO basis functions and examine some of the properties of the raising and \
lowering operators. Note the extra normalization factor ",
  Cell[BoxData[
      StyleBox[\(\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\),
        FontColor->RGBColor[0, 0, 1]]]],
  "out front:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{\(\[CurlyPhi]\_n_\), "=", " ", 
      RowBox[{
        RowBox[{
          StyleBox[\(\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\),
            FontColor->RGBColor[0, 0, 
            1]], \(1\/\@\(\(2\^n\) \(n!\) \@\[Pi]\)\), \
\(Exp[\(-\(z\^2\/2\)\)]\), " ", \(HermiteH[n, z]\)}], "/.", 
        StyleBox[\(z \[Rule] \ \(\@\(\(m\ \[Omega]\)\/\[HBar]\)\) x\),
          FontColor->RGBColor[0, 0, 1]]}]}]], "Input"],

Cell[BoxData[
    \(\(\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \
\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\ HermiteH[n, x\ \@\(\(m\ \[Omega]\)\/\
\[HBar]\)]\)\/\(\[Pi]\^\(1/4\)\ \@\(2\^n\ \(n!\)\)\)\)], "Output"]
}, Open  ]],

Cell["Check that these are eigenfunctions of H:", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \({H\ @\ \[CurlyPhi]\_0/\[CurlyPhi]\_0, 
        H\ @\ \[CurlyPhi]\_1/\[CurlyPhi]\_1, 
        H\ @\ \[CurlyPhi]\_2/\[CurlyPhi]\_2} // Simplify\)], "Input"],

Cell[BoxData[
    \({1\/2\ \[HBar]\ \((\[Omega] + \(2\ \[ExponentialE]\^\(\(m\ x\^2\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \[Pi]\^\(1/4\)\ \[Omega]\ \(Transpose[\@\(\(m\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \
\[Omega]\))\) &]\)[0]\)\/\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\))\), 
      1\/2\ \[HBar]\ \((\[Omega] + \(\(1\/\(x\ \((\(m\ \[Omega]\)\/\[HBar])\)\
\^\(3/4\)\)\)\((\@2\ \[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\
\)\ \[Pi]\^\(1/4\)\ \[Omega]\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\
\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(\
\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(1/4\)\)\/\[Pi]\^\(1/4\)])\)\))\), \(\(1\/\(4\ m\^2\ \
x\^2\ \[Omega] - 2\ m\ \[HBar]\)\)\((2\ m\^2\ x\^2\ \[Omega]\^2\ \[HBar] - 
          m\ \[Omega]\ \[HBar]\^2 + 
          2\ \@2\ \[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \
\[Pi]\^\(1/4\)\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\ \[HBar]\^3\ \
\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\
\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(2\ \[ExponentialE]\^\(-\(\(m\ x\^2\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\)\ x\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(3/4\)\)\/\[Pi]\^\(1/4\)])\)\)}\)], "Output"]
}, Open  ]],

Cell["\<\
The raising operator raises the nth eigenfunction to the (n+1)th, while the \
lowering operator lowers the nth to the (n-1)th. Consider the ground- and \
first-excited states:\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \({\(a\^\[Dagger]\)\ @\ \[CurlyPhi]\_0 \[Equal] \[CurlyPhi]\_1, 
        a\ @\ \[CurlyPhi]\_1 \[Equal] \[CurlyPhi]\_0} // Simplify\)], "Input"],

Cell[BoxData[
    \({\[Pi]\^\(1/4\)\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \
\((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) \
&]\)[\(\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \
\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\)\/\[Pi]\^\(1/4\)] \[Equal] \@2\ \
\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ x\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(3/4\), True}\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "Including a normalization factor ",
  Cell[BoxData[
      \(\@\(n!\)\)]],
  ", we can move ",
  StyleBox["up",
    FontColor->RGBColor[1, 0, 0]],
  " and ",
  StyleBox["down",
    FontColor->RGBColor[0, 0, 1]],
  " the ladder:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{
      RowBox[{"{", 
        RowBox[{
          RowBox[{
            FractionBox[
              
              StyleBox[\(\(a\^\[Dagger]\)\ @\ \(\(a\^\[Dagger]\)\ @\ \(\(a\^\
\[Dagger]\)\ @\ \[CurlyPhi]\_0\)\)\),
                FontColor->RGBColor[1, 0, 0]], \(\@\(3!\)\)], " ", 
            "\[Equal]", \(\[CurlyPhi]\_3\)}], ",", 
          RowBox[{
            FractionBox[
              StyleBox[\(a\ @\ \(a\ @\ \(a\ @\ \[CurlyPhi]\_3\)\)\),
                FontColor->RGBColor[0, 0, 1]], \(\@\(3!\)\)], " ", 
            "\[Equal]", \(\[CurlyPhi]\_0\)}]}], "}"}], "//", 
      "Simplify"}]], "Input"],

Cell[BoxData[
    \({\(\(1\/\@6\)\(\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ \
#1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(Transpose[\@\(\(m\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \
\[Omega]\))\) &]\)[\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ \
#1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(\[ExponentialE]\^\(-\
\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\
\(1/4\)\)\/\[Pi]\^\(1/4\)]]]\)\) \[Equal] \(\[ExponentialE]\^\(-\(\(m\ x\^2\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\)\ x\ \((2\ m\ x\^2\ \[Omega] - 3\ \[HBar])\)\ \
\((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\)\/\(\@3\ \[Pi]\^\(1/4\)\ \[HBar]\), 
      True}\)], "Output"]
}, Open  ]],

Cell[TextData[{
  "And when we hit the bottom rung = ",
  StyleBox["ground state",
    FontColor->RGBColor[0, 0, 1]],
  ", the 'machine' stops:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"a", " ", "@", " ", 
      StyleBox[\(\[CurlyPhi]\_0\),
        FontColor->RGBColor[0, 0, 1]]}]], "Input"],

Cell[BoxData[
    \(0\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[TextData[{
  StyleBox["Exercise",
    FontColor->RGBColor[0, 0, 1]],
  " Use this result to solve for the ground state wavefunction by giving ",
  StyleBox["a@\[Psi][x]\[Equal]0",
    FontFamily->"Courier",
    FontColor->RGBColor[1, 0, 0]],
  " to ",
  StyleBox["DSolve",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  ". Normalize the result to obtain ",
  Cell[BoxData[
      StyleBox[\(\[CurlyPhi]\_0\),
        FontColor->RGBColor[0, 0, 1]]]],
  "."
}], "Subsubsection"],

Cell[TextData[{
  StyleBox["Exercise",
    FontColor->RGBColor[0, 0, 1]],
  " Use the built-in function ",
  StyleBox["Nest",
    FontFamily->"Courier",
    FontColor->RGBColor[0, 0, 1]],
  " to define the nth normalized HO eigenstate by repeated application of  ",
  Cell[BoxData[
      StyleBox[\(a\^\[Dagger]\),
        FontColor->RGBColor[1, 0, 0]]]],
  " to ",
  Cell[BoxData[
      StyleBox[\(\[CurlyPhi]\_0\),
        FontColor->RGBColor[0, 0, 1]]]],
  ". Show for a few particular values of n that your function is equivalent \
to ",
  Cell[BoxData[
      StyleBox[\(\[CurlyPhi]\_n\),
        FontColor->RGBColor[0, 0, 1]]]],
  "."
}], "Subsubsection"],

Cell[CellGroupData[{

Cell[" Number operator", "Subsubsection"],

Cell[TextData[{
  "The excitation quantum numbers ",
  StyleBox["n",
    FontColor->RGBColor[0, 0, 1]],
  " are also the eigenvalues of another useful operator, the so-called \
'number operator', defined as"
}], "Text"],

Cell[BoxData[
    RowBox[{
      StyleBox["\[DoubleStruckCapitalN]",
        FontColor->RGBColor[0, 0, 1]], ":=", 
      " ", \(\(a\^\[Dagger]\)\ @\ \(a\ @\ #\) &\), "   ", 
      StyleBox[\( (*\ N - look - alike\ symbol\ from\ a\ palette\ *) \),
        FontColor->RGBColor[0, 0, 1]]}]], "Input"],

Cell[TextData[{
  "with the",
  " ",
  Cell[BoxData[
      StyleBox[\(\[CurlyPhi]\_n\),
        FontColor->RGBColor[0, 0, 1]]]],
  " as eigenfunctions:"
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \({\[DoubleStruckCapitalN]\ @\ \[CurlyPhi]\_0/\[CurlyPhi]\_0, \
\[DoubleStruckCapitalN]\ @\ \[CurlyPhi]\_1/\[CurlyPhi]\_1, \
\[DoubleStruckCapitalN]\ @\ \[CurlyPhi]\_2/\[CurlyPhi]\_2} // 
      Simplify\)], "Input"],

Cell[BoxData[
    \({\(\[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \
\[Pi]\^\(1/4\)\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \
\(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[0]\)\/\((\(m\ \[Omega]\)\/\
\[HBar])\)\^\(1/4\), \(\[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\
\)\)\ \[Pi]\^\(1/4\)\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\
\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) \
&]\)[\(\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \
\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\)\/\[Pi]\^\(1/4\)]\)\/\(\@2\ x\ \
\((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\), \((\@2\ \[ExponentialE]\^\(\(m\ \
x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \[Pi]\^\(1/4\)\ \[HBar]\ \(Transpose[\@\(\
\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \
\[Omega]\))\) &]\)[\(2\ \[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \
\[HBar]\)\)\)\ x\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\)\/\[Pi]\^\(1/4\)])\
\)/\((\((2\ m\ x\^2\ \[Omega] - \[HBar])\)\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(1/4\))\)}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  StyleBox["Exercise",
    FontColor->RGBColor[0, 0, 1]],
  " Use the number operator to redefine the hamiltonian one more time and \
verify that"
}], "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \({H\ @\ \[CurlyPhi]\_0/\[CurlyPhi]\_0, 
        H\ @\ \[CurlyPhi]\_1/\[CurlyPhi]\_1, 
        H\ @\ \[CurlyPhi]\_2/\[CurlyPhi]\_2} // Simplify\)], "Input"],

Cell[BoxData[
    \({1\/2\ \[HBar]\ \((\[Omega] + \(2\ \[ExponentialE]\^\(\(m\ x\^2\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \[Pi]\^\(1/4\)\ \[Omega]\ \(Transpose[\@\(\(m\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \
\[Omega]\))\) &]\)[0]\)\/\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\))\), 
      1\/2\ \[HBar]\ \((\[Omega] + \(\(1\/\(x\ \((\(m\ \[Omega]\)\/\[HBar])\)\
\^\(3/4\)\)\)\((\@2\ \[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\
\)\ \[Pi]\^\(1/4\)\ \[Omega]\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\
\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(\
\[ExponentialE]\^\(-\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(1/4\)\)\/\[Pi]\^\(1/4\)])\)\))\), \(\(1\/\(4\ m\^2\ \
x\^2\ \[Omega] - 2\ m\ \[HBar]\)\)\((2\ m\^2\ x\^2\ \[Omega]\^2\ \[HBar] - 
          m\ \[Omega]\ \[HBar]\^2 + 
          2\ \@2\ \[ExponentialE]\^\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \
\[Pi]\^\(1/4\)\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\ \[HBar]\^3\ \
\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\
\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(2\ \[ExponentialE]\^\(-\(\(m\ x\^2\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\)\ x\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(3/4\)\)\/\[Pi]\^\(1/4\)])\)\)}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[TextData[{
  StyleBox["Exercise",
    FontColor->RGBColor[0, 0, 1]],
  " Modify our definitions of  ",
  Cell[BoxData[
      StyleBox[\(a\^\[Dagger]\),
        FontColor->RGBColor[1, 0, 0]]]],
  " and ",
  Cell[BoxData[
      StyleBox["a",
        FontColor->RGBColor[0, 0, 1]]]],
  " to define ",
  Cell[BoxData[
      StyleBox[\(a\_\[PlusMinus]\),
        FontColor->RGBColor[1, 0, 0]]]],
  "as in Griffith's eq. [2.41]. Note, his operators have a different phase \
(careful with the \[PlusMinus]I) and scale (his number operator has \
dimensions \[HBar] \[Omega] while ours is dimensionless). Thus, verify his \
eqs. [2.42] and [2.51]."
}], "Subsubsection"],

Cell[CellGroupData[{

Cell["Solutions", "Subsection"],

Cell[BoxData[
    \(H\  := \ K@#\  + \ \(1\/2\) m\ \(\[Omega]\^2\) x\^2\ # &\)], "Input"],

Cell[BoxData[
    RowBox[{\(phi[n_]\), " ", ":=", 
      RowBox[{
        RowBox[{
          RowBox[{"Nest", "[", 
            RowBox[{
              StyleBox[\(a\^\[Dagger]\),
                FontColor->RGBColor[1, 0, 0]], 
              StyleBox[",",
                FontColor->RGBColor[1, 0, 0]], \(\[CurlyPhi]\_0\), ",", "n"}],
             "]"}], "/", \(\@\(n!\)\)}], "//", "Simplify"}]}]], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(phi[5] == \[CurlyPhi]\_5 // Simplify\)], "Input"],

Cell[BoxData[
    \(\(\(1\/\(2\ \@30\)\)\(\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\
\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(Transpose[\@\
\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\
\ \[Omega]\))\) &]\)[\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ \
#1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(Transpose[\@\(\(m\ \
\[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \
\[Omega]\))\) &]\)[\(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ \
#1 + \(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(\[ExponentialE]\^\(-\
\(\(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\
\(1/4\)\)\/\[Pi]\^\(1/4\)]]]]]\)\) \[Equal] \(\[ExponentialE]\^\(-\(\(m\ x\^2\
\ \[Omega]\)\/\(2\ \[HBar]\)\)\)\ x\ \((\(m\ \[Omega]\)\/\[HBar])\)\^\(3/4\)\ \
\((4\ m\^2\ x\^4\ \[Omega]\^2 - 20\ m\ x\^2\ \[Omega]\ \[HBar] + 15\ \
\[HBar]\^2)\)\)\/\(2\ \@15\ \[Pi]\^\(1/4\)\ \[HBar]\^2\)\)], "Output"]
}, Open  ]],

Cell[BoxData[{
    \(Clear[H]\), "\[IndentingNewLine]", 
    \(H\  := \[HBar]\ \[Omega]\ \((\[DoubleStruckCapitalN]\ @\ #\  + \ \(1\/2\
\) #)\) &\)}], "Input"],

Cell[CellGroupData[{

Cell["Coherent state?", "Subsubsection",
  FontColor->RGBColor[1, 0, 0]],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(a\^\[Dagger]\)\ @\ \((E^\((I\ ko\ x)\)\ \[CurlyPhi]\_0)\)/\((E^\((I\ \
ko\ x)\)\ \[CurlyPhi]\_0)\) // Simplify\)], "Input"],

Cell[BoxData[
    \(\(\(1\/\((\(m\ \[Omega]\)\/\[HBar])\)\^\(1/4\)\)\((\[ExponentialE]\^\(1\
\/2\ x\ \((\(-2\)\ \[ImaginaryI]\ ko + \(m\ x\ \[Omega]\)\/\[HBar])\)\)\ \
\[Pi]\^\(1/4\)\ \(Transpose[\@\(\(m\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((x\ #1 + \
\(\[ImaginaryI]\ p[#1]\)\/\(m\ \[Omega]\))\) &]\)[\(\[ExponentialE]\^\(\
\[ImaginaryI]\ ko\ x - \(m\ x\^2\ \[Omega]\)\/\(2\ \[HBar]\)\)\ \((\(m\ \
\[Omega]\)\/\[HBar])\)\^\(1/4\)\)\/\[Pi]\^\(1/4\)])\)\)\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"5.0 for Macintosh",
ScreenRectangle->{{0, 1920}, {0, 1174}},
WindowSize->{692, 638},
WindowMargins->{{4, Automatic}, {Automatic, -1}},
Magnification->1.25
]

(*******************************************************************
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[1776, 53, 126, 4, 78, "Subsubtitle"],

Cell[CellGroupData[{
Cell[1927, 61, 65, 0, 32, "Subsubsection"],
Cell[1995, 63, 356, 9, 74, "Text"],

Cell[CellGroupData[{
Cell[2376, 76, 861, 23, 52, "Input"],
Cell[3240, 101, 64, 1, 33, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[3341, 107, 451, 12, 33, "Input"],
Cell[3795, 121, 119, 2, 36, "Output"]
}, Open  ]],
Cell[3929, 126, 740, 22, 112, "Text"],

Cell[CellGroupData[{
Cell[4694, 152, 1089, 32, 33, "Input"],
Cell[5786, 186, 52, 1, 36, "Output"]
}, Open  ]],
Cell[5853, 190, 118, 3, 55, "Text"],

Cell[CellGroupData[{
Cell[5996, 197, 325, 9, 33, "Input"],
Cell[6324, 208, 49, 1, 34, "Output"]
}, Open  ]],
Cell[6388, 212, 289, 8, 55, "Text"],

Cell[CellGroupData[{
Cell[6702, 224, 706, 20, 33, "Input"],
Cell[7411, 246, 60, 1, 33, "Output"]
}, Open  ]],
Cell[7486, 250, 649, 26, 74, "Text"],

Cell[CellGroupData[{
Cell[8160, 280, 371, 9, 33, "Input"],
Cell[8534, 291, 55, 1, 36, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[8638, 298, 42, 0, 32, "Subsubsection"],
Cell[8683, 300, 103, 3, 36, "Text"],
Cell[8789, 305, 176, 8, 36, "Text"],
Cell[8968, 315, 651, 18, 52, "Input"],

Cell[CellGroupData[{
Cell[9644, 337, 427, 13, 33, "Input"],
Cell[10074, 352, 303, 6, 36, "Output"]
}, Open  ]],
Cell[10392, 361, 117, 3, 36, "Text"],

Cell[CellGroupData[{
Cell[10534, 368, 378, 12, 33, "Input"],
Cell[10915, 382, 182, 4, 36, "Output"]
}, Open  ]],
Cell[11112, 389, 117, 3, 36, "Text"],
Cell[11232, 394, 838, 24, 52, "Input"],

Cell[CellGroupData[{
Cell[12095, 422, 901, 26, 33, "Input"],
Cell[12999, 450, 303, 6, 36, "Output"]
}, Open  ]],
Cell[13317, 459, 194, 4, 55, "Text"],
Cell[13514, 465, 249, 5, 52, "Input"],
Cell[13766, 472, 115, 3, 36, "Text"],

Cell[CellGroupData[{
Cell[13906, 479, 565, 16, 33, "Input"],
Cell[14474, 497, 600, 14, 36, "Output"]
}, Open  ]],
Cell[15089, 514, 153, 5, 36, "Text"],
Cell[15245, 521, 200, 4, 78, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[15482, 530, 422, 16, 49, "Subsubsection"],

Cell[CellGroupData[{
Cell[15929, 550, 292, 9, 33, "Input"],
Cell[16224, 561, 374, 6, 131, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[16647, 573, 56, 0, 32, "Subsubsection"],
Cell[16706, 575, 626, 18, 93, "Text"],
Cell[17335, 595, 938, 25, 120, "Input"],
Cell[18276, 622, 126, 5, 36, "Text"],

Cell[CellGroupData[{
Cell[18427, 631, 310, 9, 35, "Input"],
Cell[18740, 642, 158, 2, 63, "Output"]
}, Open  ]],
Cell[18913, 647, 189, 5, 55, "Text"],

Cell[CellGroupData[{
Cell[19127, 656, 1127, 32, 35, "Input"],
Cell[20257, 690, 667, 14, 68, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[20961, 709, 549, 14, 57, "Input"],
Cell[21513, 725, 753, 15, 109, "Output"]
}, Open  ]],
Cell[22281, 743, 70, 0, 36, "Text"],
Cell[22354, 745, 835, 20, 78, "Input"],

Cell[CellGroupData[{
Cell[23214, 769, 74, 1, 33, "Input"],
Cell[23291, 772, 753, 15, 109, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[24093, 793, 41, 0, 32, "Subsubsection"],
Cell[24137, 795, 329, 8, 59, "Text"],

Cell[CellGroupData[{
Cell[24491, 807, 436, 9, 134, "Input"],
Cell[24930, 818, 234, 3, 77, "Output"]
}, Open  ]],
Cell[25179, 824, 57, 0, 36, "Text"],

Cell[CellGroupData[{
Cell[25261, 828, 174, 3, 33, "Input"],
Cell[25438, 833, 1304, 18, 442, "Output"]
}, Open  ]],
Cell[26757, 854, 199, 4, 55, "Text"],

Cell[CellGroupData[{
Cell[26981, 862, 161, 2, 35, "Input"],
Cell[27145, 866, 427, 6, 124, "Output"]
}, Open  ]],
Cell[27587, 875, 258, 11, 39, "Text"],

Cell[CellGroupData[{
Cell[27870, 890, 631, 16, 67, "Input"],
Cell[28504, 908, 742, 10, 261, "Output"]
}, Open  ]],
Cell[29261, 921, 156, 5, 36, "Text"],

Cell[CellGroupData[{
Cell[29442, 930, 132, 3, 33, "Input"],
Cell[29577, 935, 35, 1, 33, "Output"]
}, Open  ]]
}, Open  ]],
Cell[29639, 940, 497, 16, 49, "Subsubsection"],
Cell[30139, 958, 660, 21, 66, "Subsubsection"],

Cell[CellGroupData[{
Cell[30824, 983, 41, 0, 32, "Subsubsection"],
Cell[30868, 985, 219, 6, 55, "Text"],
Cell[31090, 993, 297, 6, 35, "Input"],
Cell[31390, 1001, 164, 7, 36, "Text"],

Cell[CellGroupData[{
Cell[31579, 1012, 233, 4, 33, "Input"],
Cell[31815, 1018, 1096, 15, 349, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[32960, 1039, 183, 5, 49, "Subsubsection"],

Cell[CellGroupData[{
Cell[33168, 1048, 174, 3, 33, "Input"],
Cell[33345, 1053, 1304, 18, 442, "Output"]
}, Open  ]]
}, Open  ]],
Cell[34676, 1075, 665, 19, 66, "Subsubsection"],

Cell[CellGroupData[{
Cell[35366, 1098, 31, 0, 48, "Subsection"],
Cell[35400, 1100, 89, 1, 57, "Input"],
Cell[35492, 1103, 404, 10, 42, "Input"],

Cell[CellGroupData[{
Cell[35921, 1117, 69, 1, 33, "Input"],
Cell[35993, 1120, 1019, 13, 371, "Output"]
}, Open  ]],
Cell[37027, 1136, 159, 3, 78, "Input"],

Cell[CellGroupData[{
Cell[37211, 1143, 72, 1, 32, "Subsubsection"],

Cell[CellGroupData[{
Cell[37308, 1148, 145, 2, 35, "Input"],
Cell[37456, 1152, 464, 6, 176, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}
]
*)



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