{-# LANGUAGE RebindableSyntax #-}
module Circuit.Diff.Chart
(
inducedMetric2D,
raise2D,
partialG,
christoffel2D,
directionalDerivative,
covariantDerivative,
)
where
import Circuit.Diff (Diff (..), Diff', runDiff)
import NumHask.Prelude
dot2 :: (Additive a, Multiplicative a) => (a, a) -> (a, a) -> a
dot2 :: forall a. (Additive a, Multiplicative a) => (a, a) -> (a, a) -> a
dot2 (a
x1, a
y1) (a
x2, a
y2) = a
x1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x2 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y2
inducedMetric2D ::
(Additive a, Multiplicative a) =>
Diff' (a, a) (a, a) ->
Diff' ((a, a), (a, a)) (a, a)
inducedMetric2D :: forall a.
(Additive a, Multiplicative a) =>
Diff' (a, a) (a, a) -> Diff' ((a, a), (a, a)) (a, a)
inducedMetric2D (Diff (a, a) -> ((a, a), (a, a) -> (a, a))
f) = (((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a)
forall k (p :: k) a b. (a -> (b, b -> a)) -> Diff p a b
Diff ((((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a))
-> (((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a)
forall a b. (a -> b) -> a -> b
$ \((a, a)
x, (a, a)
v) ->
let ((a, a)
_, (a, a) -> (a, a)
jt) = (a, a) -> ((a, a), (a, a) -> (a, a))
f (a, a)
x
jv1 :: a
jv1 = (a, a) -> (a, a) -> a
forall a. (Additive a, Multiplicative a) => (a, a) -> (a, a) -> a
dot2 (a, a)
v ((a, a) -> (a, a)
jt (a
forall a. Multiplicative a => a
one, a
forall a. Additive a => a
zero))
jv2 :: a
jv2 = (a, a) -> (a, a) -> a
forall a. (Additive a, Multiplicative a) => (a, a) -> (a, a) -> a
dot2 (a, a)
v ((a, a) -> (a, a)
jt (a
forall a. Additive a => a
zero, a
forall a. Multiplicative a => a
one))
gv :: (a, a)
gv = (a, a) -> (a, a)
jt (a
jv1, a
jv2)
in ((a, a)
gv, ((a, a), (a, a)) -> (a, a) -> ((a, a), (a, a))
forall a b. a -> b -> a
const ((a
forall a. Additive a => a
zero, a
forall a. Additive a => a
zero), (a
forall a. Additive a => a
zero, a
forall a. Additive a => a
zero)))
raise2D :: (Field a) => Diff' ((a, a), (a, a)) (a, a) -> Diff' ((a, a), (a, a)) (a, a)
raise2D :: forall a.
Field a =>
Diff' ((a, a), (a, a)) (a, a) -> Diff' ((a, a), (a, a)) (a, a)
raise2D (Diff ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
lower) = (((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a)
forall k (p :: k) a b. (a -> (b, b -> a)) -> Diff p a b
Diff ((((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a))
-> (((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a))))
-> Diff () ((a, a), (a, a)) (a, a)
forall a b. (a -> b) -> a -> b
$ \((a, a)
x, (a, a)
c) ->
let ((a, a)
col1, (a, a) -> ((a, a), (a, a))
_) = ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
lower ((a, a)
x, (a
forall a. Multiplicative a => a
one, a
forall a. Additive a => a
zero))
((a, a)
col2, (a, a) -> ((a, a), (a, a))
_) = ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
lower ((a, a)
x, (a
forall a. Additive a => a
zero, a
forall a. Multiplicative a => a
one))
g00 :: a
g00 = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
col1
g10 :: a
g10 = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
col1
g01 :: a
g01 = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
col2
g11 :: a
g11 = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
col2
det :: a
det = a
g00 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
g11 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
g01 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
g10
inv00 :: a
inv00 = a
g11 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det
inv01 :: a
inv01 = a -> a
forall a. Subtractive a => a -> a
negate a
g01 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det
inv10 :: a
inv10 = a -> a
forall a. Subtractive a => a -> a
negate a
g10 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det
inv11 :: a
inv11 = a
g00 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det
v1 :: a
v1 = a
inv00 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
inv01 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
c
v2 :: a
v2 = a
inv10 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
inv11 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
c
in ((a
v1, a
v2), ((a, a), (a, a)) -> (a, a) -> ((a, a), (a, a))
forall a b. a -> b -> a
const ((a
forall a. Additive a => a
zero, a
forall a. Additive a => a
zero), (a
forall a. Additive a => a
zero, a
forall a. Additive a => a
zero)))
basis0 :: (Additive a, Multiplicative a) => (a, a)
basis0 :: forall a. (Additive a, Multiplicative a) => (a, a)
basis0 = (a
forall a. Multiplicative a => a
one, a
forall a. Additive a => a
zero)
basis1 :: (Additive a, Multiplicative a) => (a, a)
basis1 :: forall a. (Additive a, Multiplicative a) => (a, a)
basis1 = (a
forall a. Additive a => a
zero, a
forall a. Multiplicative a => a
one)
partialG ::
(Additive a, Multiplicative a) =>
Diff' ((a, a), (a, a)) (a, a) ->
(a, a) ->
(((a, a), (a, a)), ((a, a), (a, a)))
partialG :: forall a.
(Additive a, Multiplicative a) =>
Diff' ((a, a), (a, a)) (a, a)
-> (a, a) -> (((a, a), (a, a)), ((a, a), (a, a)))
partialG Diff' ((a, a), (a, a)) (a, a)
lower (a, a)
x =
let probe :: (a, a) -> (a, a) -> (a, a)
probe (a, a)
v (a, a)
dc =
let ((a, a)
_, (a, a) -> ((a, a), (a, a))
back) = Diff' ((a, a), (a, a)) (a, a)
-> ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
forall k (p :: k) a b. Diff p a b -> a -> (b, b -> a)
runDiff Diff' ((a, a), (a, a)) (a, a)
lower ((a, a)
x, (a, a)
v)
((a, a)
dpoint, (a, a)
_) = (a, a) -> ((a, a), (a, a))
back (a, a)
dc
in (a, a)
dpoint
row0 :: ((a, a), (a, a))
row0 = ((a, a) -> (a, a) -> (a, a)
probe (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0 (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0, (a, a) -> (a, a) -> (a, a)
probe (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0 (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1)
row1 :: ((a, a), (a, a))
row1 = ((a, a) -> (a, a) -> (a, a)
probe (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1 (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0, (a, a) -> (a, a) -> (a, a)
probe (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1 (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1)
in (((a, a), (a, a))
row0, ((a, a), (a, a))
row1)
christoffel2D ::
forall a.
(Field a) =>
Diff' ((a, a), (a, a)) (a, a) ->
Diff' ((a, a), (a, a)) (a, a) ->
(a, a) ->
(a, a, a, a, a, a, a, a)
christoffel2D :: forall a.
Field a =>
Diff' ((a, a), (a, a)) (a, a)
-> Diff' ((a, a), (a, a)) (a, a)
-> (a, a)
-> (a, a, a, a, a, a, a, a)
christoffel2D Diff' ((a, a), (a, a)) (a, a)
lower Diff' ((a, a), (a, a)) (a, a)
raise (a, a)
x =
let pg :: (((a, a), (a, a)), ((a, a), (a, a)))
pg = Diff' ((a, a), (a, a)) (a, a)
-> (a, a) -> (((a, a), (a, a)), ((a, a), (a, a)))
forall a.
(Additive a, Multiplicative a) =>
Diff' ((a, a), (a, a)) (a, a)
-> (a, a) -> (((a, a), (a, a)), ((a, a), (a, a)))
partialG Diff' ((a, a), (a, a)) (a, a)
lower (a, a)
x
((a
g00, a
g01), (a
g10, a
g11)) =
let ((a, a)
v0, (a, a) -> ((a, a), (a, a))
_) = Diff' ((a, a), (a, a)) (a, a)
-> ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
forall k (p :: k) a b. Diff p a b -> a -> (b, b -> a)
runDiff Diff' ((a, a), (a, a)) (a, a)
raise ((a, a)
x, (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0)
((a, a)
v1, (a, a) -> ((a, a), (a, a))
_) = Diff' ((a, a), (a, a)) (a, a)
-> ((a, a), (a, a)) -> ((a, a), (a, a) -> ((a, a), (a, a)))
forall k (p :: k) a b. Diff p a b -> a -> (b, b -> a)
runDiff Diff' ((a, a), (a, a)) (a, a)
raise ((a, a)
x, (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1)
in ((a, a)
v0, (a, a)
v1)
d :: Int -> Int -> Int -> a
d :: Int -> Int -> Int -> a
d Int
i Int
j Int
k = case (Int
i, Int
j, Int
k) of
(Int
0, Int
0, Int
0) -> (a, a) -> a
forall a b. (a, b) -> a
fst (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> a
fst ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> a
fst (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
0, Int
0, Int
1) -> (a, a) -> a
forall a b. (a, b) -> a
fst (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> b
snd ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> a
fst (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
0, Int
1, Int
0) -> (a, a) -> a
forall a b. (a, b) -> a
fst (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> a
fst ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> b
snd (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
0, Int
1, Int
1) -> (a, a) -> a
forall a b. (a, b) -> a
fst (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> b
snd ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> b
snd (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
1, Int
0, Int
0) -> (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> a
fst ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> a
fst (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
1, Int
0, Int
1) -> (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> b
snd ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> a
fst (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
1, Int
1, Int
0) -> (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> a
fst ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> b
snd (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int
1, Int
1, Int
1) -> (a, a) -> a
forall a b. (a, b) -> b
snd (((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> b
snd ((((a, a), (a, a)), ((a, a), (a, a))) -> ((a, a), (a, a))
forall a b. (a, b) -> b
snd (((a, a), (a, a)), ((a, a), (a, a)))
pg))
(Int, Int, Int)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"christoffel2D: index out of range"
gamma :: Int -> Int -> Int -> a
gamma :: Int -> Int -> Int -> a
gamma Int
c Int
a Int
b =
(a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
forall a. Multiplicative a => a
one))
a -> a -> a
forall a. Multiplicative a => a -> a -> a
* ( (if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) then a
g00 else a
g10)
a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (Int -> Int -> Int -> a
d Int
a Int
0 Int
b a -> a -> a
forall a. Additive a => a -> a -> a
+ Int -> Int -> Int -> a
d Int
b Int
0 Int
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- Int -> Int -> Int -> a
d Int
0 Int
a Int
b)
a -> a -> a
forall a. Additive a => a -> a -> a
+ (if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) then a
g01 else a
g11)
a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (Int -> Int -> Int -> a
d Int
a Int
1 Int
b a -> a -> a
forall a. Additive a => a -> a -> a
+ Int -> Int -> Int -> a
d Int
b Int
1 Int
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- Int -> Int -> Int -> a
d Int
1 Int
a Int
b)
)
in ( Int -> Int -> Int -> a
gamma Int
0 Int
0 Int
0,
Int -> Int -> Int -> a
gamma Int
0 Int
0 Int
1,
Int -> Int -> Int -> a
gamma Int
0 Int
1 Int
0,
Int -> Int -> Int -> a
gamma Int
0 Int
1 Int
1,
Int -> Int -> Int -> a
gamma Int
1 Int
0 Int
0,
Int -> Int -> Int -> a
gamma Int
1 Int
0 Int
1,
Int -> Int -> Int -> a
gamma Int
1 Int
1 Int
0,
Int -> Int -> Int -> a
gamma Int
1 Int
1 Int
1
)
directionalDerivative ::
(Additive a, Multiplicative a) =>
Diff' (a, a) (a, a) ->
(a, a) ->
(a, a) ->
(a, a)
directionalDerivative :: forall a.
(Additive a, Multiplicative a) =>
Diff' (a, a) (a, a) -> (a, a) -> (a, a) -> (a, a)
directionalDerivative Diff' (a, a) (a, a)
v (a, a)
x (a, a)
dx =
let ((a, a)
_, (a, a) -> (a, a)
vt) = Diff' (a, a) (a, a) -> (a, a) -> ((a, a), (a, a) -> (a, a))
forall k (p :: k) a b. Diff p a b -> a -> (b, b -> a)
runDiff Diff' (a, a) (a, a)
v (a, a)
x
vTe0 :: (a, a)
vTe0 = (a, a) -> (a, a)
vt (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis0
vTe1 :: (a, a)
vTe1 = (a, a) -> (a, a)
vt (a, a)
forall a. (Additive a, Multiplicative a) => (a, a)
basis1
in ( (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
dx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
vTe0 a -> a -> a
forall a. Additive a => a -> a -> a
+ (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
dx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
vTe0,
(a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
dx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
vTe1 a -> a -> a
forall a. Additive a => a -> a -> a
+ (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
dx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
vTe1
)
covariantDerivative ::
(Field a) =>
Diff' ((a, a), (a, a)) (a, a) ->
Diff' ((a, a), (a, a)) (a, a) ->
Diff' (a, a) (a, a) ->
(a, a) ->
(a, a) ->
(a, a)
covariantDerivative :: forall a.
Field a =>
Diff' ((a, a), (a, a)) (a, a)
-> Diff' ((a, a), (a, a)) (a, a)
-> Diff' (a, a) (a, a)
-> (a, a)
-> (a, a)
-> (a, a)
covariantDerivative Diff' ((a, a), (a, a)) (a, a)
lower Diff' ((a, a), (a, a)) (a, a)
raise Diff' (a, a) (a, a)
v (a, a)
x (a, a)
dx =
let ((a, a)
vx, (a, a) -> (a, a)
_) = Diff' (a, a) (a, a) -> (a, a) -> ((a, a), (a, a) -> (a, a))
forall k (p :: k) a b. Diff p a b -> a -> (b, b -> a)
runDiff Diff' (a, a) (a, a)
v (a, a)
x
(a
g000, a
g001, a
g010, a
g011, a
g100, a
g101, a
g110, a
g111) = Diff' ((a, a), (a, a)) (a, a)
-> Diff' ((a, a), (a, a)) (a, a)
-> (a, a)
-> (a, a, a, a, a, a, a, a)
forall a.
Field a =>
Diff' ((a, a), (a, a)) (a, a)
-> Diff' ((a, a), (a, a)) (a, a)
-> (a, a)
-> (a, a, a, a, a, a, a, a)
christoffel2D Diff' ((a, a), (a, a)) (a, a)
lower Diff' ((a, a), (a, a)) (a, a)
raise (a, a)
x
dx0 :: a
dx0 = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
dx
dx1 :: a
dx1 = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
dx
v0 :: a
v0 = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
vx
v1 :: a
v1 = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
vx
gamma0 :: a
gamma0 = a
g000 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx0 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v0 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g001 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx0 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v1 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g010 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v0 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g011 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v1
gamma1 :: a
gamma1 = a
g100 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx0 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v0 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g101 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx0 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v1 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g110 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v0 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
g111 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
dx1 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
v1
partial :: (a, a)
partial = Diff' (a, a) (a, a) -> (a, a) -> (a, a) -> (a, a)
forall a.
(Additive a, Multiplicative a) =>
Diff' (a, a) (a, a) -> (a, a) -> (a, a) -> (a, a)
directionalDerivative Diff' (a, a) (a, a)
v (a, a)
x (a, a)
dx
in ((a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
partial a -> a -> a
forall a. Additive a => a -> a -> a
+ a
gamma0, (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
partial a -> a -> a
forall a. Additive a => a -> a -> a
+ a
gamma1)