(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 29111, 948] NotebookOptionsPosition[ 25928, 845] NotebookOutlinePosition[ 26318, 862] CellTagsIndexPosition[ 26275, 859] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Execrises (12)", "Title"], Cell["\<\ Assigned: April 16 Due: April 23\ \>", "Subsubtitle", CellChangeTimes->{{3.448901465465457*^9, 3.4489014692941*^9}}], Cell[CellGroupData[{ Cell["Setup your Notebook (in-Class)", "Section"], Cell[TextData[{ "Copy the Crank-Nicolson formula from the class notebook, ", StyleBox["7-QuantumIntro", FontSlant->"Italic"], StyleBox[".nb", FontSlant->"Italic"], ", that advances the wavefunction in unit time steps. \nAlso, copy the \ initial condition function that creates an initial wave-packet of a given \ size and momentum.\nThese functions are called ", StyleBox["cnStep[\[Ellipsis]]", FontWeight->"Bold"], " and ", StyleBox["initial[\[Ellipsis]][x].\n", FontWeight->"Bold"], "(If you wish, you may also want to copy the function ", StyleBox["plot\[Psi][\[Ellipsis]]", FontWeight->"Bold"], ".)" }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"\[Psi]_List", ",", " ", "v_List"}], "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"sparseA", ",", "r", ",", "len"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"len", " ", "=", " ", RowBox[{"Length", "[", "\[Psi]", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"sparseA", " ", "=", " ", RowBox[{"SparseArray", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i_", ",", "i_"}], "}"}], " ", ":>", " ", RowBox[{"1", " ", "+", " ", RowBox[{"I", " ", RowBox[{"(", RowBox[{"1.0", " ", "+", " ", RowBox[{ "v", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}], " ", "0.5"}]}]}], ",", " ", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i_", ",", "j_"}], "}"}], "/;", " ", RowBox[{ RowBox[{"Abs", "[", RowBox[{"i", "-", "j"}], "]"}], " ", "\[Equal]", " ", "1"}]}], " ", "\[Rule]", " ", RowBox[{ RowBox[{"-", " ", "I"}], " ", "0.25"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"len", ",", " ", "len"}], "}"}], ",", " ", "0.0"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"r", " ", "=", " ", RowBox[{ RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"I", " ", "0.25"}], ",", RowBox[{"1.0", " ", "-", " ", RowBox[{"I", " ", "0.5"}]}], ",", " ", RowBox[{"I", " ", "0.25"}]}], "}"}], ",", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}], " ", "-", " ", RowBox[{"I", " ", "\[Psi]", " ", "v", " ", "0.5"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", StyleBox[ RowBox[{"fixed", " ", "boundaries"}], FontColor->RGBColor[0, 1, 0]], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"sol", " ", "=", " ", RowBox[{"LinearSolve", "[", RowBox[{"sparseA", ",", "r"}], "]"}]}], ";", "\[IndentingNewLine]", "sol"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.448901019266375*^9, 3.448901090956354*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"k_", ",", "x0_", ",", "s_"}], "]"}], "[", "x_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"Exp", "[", RowBox[{"I", " ", "k", " ", "x"}], "]"}], " ", RowBox[{ RowBox[{"Exp", "[", RowBox[{"-", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"(", RowBox[{"x", "-", "x0"}], ")"}], "/", RowBox[{"(", RowBox[{"2", " ", "s"}], ")"}]}], ")"}], "^", "2"}]}], "]"}], "/", RowBox[{"Sqrt", "[", " ", RowBox[{"Sqrt", "[", RowBox[{"2", " ", "\[Pi]", " ", RowBox[{"s", "^", "2"}]}], "]"}], "]"}]}]}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"plot\[Psi]", "[", RowBox[{"\[Psi]_List", ",", "options___"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"p1", ",", "p2", ",", "p3", ",", "p4"}], "}"}], ",", RowBox[{ RowBox[{"p1", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Re", "[", "\[Psi]", "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{"0", ",", "0", ",", "1"}], "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p2", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Im", "[", "\[Psi]", "]"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"RGBColor", "[", RowBox[{"1", ",", "0", ",", "0"}], "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p3", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Abs", "[", "\[Psi]", "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"p4", "=", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"-", RowBox[{"Abs", "[", "\[Psi]", "]"}]}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], ";", RowBox[{"Show", "[", RowBox[{"p1", ",", "p2", ",", "p3", ",", "p4", ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}], ",", "options"}], "]"}]}]}], "]"}]}], ";"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["A stationary start (in-Class)", "Section"], Cell[TextData[{ "Examine quantum wave-function dynamics when the initial condition has no \ initial momentum. This is determined by initializing your solution with ", StyleBox["k", FontSlant->"Italic"], " = 0.0, or", " ", StyleBox["initial[0.0,x0,s0][x]", FontWeight->"Bold"], "." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[{ RowBox[{ RowBox[{"nGrid", " ", "=", " ", "100"}], ";", RowBox[{"\[Psi]0", " ", "=", " ", RowBox[{"(", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"0.0", ",", RowBox[{"nGrid", "/", "2"}], ",", "8"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "//", " ", "N"}], ")"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"v0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{"0.0", ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"plot\[Psi]", "[", "\[Psi]0", "]"}]}], "Input", CellChangeTimes->{3.448901517569137*^9}], Cell[TextData[{ "Here, I introduced an auxiliary function, called ", StyleBox["tenSteps[\[Psi]]", FontWeight->"Bold"], ", that returns a time-advanced wave-function resulting from 10 time steps. \ This reduces the memory requirements for subsequent graphics." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"tenSteps", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Nest", "[", RowBox[{ RowBox[{ RowBox[{"cnStep", "[", RowBox[{"#", ",", "v0"}], "]"}], "&"}], ",", " ", "\[Psi]", ",", " ", "10"}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", StyleBox[ RowBox[{ RowBox[{"100", " ", "x", " ", "10"}], " ", "=", " ", RowBox[{"1000", " ", RowBox[{"steps", "!"}]}]}], FontColor->RGBColor[1, 0, 1]], " ", "*)"}], RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"sol", " ", "=", " ", RowBox[{"NestList", "[", RowBox[{"tenSteps", ",", " ", "\[Psi]0", ",", " ", "100"}], "]"}]}], ";"}], ")"}], "//", "Timing"}]}]], "Input"], Cell[BoxData[ RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "sol", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.3"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.448901548035557*^9}], Cell[BoxData[ RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"Abs", "[", "sol", "]"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.3"}], "}"}]}], ",", RowBox[{"Mesh", "\[Rule]", "False"}]}], "]"}]], "Input", CellChangeTimes->{3.448901555422675*^9}], Cell[BoxData[ RowBox[{"plot\[Psi]", "[", RowBox[{"sol", "\[LeftDoubleBracket]", "80", "\[RightDoubleBracket]"}], "]"}]], "Input", CellChangeTimes->{3.448901561266059*^9}], Cell["\<\ Although the particle starts in the middle of the box and although it is not \ \"moving\" in the classical sense, over time, the probablity of finding the \ object is no longer at the center. In fact, the probability oscillates in \ time between the center and the sides.\ \>", "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Most likely position (in-class)", "Section"], Cell[TextData[{ "Compute the \"most likely position\" of the object as a function of time \ for the initial condition above and for the initial condition used in class.\n\ The most likely position is defined as the sum, ", Cell[BoxData[ FormBox[ RowBox[{ UnderoverscriptBox["\[Sum]", RowBox[{"x", "=", "1"}], "nGrid"], RowBox[{ SuperscriptBox["\[Psi]", "*"], " ", "x", " ", "\[Psi]"}]}], TraditionalForm]]], ", where ", Cell[BoxData[ FormBox[ SuperscriptBox["\[Psi]", "*"], TraditionalForm]]], "is the complex conjugate of \[Psi]." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"avgx", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"Plus", " ", "@@", " ", RowBox[{"(", RowBox[{ RowBox[{"Conjugate", "[", "\[Psi]", "]"}], " ", RowBox[{"Table", "[", RowBox[{"x", ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "\[Psi]"}], ")"}]}], " ", "//", " ", "Chop"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"avgx", "[", RowBox[{"sol", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"avgx", "[", RowBox[{"sol", "\[LeftDoubleBracket]", "100", "\[RightDoubleBracket]"}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"avgx", "/@", "sol"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "100"}], "}"}]}]}], "]"}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"nGrid", " ", "=", " ", "100"}], ";", RowBox[{"\[Psi]0", " ", "=", " ", RowBox[{"(", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"0.6", ",", RowBox[{"nGrid", "/", "2"}], ",", "8"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "//", " ", "N"}], ")"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"v0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{"0.0", ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"plot\[Psi]", "[", "\[Psi]0", "]"}]}], "Input", CellChangeTimes->{3.4489015723710546`*^9}], Cell[BoxData[ RowBox[{ RowBox[{"sol", " ", "=", " ", RowBox[{"NestList", "[", RowBox[{"tenSteps", ",", " ", "\[Psi]0", ",", " ", "100"}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "sol", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "0.3"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.448901578881143*^9}], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"avgx", "/@", "sol"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "100"}], "}"}]}]}], "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Most likely momentum (in-class)", "Section"], Cell["\<\ For the wave-function computed in class, determine the \"most-likely momentum\ \" as a function of time.\ \>", "Text"], Cell[TextData[{ "The most likely momentum can be calculated in several ways. One easy method \ is to compute the sum ", Cell[BoxData[ FormBox[ RowBox[{ UnderoverscriptBox["\[Sum]", RowBox[{"x", "=", "1"}], "nGrid"], RowBox[{ SuperscriptBox["\[Psi]", "*"], "(", RowBox[{ RowBox[{"-", " ", "I"}], " ", RowBox[{ SubscriptBox["\[PartialD]", "x"], " ", "\[Psi]"}]}], ")"}]}], TraditionalForm]]], ". This can be written as" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"avgk", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"-", " ", "I"}], " ", RowBox[{"Chop", "[", " ", RowBox[{"Plus", " ", "@@", " ", RowBox[{"(", RowBox[{ RowBox[{"Conjugate", "[", "\[Psi]", "]"}], " ", RowBox[{"ListConvolve", "[", RowBox[{ RowBox[{"{", RowBox[{"0.5", ",", " ", "0", ",", " ", RowBox[{"-", "0.5"}]}], "}"}], ",", " ", "\[Psi]", ",", " ", "2", ",", " ", "0.0"}], "]"}]}], ")"}]}], "]"}]}]}], ";"}]], "Input"], Cell[TextData[{ "The command ", StyleBox["ListConvolve[\[Ellipsis]]", FontWeight->"Bold"], " is used to find the central-difference approximation to the first \ derivative in x", StyleBox[". ", FontSlant->"Italic"], Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "x"], " ", "\[Psi]"}], TraditionalForm]]], "\[TildeTilde] (\[Psi](x + 1) - \[Psi](x - 1)) / 2." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"avgk", "[", RowBox[{"sol", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avgk", "/@", "sol"}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Momentum Probability", "Subsubsection"], Cell[TextData[{ "Another way to view the momentum is to transform the solution to a \ \"momentum representation\". This is simply the Fourier transform (along the \ ", StyleBox["x", FontSlant->"Italic"], " direction) of the solution, \[Psi](x, t) \[Rule] \[Psi](k, t)." }], "Text"], Cell[TextData[{ "As described in ", StyleBox["Mathematica's ", FontSlant->"Italic"], "help manuals, ", StyleBox["Fourier[\[Ellipsis]]", FontWeight->"Bold"], " returns the spectrum in a mixed order. The first ", StyleBox["nGrid/2", FontWeight->"Bold"], " points correspond to ", StyleBox["k", FontSlant->"Italic"], " = 0 to -\[Pi]. The next points correspond to \[Pi] back down towards 0. \ For this reason, we need t o re-arrange the spectrum:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"rearrangeFourier", "[", "p_List", "]"}], " ", ":=", " ", RowBox[{"Reverse", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"[", RowBox[{"Range", "[", RowBox[{ RowBox[{ RowBox[{"nGrid", "/", "2"}], " ", "+", " ", "1"}], ",", " ", "nGrid"}], "]"}], "]"}], "]"}], " ", StyleBox["~", FontColor->RGBColor[1, 0, 1]], StyleBox[" ", FontColor->RGBColor[1, 0, 1]], StyleBox["Join", FontColor->RGBColor[1, 0, 1]], StyleBox["~", FontColor->RGBColor[1, 0, 1]], " ", RowBox[{"p", "[", RowBox[{"[", RowBox[{"Range", "[", RowBox[{"1", ",", RowBox[{"nGrid", "/", "2"}]}], "]"}], "]"}], "]"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"kTest", "=", "0.6"}], ";", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Abs", "[", RowBox[{"Fourier", "[", RowBox[{"Table", "[", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", "kTest", " ", "x"}]], ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]}]], "Input", CellChangeTimes->{3.448901621053219*^9}], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Abs", "[", RowBox[{"rearrangeFourier", "[", RowBox[{"Fourier", "[", RowBox[{"Table", "[", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", "kTest", " ", "x"}]], ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "nGrid"}], "}"}]}], "]"}], "]"}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"solk", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"rearrangeFourier", "[", RowBox[{"Fourier", "[", "#", "]"}], "]"}], "&"}], " ", "/@", " ", "sol"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListDensityPlot", "[", RowBox[{ RowBox[{"Abs", "[", "solk", "]"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"Abs", "[", "solk", "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}]}], "]"}]], "Input"], Cell[TextData[{ "Notice that ", StyleBox["zero", FontSlant->"Italic"], " momentum is at position ", StyleBox["nGrid/2", FontWeight->"Bold"], ". The particle bounces back and forth. After a few bounces, however, it \ becomes difficult to know whether the particle is moving to the right or to \ the left!" }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Heisenberg's Uncertainty", "Section"], Cell["\<\ In this problem, you are to examine Heisenberg's Uncertainty Principle. If \ you specify the location of a particle with high accuracy, you can not know \ its momentum very well. On the other hand, if you allow uncertainty in a \ particle's location, then you may specify its momentum more accurately. \ \>", "Text"], Cell[CellGroupData[{ Cell["Part 1", "Subsection"], Cell["\<\ In order to illustrate this, we'll look at particles initialized with \ \"zero\" momentum. We'll first examine the time-dependence of the \ wave-function for a \"narrow\" (well-localized) initial condition and next \ for a broad (not very-well localized) initial condtion. \ \>", "Text"], Cell[TextData[{ "Let these two initial conditions be called, ", StyleBox["\[Psi]", FontWeight->"Bold"], StyleBox["Narrow", FontWeight->"Bold"], " and ", StyleBox["\[Psi]Broad", FontWeight->"Bold"], ":" }], "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"nGrid", " ", "=", " ", "100"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"v0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{"0.0", ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}]}], ";", RowBox[{"\[Psi]Narrow", " ", "=", " ", RowBox[{"N", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"0.0", ",", RowBox[{"nGrid", "/", "2"}], ",", "2"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"\[Psi]Broad", " ", "=", " ", RowBox[{"N", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"initial", "[", RowBox[{"0.0", ",", RowBox[{"nGrid", "/", "2"}], ",", "16"}], "]"}], "[", "x", "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], "]"}]}], ";"}]}], "Input"], Cell[TextData[{ "Advance the wave-function from both of these initial conditions using ", StyleBox["cnStep[\[Ellipsis]]", FontWeight->"Bold"], ". Describe in words the differences between the two solutions. What do \ these differences say about the uncertainty relation?" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part 2", "Subsection"], Cell[TextData[{ "Another way to illustrate the uncertainty relation is to look at both the \ \"width\" of the particle's probability in both coordinate space, or ", StyleBox["x", FontSlant->"Italic"], "-space, and in \"momentum space\", or ", StyleBox["k", FontSlant->"Italic"], "-space. Call the width in coordinate space \[CapitalDelta]x. Call the width \ in momentum space \[CapitalDelta]k. The uncertainty principle states that \ \[CapitalDelta]x \[CapitalDelta]k is a constant. " }], "Text"], Cell["\<\ Below, two functions are defined that compute the width in coordinate space \ and the width in momentum space:\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"deltaX", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "avg", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"avg", " ", "=", " ", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Chop", "[", RowBox[{ RowBox[{"Conjugate", "[", "\[Psi]", "]"}], " ", RowBox[{"Table", "[", RowBox[{"x", ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "\[Psi]"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"Sqrt", "[", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Chop", "[", RowBox[{ RowBox[{"Conjugate", "[", "\[Psi]", "]"}], " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"x", " ", "-", " ", "avg"}], ")"}], "^", "2"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "\[Psi]"}], "]"}]}], "]"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"deltaP", "[", "\[Psi]_List", "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"p", ",", "avg"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"p", " ", "=", " ", RowBox[{"rearrangeFourier", "[", RowBox[{"Fourier", "[", "\[Psi]", "]"}], "]"}]}], ";", RowBox[{"avg", " ", "=", " ", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Chop", "[", RowBox[{ RowBox[{"Conjugate", "[", "p", "]"}], " ", RowBox[{"Table", "[", RowBox[{"k", ",", " ", RowBox[{"{", RowBox[{"k", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "p"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"Sqrt", "[", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Chop", "[", RowBox[{ RowBox[{"Conjugate", "[", "p", "]"}], " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"k", " ", "-", " ", "avg"}], ")"}], "^", "2"}], ",", " ", RowBox[{"{", RowBox[{"k", ",", " ", "1", ",", " ", "nGrid"}], "}"}]}], "]"}], " ", "p"}], "]"}]}], "]"}]}]}], "]"}]}], ";"}]}], "Input"], Cell[TextData[{ "These two functions work in the same way, except ", StyleBox["deltaP[\[Ellipsis]]", FontWeight->"Bold"], " uses the Fourier transform of \[Psi] while ", StyleBox["deltaX[\[Ellipsis]]", FontWeight->"Bold"], " uses \[Psi](", StyleBox["x", FontSlant->"Italic"], ")." }], "Text"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"deltaX", "[", "\[Psi]Narrow", "]"}], ",", " ", RowBox[{"deltaP", "[", "\[Psi]Narrow", "]"}], ",", " ", RowBox[{ RowBox[{"deltaX", "[", "\[Psi]Narrow", "]"}], " ", "*", " ", RowBox[{"deltaP", "[", "\[Psi]Narrow", "]"}]}]}], "}"}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"deltaX", "[", "\[Psi]Broad", "]"}], ",", " ", RowBox[{"deltaP", "[", "\[Psi]Broad", "]"}], ",", " ", RowBox[{ RowBox[{"deltaX", "[", "\[Psi]Broad", "]"}], " ", "*", " ", RowBox[{"deltaP", "[", "\[Psi]Broad", "]"}]}]}], "}"}]], "Input"], Cell[TextData[{ StyleBox["Your assignment: ", FontWeight->"Bold", FontSlant->"Italic"], "Use the functions defined above and plot \[CapitalDelta]x versus \ \[CapitalDelta]k for various initial conditions. Use the ", StyleBox["initial[\[Ellipsis]]", FontWeight->"Bold"], " function to change the width of \[Psi] keeping the mean momentum at zero. \ ListPlot your results." }], "Text"] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{674, 848}, WindowMargins->{{Automatic, 525}, {Automatic, 26}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 31, 0, 73, "Title"], Cell[624, 25, 127, 4, 45, "Subsubtitle"], Cell[CellGroupData[{ Cell[776, 33, 49, 0, 69, "Section"], Cell[828, 35, 635, 18, 91, "Text"], Cell[CellGroupData[{ Cell[1488, 57, 33, 0, 24, "Subsubsection"], Cell[1524, 59, 2368, 61, 165, "Input"], Cell[3895, 122, 725, 24, 46, "Input"], Cell[4623, 148, 1830, 44, 165, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[6502, 198, 48, 0, 39, "Section"], Cell[6553, 200, 302, 10, 43, "Text"], Cell[CellGroupData[{ Cell[6880, 214, 33, 0, 24, "Subsubsection"], Cell[6916, 216, 842, 24, 63, "Input"], Cell[7761, 242, 276, 6, 43, "Text"], Cell[8040, 250, 300, 9, 28, "Input"], Cell[8343, 261, 475, 15, 46, "Input"], Cell[8821, 278, 358, 9, 46, "Input"], Cell[9182, 289, 299, 8, 28, "Input"], Cell[9484, 299, 178, 4, 28, "Input"], Cell[9665, 305, 295, 5, 59, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[10009, 316, 50, 0, 39, "Section"], Cell[10062, 318, 582, 17, 67, "Text"], Cell[10647, 337, 475, 13, 28, "Input"], Cell[CellGroupData[{ Cell[11147, 354, 33, 0, 24, "Subsubsection"], Cell[11183, 356, 129, 3, 28, "Input"], Cell[11315, 361, 131, 3, 28, "Input"], Cell[11449, 366, 205, 6, 28, "Input"], Cell[11657, 374, 844, 24, 63, "Input"], Cell[12504, 400, 178, 5, 28, "Input"], Cell[12685, 407, 358, 9, 46, "Input"], Cell[13046, 418, 205, 6, 28, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[13300, 430, 50, 0, 39, "Section"], Cell[13353, 432, 128, 3, 43, "Text"], Cell[13484, 437, 487, 16, 51, "Text"], Cell[13974, 455, 592, 16, 46, "Input"], Cell[14569, 473, 402, 13, 43, "Text"], Cell[CellGroupData[{ Cell[14996, 490, 33, 0, 24, "Subsubsection"], Cell[15032, 492, 129, 3, 28, "Input"], Cell[15164, 497, 90, 2, 28, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[15291, 504, 45, 0, 24, "Subsubsection"], Cell[15339, 506, 286, 7, 59, "Text"], Cell[15628, 515, 473, 15, 59, "Text"], Cell[16104, 532, 762, 25, 46, "Input"], Cell[16869, 559, 531, 15, 53, "Input"], Cell[17403, 576, 479, 13, 53, "Input"], Cell[17885, 591, 226, 7, 28, "Input"], Cell[18114, 600, 266, 6, 46, "Input"], Cell[18383, 608, 207, 5, 28, "Input"], Cell[18593, 615, 325, 10, 43, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[18967, 631, 43, 0, 39, "Section"], Cell[19013, 633, 326, 5, 59, "Text"], Cell[CellGroupData[{ Cell[19364, 642, 28, 0, 33, "Subsection"], Cell[19395, 644, 297, 5, 59, "Text"], Cell[19695, 651, 225, 10, 27, "Text"], Cell[19923, 663, 1114, 34, 80, "Input"], Cell[21040, 699, 288, 6, 43, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[21365, 710, 28, 0, 33, "Subsection"], Cell[21396, 712, 505, 11, 59, "Text"], Cell[21904, 725, 134, 3, 27, "Text"], Cell[22041, 730, 2525, 67, 131, "Input"], Cell[24569, 799, 305, 11, 43, "Text"], Cell[24877, 812, 308, 7, 28, "Input"], Cell[25188, 821, 304, 7, 28, "Input"], Cell[25495, 830, 393, 10, 43, "Text"] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)