{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Trustworthy #-}
module Physics.Learn.Schrodinger1D
(
freeV
, harmonicV
, squareWell
, doubleWell
, stepV
, wall
, coherent
, gaussian
, movingGaussian
, stateVectorFromWavefunction
, hamiltonianMatrix
, expectX
, picture
, xRange
, listForm
)
where
import Data.Complex
( Complex(..)
, magnitude
)
import Graphics.Gloss
( Picture(..)
, yellow
, black
, Display(..)
, display
)
import Numeric.LinearAlgebra
( R
, C
, Vector
, Matrix
, (|>)
, (<.>)
, fromLists
, toList
, size
)
import Physics.Learn.QuantumMat
( probVector
, timeEv
)
freeV
:: Double
-> Double
freeV :: R -> R
freeV R
_x = R
0
harmonicV
:: Double
-> Double
-> Double
harmonicV :: R -> R -> R
harmonicV R
k R
x = R
k R -> R -> R
forall a. Num a => a -> a -> a
* R
xR -> R -> R
forall a. Floating a => a -> a -> a
**R
2 R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
2
doubleWell
:: Double
-> Double
-> Double
-> Double
doubleWell :: R -> R -> R -> R
doubleWell R
a R
v0 R
x = R
v0 R -> R -> R
forall a. Num a => a -> a -> a
* ((R
xR -> R -> R
forall a. Floating a => a -> a -> a
**R
2 R -> R -> R
forall a. Num a => a -> a -> a
- R
aR -> R -> R
forall a. Floating a => a -> a -> a
**R
2)R -> R -> R
forall a. Fractional a => a -> a -> a
/R
aR -> R -> R
forall a. Floating a => a -> a -> a
**R
2)R -> R -> R
forall a. Floating a => a -> a -> a
**R
2
squareWell
:: Double
-> Double
-> Double
-> Double
squareWell :: R -> R -> R -> R
squareWell R
l R
v0 R
x
| R -> R
forall a. Num a => a -> a
abs R
x R -> R -> Bool
forall a. Ord a => a -> a -> Bool
< R
lR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2 = R
0
| Bool
otherwise = R
v0
stepV
:: Double
-> Double
-> Double
stepV :: R -> R -> R
stepV R
v0 R
x
| R
x R -> R -> Bool
forall a. Ord a => a -> a -> Bool
< R
0 = R
0
| Bool
otherwise = R
v0
wall
:: Double
-> Double
-> Double
-> Double
-> Double
wall :: R -> R -> R -> R -> R
wall R
w R
v0 R
x0 R
x
| R -> R
forall a. Num a => a -> a
abs (R
xR -> R -> R
forall a. Num a => a -> a -> a
-R
x0) R -> R -> Bool
forall a. Ord a => a -> a -> Bool
< R
wR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2 = R
v0
| Bool
otherwise = R
0
coherent
:: R
-> C
-> R -> C
coherent :: R -> Complex R -> R -> Complex R
coherent R
l Complex R
z R
x
= ((R
1R -> R -> R
forall a. Fractional a => a -> a -> a
/(R
forall a. Floating a => a
piR -> R -> R
forall a. Num a => a -> a -> a
*R
lR -> R -> R
forall a. Floating a => a -> a -> a
**R
2))R -> R -> R
forall a. Floating a => a -> a -> a
**R
0.25 R -> R -> R
forall a. Num a => a -> a -> a
* R -> R
forall a. Floating a => a -> a
exp(-R
xR -> R -> R
forall a. Floating a => a -> a -> a
**R
2R -> R -> R
forall a. Fractional a => a -> a -> a
/(R
2R -> R -> R
forall a. Num a => a -> a -> a
*R
lR -> R -> R
forall a. Floating a => a -> a -> a
**R
2)) R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0)
Complex R -> Complex R -> Complex R
forall a. Num a => a -> a -> a
* Complex R -> Complex R
forall a. Floating a => a -> a
exp(-Complex R
zComplex R -> Complex R -> Complex R
forall a. Floating a => a -> a -> a
**Complex R
2Complex R -> Complex R -> Complex R
forall a. Fractional a => a -> a -> a
/Complex R
2 Complex R -> Complex R -> Complex R
forall a. Num a => a -> a -> a
+ (R -> R
forall a. Floating a => a -> a
sqrt(R
2R -> R -> R
forall a. Fractional a => a -> a -> a
/R
lR -> R -> R
forall a. Floating a => a -> a -> a
**R
2) R -> R -> R
forall a. Num a => a -> a -> a
* R
x R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0) Complex R -> Complex R -> Complex R
forall a. Num a => a -> a -> a
* Complex R
z)
gaussian
:: R
-> R
-> R -> C
gaussian :: R -> R -> R -> Complex R
gaussian R
a R
x0 R
x = R -> R
forall a. Floating a => a -> a
exp(-(R
xR -> R -> R
forall a. Num a => a -> a -> a
-R
x0)R -> R -> R
forall a. Floating a => a -> a -> a
**R
2R -> R -> R
forall a. Fractional a => a -> a -> a
/(R
2R -> R -> R
forall a. Num a => a -> a -> a
*R
aR -> R -> R
forall a. Floating a => a -> a -> a
**R
2)) R -> R -> R
forall a. Fractional a => a -> a -> a
/ R -> R
forall a. Floating a => a -> a
sqrt(R
a R -> R -> R
forall a. Num a => a -> a -> a
* R -> R
forall a. Floating a => a -> a
sqrt R
forall a. Floating a => a
pi) R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0
movingGaussian
:: R
-> R
-> R
-> R -> C
movingGaussian :: R -> R -> R -> R -> Complex R
movingGaussian R
a R
x0 R
l0 R
x = Complex R -> Complex R
forall a. Floating a => a -> a
exp((R
0 R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
xR -> R -> R
forall a. Fractional a => a -> a -> a
/R
l0) Complex R -> Complex R -> Complex R
forall a. Num a => a -> a -> a
- ((R
xR -> R -> R
forall a. Num a => a -> a -> a
-R
x0)R -> R -> R
forall a. Floating a => a -> a -> a
**R
2R -> R -> R
forall a. Fractional a => a -> a -> a
/(R
2R -> R -> R
forall a. Num a => a -> a -> a
*R
aR -> R -> R
forall a. Floating a => a -> a -> a
**R
2) R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0)) Complex R -> Complex R -> Complex R
forall a. Fractional a => a -> a -> a
/ (R -> R
forall a. Floating a => a -> a
sqrt(R
a R -> R -> R
forall a. Num a => a -> a -> a
* R -> R
forall a. Floating a => a -> a
sqrt R
forall a. Floating a => a
pi) R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0)
fact :: Int -> Double
fact :: Int -> R
fact Int
0 = R
1
fact Int
n = Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n R -> R -> R
forall a. Num a => a -> a -> a
* Int -> R
fact (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
linspace :: Double -> Double -> Int -> [Double]
linspace :: R -> R -> Int -> [R]
linspace R
left R
right Int
num
= let dx :: R
dx = (R
right R -> R -> R
forall a. Num a => a -> a -> a
- R
left) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
in [ R
left R -> R -> R
forall a. Num a => a -> a -> a
+ R
dx R -> R -> R
forall a. Num a => a -> a -> a
* Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n | Int
n <- [Int
0..Int
numInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
stateVectorFromWavefunction :: R
-> R
-> Int
-> (R -> C)
-> Vector C
stateVectorFromWavefunction :: R -> R -> Int -> (R -> Complex R) -> Vector (Complex R)
stateVectorFromWavefunction R
left R
right Int
num R -> Complex R
psi
= (Int
num Int -> [Complex R] -> Vector (Complex R)
forall a. Storable a => Int -> [a] -> Vector a
|>) [R -> Complex R
psi R
x | R
x <- R -> R -> Int -> [R]
linspace R
left R
right Int
num]
hamiltonianMatrix :: R
-> R
-> Int
-> R
-> R
-> (R -> R)
-> Matrix C
hamiltonianMatrix :: R -> R -> Int -> R -> R -> (R -> R) -> Matrix (Complex R)
hamiltonianMatrix R
xmin R
xmax Int
num R
hbar R
m R -> R
pe
= let coeff :: R
coeff = -R
hbarR -> R -> R
forall a. Floating a => a -> a -> a
**R
2R -> R -> R
forall a. Fractional a => a -> a -> a
/(R
2R -> R -> R
forall a. Num a => a -> a -> a
*R
m)
dx :: R
dx = (R
xmax R -> R -> R
forall a. Num a => a -> a -> a
- R
xmin) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
diagKEterm :: R
diagKEterm = -R
2 R -> R -> R
forall a. Num a => a -> a -> a
* R
coeff R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
dxR -> R -> R
forall a. Floating a => a -> a -> a
**R
2
offdiagKEterm :: R
offdiagKEterm = R
coeff R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
dxR -> R -> R
forall a. Floating a => a -> a -> a
**R
2
xs :: [R]
xs = R -> R -> Int -> [R]
linspace R
xmin R
xmax Int
num
in [[Complex R]] -> Matrix (Complex R)
forall t. Element t => [[t]] -> Matrix t
fromLists [[case Int -> Int
forall a. Num a => a -> a
abs(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) of
Int
0 -> (R
diagKEterm R -> R -> R
forall a. Num a => a -> a -> a
+ R -> R
pe R
x) R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0
Int
1 -> R
offdiagKEterm R -> R -> Complex R
forall a. a -> a -> Complex a
:+ R
0
Int
_ -> Complex R
0
| Int
j <- [Int
1..Int
num] ] | (Int
i,R
x) <- [Int] -> [R] -> [(Int, R)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
num] [R]
xs]
expectX :: Vector C
-> Vector R
-> R
expectX :: Vector (Complex R) -> Vector R -> R
expectX Vector (Complex R)
psi Vector R
xs = Vector (Complex R) -> Vector R
probVector Vector (Complex R)
psi Vector R -> Vector R -> R
forall t. Numeric t => Vector t -> Vector t -> t
<.> Vector R
xs
glossScaleX :: Int -> (Double,Double) -> Double -> Float
glossScaleX :: Int -> (R, R) -> R -> Float
glossScaleX Int
screenWidth (R
xmin,R
xmax) R
x
= let w :: R
w = Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
screenWidth :: Double
in R -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (R -> Float) -> R -> Float
forall a b. (a -> b) -> a -> b
$ (R
x R -> R -> R
forall a. Num a => a -> a -> a
- R
xmin) R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
xmax R -> R -> R
forall a. Num a => a -> a -> a
- R
xmin) R -> R -> R
forall a. Num a => a -> a -> a
* R
w R -> R -> R
forall a. Num a => a -> a -> a
- R
w R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
2
glossScaleY :: Int -> (Double,Double) -> Double -> Float
glossScaleY :: Int -> (R, R) -> R -> Float
glossScaleY Int
screenHeight (R
ymin,R
ymax) R
y
= let h :: R
h = Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
screenHeight :: Double
in R -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (R -> Float) -> R -> Float
forall a b. (a -> b) -> a -> b
$ (R
y R -> R -> R
forall a. Num a => a -> a -> a
- R
ymin) R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
ymax R -> R -> R
forall a. Num a => a -> a -> a
- R
ymin) R -> R -> R
forall a. Num a => a -> a -> a
* R
h R -> R -> R
forall a. Num a => a -> a -> a
- R
h R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
2
glossScalePoint :: (Int,Int)
-> (Double,Double)
-> (Double,Double)
-> (Double,Double)
-> (Float,Float)
glossScalePoint :: (Int, Int) -> (R, R) -> (R, R) -> (R, R) -> (Float, Float)
glossScalePoint (Int
screenWidth,Int
screenHeight) (R, R)
xMinMax (R, R)
yMinMax (R
x,R
y)
= (Int -> (R, R) -> R -> Float
glossScaleX Int
screenWidth (R, R)
xMinMax R
x
,Int -> (R, R) -> R -> Float
glossScaleY Int
screenHeight (R, R)
yMinMax R
y)
picture :: (Double, Double)
-> [Double]
-> Vector C
-> Picture
picture :: (R, R) -> [R] -> Vector (Complex R) -> Picture
picture (R
ymin,R
ymax) [R]
xs Vector (Complex R)
psi
= Color -> Picture -> Picture
Color
Color
yellow
(Path -> Picture
Line
[(Int, Int) -> (R, R) -> (R, R) -> (R, R) -> (Float, Float)
glossScalePoint
(Int
screenWidth,Int
screenHeight)
([R] -> R
forall a. HasCallStack => [a] -> a
head [R]
xs, [R] -> R
forall a. HasCallStack => [a] -> a
last [R]
xs)
(R
ymin,R
ymax)
(R, R)
p | (R, R)
p <- [R] -> [R] -> [(R, R)]
forall a b. [a] -> [b] -> [(a, b)]
zip [R]
xs ((Complex R -> R) -> [Complex R] -> [R]
forall a b. (a -> b) -> [a] -> [b]
map Complex R -> R
magSq ([Complex R] -> [R]) -> [Complex R] -> [R]
forall a b. (a -> b) -> a -> b
$ Vector (Complex R) -> [Complex R]
forall a. Storable a => Vector a -> [a]
toList Vector (Complex R)
psi)])
where
magSq :: Complex R -> R
magSq = \Complex R
z -> Complex R -> R
forall a. RealFloat a => Complex a -> a
magnitude Complex R
z R -> R -> R
forall a. Floating a => a -> a -> a
** R
2
screenWidth :: Int
screenWidth = Int
1000
screenHeight :: Int
screenHeight = Int
750
listForm :: (R,R,Vector C) -> ([R],Vector C)
listForm :: (R, R, Vector (Complex R)) -> ([R], Vector (Complex R))
listForm (R
xmin,R
xmax,Vector (Complex R)
v)
= let dt :: R
dt = (R
xmax R -> R -> R
forall a. Num a => a -> a -> a
- R
xmin) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (Complex R) -> IndexOf Vector
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
size Vector (Complex R)
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
in ([R
xmin, R
xmin R -> R -> R
forall a. Num a => a -> a -> a
+ R
dt .. R
xmax],Vector (Complex R)
v)
xRange :: R -> R -> Int -> [R]
xRange :: R -> R -> Int -> [R]
xRange R
xmin R
xmax Int
n
= let dt :: R
dt = (R
xmax R -> R -> R
forall a. Num a => a -> a -> a
- R
xmin) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
in [R
xmin, R
xmin R -> R -> R
forall a. Num a => a -> a -> a
+ R
dt .. R
xmax]