Beskrivelse

(*Source code written in Mathematica 6.0 by Steve Byrnes, Apr. 2011.
  This source code is public domain.*)
  
(*Shows classical and quantum trajectory animations for an infinite-square-well potential.
  Assumes L=hbar=1, m=2*pi^(-2), so that the nth energy eigenstate has energy n^2.*)

ClearAll["Global`*"]

(***Wavefunctions of the energy eigenstates***)
psi[n_, x_] := Sin[n*Pi*x]*2^(1/2);
energy[n_] := n^2;
psit[n_, x_, t_] := psi[n, x] Exp[-I*energy[n]*t];

(***A random time-dependent state***)
SeedRandom[1];
CoefList = Table[Random[]*Exp[2*Pi*I*Random[]], {n, 1, 4}];
CoefList = CoefList/Norm[CoefList];
Randpsi[x_, t_] := Sum[CoefList[[n]]*psit[n, x, t], {n, 1, 4}];

(***Another random time-dependent state***)
SeedRandom[2];
CoefList2 = Table[Random[]*Exp[2*Pi*I*Random[]], {n, 1, 3}];
CoefList2 = CoefList2/Norm[CoefList2];
Randpsi2[x_, t_] := Sum[CoefList2[[n]]*psit[n, x, t], {n, 1, 3}];

(***Set default style for plots***)
SetOptions[Plot,
  {PlotRange -> {{-.05, 1.05}, {-2.5, 2.5}}, Ticks -> None, 
   PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Pink]}, 
   Axes -> {True, False}}];
SetOptions[ListPlot, {PlotRange -> {{-.05, 1.05}, {-2.5, 2.5}}, Axes -> False}];

(***Draw walls***)
walls = ListPlot[{{{0, -2.5}, {0, 2.5}}, {{1, -2.5}, {1, 2.5}}}, 
   Joined -> True, PlotStyle -> {{Thick, Black}, {Thick, Black}}];

(***Make the classical plot...a red ball bounces back and forth.***)
classicaltrajectory[t_, left_, right_] := 2*(right - left)*Abs[t - Round[t]] + left;
classicalball[t_, left_, right_] := ListPlot[{{classicaltrajectory[t, left, right], 0}},
   PlotStyle -> Directive[Red, AbsolutePointSize[15]]];
classical[t_, label_] := Show[walls, classicalball[t, .1, .9], PlotLabel -> label];
(***Make the quantum plots***)
plotpsi[n_, t_, label_] := Show[walls,
   Plot[{Re[psit[n, x, t]], Im[psit[n, x, t]]}, {x, 0, 1}],
   PlotLabel -> label, Axes -> {True, False}, Ticks -> None];
plotrand[t_, label_] := Show[walls,
   Plot[{Re[Randpsi[x, t]], Im[Randpsi[x, t]]}, {x, 0, 1}],
   PlotLabel -> label, Axes -> {True, False}, Ticks -> None];
plotrand2[t_, label_] := Show[walls, 
   Plot[{Re[Randpsi2[x, t]], Im[Randpsi2[x, t]]}, {x, 0, 1}], 
   PlotLabel -> label, Axes -> {True, False}, Ticks -> None];
(***Put all the plots together***)
MakeFrame[t_] := GraphicsGrid[
   {{classical[3 t/(4 Pi), "A"], plotpsi[1, t, "B"]},
    {plotpsi[2, t, "C"], plotpsi[3, t, "D"]},
    {plotrand[t, "E"], plotrand2[t, "F"]}},
   Frame -> All, ImageSize -> 300];
output = Table[MakeFrame[t], {t, 0, 4 Pi*138/139, 4 Pi/139}];
SetDirectory["C:\\Users\\Steve\\Desktop"]
Export["test.gif", output, "DisplayDurations" -> 10]

Licensering

Jeg, dette værks ophavsretsindehaver, publicerer hermed værket under den følgende licens:

Denne fil er udgivet under Creative Commons CC0 1.0 Universal Public Domain Dedication.

Personen, der har tilknyttet et værk til dette dokument, har dikteret værket som offentlig ejendom ved at give afkald alle hans eller hendes rettigheder til værket på verdensplan efter lov om ophavsret og alle relaterede og beslægtede rettigheder, i det omfang lovgivningen tillader det. Du kan kopiere, distribuere og forarbejde værket selv til kommercielle formål; alt sammen uden at spørge om godkendelse. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse