(*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]

나는 아래 작품의 저작권자로서, 이 저작물을 다음과 같은 라이선스로 배포합니다:

	이 파일은 크리에이티브 커먼즈 CC0 1.0 보편적 퍼블릭 도메인 귀속에 따라 이용할 수 있습니다.
	저작물에 본 권리증서를 첨부한 자는 법률에서 허용하는 범위 내에서 저작인접권 및 관련된 모든 권리들을 포함하여 저작권법에 따라 전 세계적으로 해당 저작물에 대해 자신이 갖는 일체의 권리를 포기함으로써 저작물을 퍼블릭 도메인으로 양도하였습니다. 저작권자의 허락을 구하지 않아도 이 저작물을 상업적인 목적을 포함하여 모든 목적으로 복제, 수정·변경, 배포, 공연·실연할 수 있습니다. http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse