{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
module Math.VectorSpace.Docile where
import Math.LinearMap.Category.Class
import Math.LinearMap.Category.Instances
import Math.LinearMap.Asserted
import Data.Tree (Tree(..), Forest)
import Data.List (sortBy, foldl', tails)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.Ord (comparing)
import Data.List (maximumBy, unfoldr)
import qualified Data.Vector as Arr
import Data.Foldable (toList)
import Data.List (transpose)
import Data.Semigroup
import Data.VectorSpace
import Data.Basis
import Data.Void
import Prelude ()
import qualified Prelude as Hask
import Data.Kind (Type)
import Control.Category.Constrained.Prelude hiding ((^))
import Control.Arrow.Constrained
import Control.Monad.Trans.State
import Linear ( V0(V0), V1(V1), V2(V2), V3(V3), V4(V4)
, _x, _y, _z, _w, ex, ey, ez, ew )
import qualified Data.Vector.Unboxed as UArr
import Data.VectorSpace.Free
import Math.VectorSpace.ZeroDimensional
import qualified Linear.Matrix as Mat
import qualified Linear.Vector as Mat
import Control.Lens ((^.), Lens', lens, ReifiedLens', ReifiedLens(..))
import Data.Coerce
import Numeric.IEEE
import Data.CallStack
class LinearSpace v => SemiInner v where
dualBasisCandidates :: [(Int,v)] -> Forest (Int, DualVector v)
tensorDualBasisCandidates :: (SemiInner w, Scalar w ~ Scalar v)
=> [(Int, v⊗w)] -> Forest (Int, DualVector (v⊗w))
symTensorDualBasisCandidates
:: [(Int, SymmetricTensor (Scalar v) v)]
-> Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
symTensorTensorDualBasisCandidates :: ∀ w . (SemiInner w, Scalar w ~ Scalar v)
=> [(Int, SymmetricTensor (Scalar v) v ⊗ w)]
-> Forest (Int, SymmetricTensor (Scalar v) v +> DualVector w)
symTensorTensorDualBasisCandidates
= case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w
, forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v ) of
(DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness, ScalarSpaceWitness v
ScalarSpaceWitness)
-> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. LinearFunction s v w -> v -> w
getLinearFunction forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor)
cartesianDualBasisCandidates
:: [DualVector v]
-> (v -> [ℝ])
-> ([(Int,v)] -> Forest (Int, DualVector v))
cartesianDualBasisCandidates :: forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates [DualVector v]
dvs v -> [ℝ]
abss [(Int, v)]
vcas = Int -> Int -> [(Int, ([ℝ], ℝ))] -> [Tree (Int, DualVector v)]
go Int
0 Int
0 [(Int, ([ℝ], ℝ))]
sorted
where sorted :: [(Int, ([ℝ], ℝ))]
sorted = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => a -> a
negate forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
[ (Int
i, ([ℝ]
av, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ℝ]
av)) | (Int
i,v
v)<-[(Int, v)]
vcas, let av :: [ℝ]
av = v -> [ℝ]
abss v
v ]
go :: Int -> Int -> [(Int, ([ℝ], ℝ))] -> [Tree (Int, DualVector v)]
go Int
k Int
nDelay scs :: [(Int, ([ℝ], ℝ))]
scs@((Int
i,([ℝ]
av,ℝ
_)):[(Int, ([ℝ], ℝ))]
scs')
| Int
kforall a. Ord a => a -> a -> Bool
<Int
n = forall a. a -> [Tree a] -> Tree a
Node (Int
i, DualVector v
dv) (Int -> Int -> [(Int, ([ℝ], ℝ))] -> [Tree (Int, DualVector v)]
go (Int
kforall a. Num a => a -> a -> a
+Int
1) Int
0 [(Int
i',(Int -> [ℝ] -> [ℝ]
zeroAt Int
j [ℝ]
av',ℝ
m)) | (Int
i',([ℝ]
av',ℝ
m))<-[(Int, ([ℝ], ℝ))]
scs'])
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, ([ℝ], ℝ))] -> [Tree (Int, DualVector v)]
go Int
k (Int
nDelayforall a. Num a => a -> a -> a
+Int
1) (forall a. Int -> [a] -> [a]
bringToFront (Int
nDelayforall a. Num a => a -> a -> a
+Int
1) [(Int, ([ℝ], ℝ))]
scs)
where (Int
j,ℝ
_) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
jfus [ℝ]
av
dv :: DualVector v
dv = [DualVector v]
dvs forall a. [a] -> Int -> a
!! Int
j
go Int
_ Int
_ [(Int, ([ℝ], ℝ))]
_ = []
jfus :: [Int]
jfus = [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1]
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
dvs
zeroAt :: Int -> [ℝ] -> [ℝ]
zeroAt :: Int -> [ℝ] -> [ℝ]
zeroAt Int
_ [] = []
zeroAt Int
0 (ℝ
_:[ℝ]
l) = (-ℝ
1forall a. Fractional a => a -> a -> a
/ℝ
0)forall a. a -> [a] -> [a]
:[ℝ]
l
zeroAt Int
j (ℝ
e:[ℝ]
l) = ℝ
e forall a. a -> [a] -> [a]
: Int -> [ℝ] -> [ℝ]
zeroAt (Int
jforall a. Num a => a -> a -> a
-Int
1) [ℝ]
l
bringToFront :: Int -> [a] -> [a]
bringToFront :: forall a. Int -> [a] -> [a]
bringToFront Int
i [a]
l = case forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
l of
([a]
_,[]) -> []
([a]
f,a
s:[a]
l') -> a
s forall a. a -> [a] -> [a]
: [a]
fforall a. [a] -> [a] -> [a]
++[a]
l'
instance (Fractional' s, SemiInner s) => SemiInner (ZeroDim s) where
dualBasisCandidates :: [(Int, ZeroDim s)] -> Forest (Int, DualVector (ZeroDim s))
dualBasisCandidates [(Int, ZeroDim s)]
_ = []
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (ZeroDim s)) =>
[(Int, ZeroDim s ⊗ w)] -> Forest (Int, DualVector (ZeroDim s ⊗ w))
tensorDualBasisCandidates [(Int, ZeroDim s ⊗ w)]
_ = []
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (ZeroDim s)) (ZeroDim s))]
-> Forest
(Int,
SymmetricTensor (Scalar (ZeroDim s)) (DualVector (ZeroDim s)))
symTensorDualBasisCandidates [(Int, SymmetricTensor (Scalar (ZeroDim s)) (ZeroDim s))]
_ = []
instance (Fractional' s, SemiInner s) => SemiInner (V0 s) where
dualBasisCandidates :: [(Int, V0 s)] -> Forest (Int, DualVector (V0 s))
dualBasisCandidates [(Int, V0 s)]
_ = []
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (V0 s)) =>
[(Int, V0 s ⊗ w)] -> Forest (Int, DualVector (V0 s ⊗ w))
tensorDualBasisCandidates [(Int, V0 s ⊗ w)]
_ = []
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V0 s)) (V0 s))]
-> Forest
(Int, SymmetricTensor (Scalar (V0 s)) (DualVector (V0 s)))
symTensorDualBasisCandidates [(Int, SymmetricTensor (Scalar (V0 s)) (V0 s))]
_ = []
orthonormaliseDuals :: ∀ v . (SemiInner v, RealFrac' (Scalar v))
=> Scalar v -> [(v, DualVector v)]
-> [(v,Maybe (DualVector v))]
orthonormaliseDuals :: forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals = DualSpaceWitness v
-> Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
od forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where od :: DualSpaceWitness v
-> Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
od DualSpaceWitness v
_ Scalar v
_ [] = []
od (DualSpaceWitness v
DualSpaceWitness :: DualSpaceWitness v) Scalar v
ε ((v
v,DualVector v
v'₀):[(v, DualVector v)]
ws)
| forall a. Num a => a -> a
abs Scalar v
ovl₀ forall a. Ord a => a -> a -> Bool
> Scalar v
0, forall a. Num a => a -> a
abs Scalar v
ovl₁ forall a. Ord a => a -> a -> Bool
> Scalar v
ε
= (v
v,forall a. a -> Maybe a
Just DualVector v
v')
forall a. a -> [a] -> [a]
: [ (v
w, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\DualVector v
w' -> DualVector v
w' forall v. AdditiveGroup v => v -> v -> v
^-^ (DualVector v
w'forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v)forall v. VectorSpace v => Scalar v -> v -> v
*^DualVector v
v') Maybe (DualVector v)
w's)
| (v
w,Maybe (DualVector v)
w's)<-[(v, Maybe (DualVector v))]
wssys ]
| Bool
otherwise = (v
v,forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: [(v, Maybe (DualVector v))]
wssys
where wssys :: [(v, Maybe (DualVector v))]
wssys = forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals Scalar v
ε [(v, DualVector v)]
ws
v'₁ :: DualVector v
v'₁ = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\DualVector v
v'i₀ (v
w,Maybe (DualVector v)
w's)
-> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\DualVector v
v'i DualVector v
w' -> DualVector v
v'i forall v. AdditiveGroup v => v -> v -> v
^-^ (DualVector v
v'iforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
w)forall v. VectorSpace v => Scalar v -> v -> v
*^DualVector v
w') DualVector v
v'i₀ Maybe (DualVector v)
w's)
(DualVector v
v'₀ forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
ovl₀) [(v, Maybe (DualVector v))]
wssys
v' :: DualVector v
v' = DualVector v
v'₁ forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
ovl₁
ovl₀ :: Scalar v
ovl₀ = DualVector v
v'₀forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v
ovl₁ :: Scalar v
ovl₁ = DualVector v
v'₁forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v
dualBasis :: ∀ v . (SemiInner v, RealFrac' (Scalar v))
=> [v] -> [Maybe (DualVector v)]
dualBasis :: forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis [v]
vs = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(v, Maybe (DualVector v))]
result
where zip' :: [(a, a)] -> [(a, b)] -> [(a, b)]
zip' ((a
i,a
v):[(a, a)]
vs) ((a
j,b
v'):[(a, b)]
ds)
| a
iforall a. Ord a => a -> a -> Bool
<a
j = [(a, a)] -> [(a, b)] -> [(a, b)]
zip' [(a, a)]
vs ((a
j,b
v')forall a. a -> [a] -> [a]
:[(a, b)]
ds)
| a
iforall a. Eq a => a -> a -> Bool
==a
j = (a
v,b
v') forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, b)] -> [(a, b)]
zip' [(a, a)]
vs [(a, b)]
ds
zip' [(a, a)]
_ [(a, b)]
_ = []
result :: [(v, Maybe (DualVector v))]
result :: [(v, Maybe (DualVector v))]
result = case Int
-> Int
-> Forest (Int, DualVector v)
-> Either
(Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
findBest Int
n Int
n forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates [(Int, v)]
vsIxed of
Right [(Int, DualVector v)]
bestCandidates
-> forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals forall a. IEEE a => a
epsilon
(forall {a} {a} {b}. Ord a => [(a, a)] -> [(a, b)] -> [(a, b)]
zip' [(Int, v)]
vsIxed forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) [(Int, DualVector v)]
bestCandidates)
Left (Int
_, [(Int, Maybe (DualVector v))]
bestCompromise)
-> let survivors :: [(Int, DualVector v)]
casualties :: [Int]
([Int]
casualties, [(Int, DualVector v)]
survivors)
= forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b c.
(SumToProduct f r t, Object r a, ObjectSum r b c, Object t (f a),
ObjectPair t (f b) (f c)) =>
r a (b + c) -> t (f a) (f b, f c)
mapEither (\case
(Int
i,Maybe (DualVector v)
Nothing) -> forall a b. a -> Either a b
Left Int
i
(Int
i,Just DualVector v
v') -> forall a b. b -> Either a b
Right (Int
i,DualVector v
v')
) [(Int, Maybe (DualVector v))]
bestCompromise
bestEffort :: [(v, Maybe (DualVector v))]
bestEffort = forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals forall a. IEEE a => a
epsilon
[ (Vector v
lookupArr forall a. Vector a -> Int -> a
Arr.! Int
i, DualVector v
v')
| (Int
i,DualVector v
v') <- [(Int, DualVector v)]
survivors ]
in forall a b. (a -> b) -> [a] -> [b]
map forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((,) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) [(Int, DualVector v)]
survivors [(v, Maybe (DualVector v))]
bestEffort
forall a. [a] -> [a] -> [a]
++ [ (Int
i,(Vector v
lookupArr forall a. Vector a -> Int -> a
Arr.! Int
i, forall a. Maybe a
Nothing))
| Int
i <- [Int]
casualties ]
where findBest :: Int
-> Int
-> Forest (Int, DualVector v)
-> Either (Int, [(Int, Maybe (DualVector v))])
[(Int, DualVector v)]
findBest :: Int
-> Int
-> Forest (Int, DualVector v)
-> Either
(Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
findBest Int
0 Int
_ Forest (Int, DualVector v)
_ = forall a b. b -> Either a b
Right []
findBest Int
nMissing Int
_ [] = forall a b. a -> Either a b
Left (Int
nMissing, [])
findBest Int
n Int
maxCompromises (Node (Int
i,DualVector v
v') Forest (Int, DualVector v)
bv' : Forest (Int, DualVector v)
alts)
| Just DualVector v
_ <- Maybe (DualVector v)
guardedv'
, Right [(Int, DualVector v)]
best' <- Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
straightContinue = forall a b. b -> Either a b
Right forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int
i,DualVector v
v') forall a. a -> [a] -> [a]
: [(Int, DualVector v)]
best'
| Int
maxCompromises forall a. Ord a => a -> a -> Bool
> Int
0
, Right [(Int, DualVector v)]
goodAlt <- Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
alternative = forall a b. b -> Either a b
Right [(Int, DualVector v)]
goodAlt
| Bool
otherwise = case Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
straightContinue of
Right [(Int, DualVector v)]
goodOtherwise -> forall a b. a -> Either a b
Left (Int
1, forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(Int, DualVector v)]
goodOtherwise)
Left (Int
nBad, [(Int, Maybe (DualVector v))]
badAnyway)
| Int
maxCompromises forall a. Ord a => a -> a -> Bool
> Int
0
, Left (Int
nBadAlt, [(Int, Maybe (DualVector v))]
badAlt) <- Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
alternative
, Int
nBadAlt forall a. Ord a => a -> a -> Bool
< Int
nBad forall a. Num a => a -> a -> a
+ Int
myBadness
-> forall a b. a -> Either a b
Left (Int
nBadAlt, [(Int, Maybe (DualVector v))]
badAlt)
| Bool
otherwise -> forall a b. a -> Either a b
Left ( Int
nBad forall a. Num a => a -> a -> a
+ Int
myBadness
, (Int
i, Maybe (DualVector v)
guardedv') forall a. a -> [a] -> [a]
: [(Int, Maybe (DualVector v))]
badAnyway )
where guardedv' :: Maybe (DualVector v)
guardedv' = case DualVector v
v'forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^(Vector v
lookupArr forall a. Vector a -> Int -> a
Arr.! Int
i) of
Scalar v
0 -> forall a. Maybe a
Nothing
Scalar v
_ -> forall a. a -> Maybe a
Just DualVector v
v'
myBadness :: Int
myBadness = case Maybe (DualVector v)
guardedv' of
Maybe (DualVector v)
Nothing -> Int
1
Just DualVector v
_ -> Int
0
straightContinue :: Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
straightContinue = Int
-> Int
-> Forest (Int, DualVector v)
-> Either
(Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
findBest (Int
nforall a. Num a => a -> a -> a
-Int
1) (Int
maxCompromisesforall a. Num a => a -> a -> a
-Int
1) Forest (Int, DualVector v)
bv'
alternative :: Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
alternative = Int
-> Int
-> Forest (Int, DualVector v)
-> Either
(Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
findBest Int
n (Int
maxCompromisesforall a. Num a => a -> a -> a
-Int
1) Forest (Int, DualVector v)
alts
vsIxed :: [(Int, v)]
vsIxed = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [v]
vs
lookupArr :: Vector v
lookupArr = forall a. [a] -> Vector a
Arr.fromList [v]
vs
n :: Int
n = forall a. Vector a -> Int
Arr.length Vector v
lookupArr
dualBasis' :: ∀ v . (LinearSpace v, SemiInner (DualVector v), RealFrac' (Scalar v))
=> [DualVector v] -> [Maybe v]
dualBasis' :: forall v.
(LinearSpace v, SemiInner (DualVector v), RealFrac' (Scalar v)) =>
[DualVector v] -> [Maybe v]
dualBasis' = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness v
DualSpaceWitness -> forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis
zipTravWith :: Hask.Traversable t => (a->b->c) -> t a -> [b] -> Maybe (t c)
zipTravWith :: forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith a -> b -> c
f = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse a -> StateT [b] Maybe c
zp
where zp :: a -> StateT [b] Maybe c
zp a
a = do
[b]
bs <- forall (m :: * -> *) s. Monad m => StateT s m s
get
case [b]
bs of
[] -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Maybe a
Nothing
(b
b:[b]
bs') -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
bs' forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
ObjectPair k (m b) (UnitObject k),
ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>> forall (m :: * -> *) a. Monad m (->) => a -> m a
return (a -> b -> c
f a
a b
b)
embedFreeSubspace :: ∀ v t r . (HasCallStack, SemiInner v, RealFrac' (Scalar v), Hask.Traversable t)
=> t v -> Maybe (ReifiedLens' v (t (Scalar v)))
embedFreeSubspace :: forall v (t :: * -> *) r.
(HasCallStack, SemiInner v, RealFrac' (Scalar v), Traversable t) =>
t v -> Maybe (ReifiedLens' v (t (Scalar v)))
embedFreeSubspace t v
vs = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(v -> t (Scalar v)
g,v -> t (Scalar v) -> v
s) -> forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens (forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens v -> t (Scalar v)
g v -> t (Scalar v) -> v
s)) Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
result
where vsList :: [v]
vsList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t v
vs
result :: Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
result = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ([DualVector v] -> v -> t (Scalar v)
genGetforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&[DualVector v] -> v -> t (Scalar v) -> v
genSet) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis [v]
vsList
genGet :: [DualVector v] -> v -> t (Scalar v)
genGet [DualVector v]
vsDuals v
u = case forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith (\v
_v DualVector v
dv -> DualVector v
dvforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
u) t v
vs [DualVector v]
vsDuals of
Just t (Scalar v)
cs -> t (Scalar v)
cs
Maybe (t (Scalar v))
Nothing -> forall a. HasCallStack => [Char] -> a
error forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Char]
"Cannot map into free subspace using a set of "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vsList)
forall a. [a] -> [a] -> [a]
++ [Char]
" vectors and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
vsDuals)
forall a. [a] -> [a] -> [a]
++ [Char]
" dual vectors."
genSet :: [DualVector v] -> v -> t (Scalar v) -> v
genSet [DualVector v]
vsDuals v
u t (Scalar v)
coefs = case forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith (,) t (Scalar v)
coefs forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vsList [DualVector v]
vsDuals of
Just t (Scalar v, (v, DualVector v))
updators -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\v
ur (Scalar v
c,(v
v,DualVector v
v')) -> v
ur forall v. AdditiveGroup v => v -> v -> v
^+^ v
vforall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*(Scalar v
c forall a. Num a => a -> a -> a
- DualVector v
v'forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
ur))
v
u t (Scalar v, (v, DualVector v))
updators
Maybe (t (Scalar v, (v, DualVector v)))
Nothing -> forall a. HasCallStack => [Char] -> a
error forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Char]
"Cannot map from free subspace using a set of "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vsList)
forall a. [a] -> [a] -> [a]
++ [Char]
" vectors, " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
vsDuals)
forall a. [a] -> [a] -> [a]
++ [Char]
" dual vectors and "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length t (Scalar v)
coefs) forall a. [a] -> [a] -> [a]
++ [Char]
" coefficients."
instance SemiInner ℝ where
dualBasisCandidates :: [(Int, ℝ)] -> Forest (Int, DualVector ℝ)
dualBasisCandidates = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((forall a. a -> [Tree a] -> Tree a
`Node`[]) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall a. Fractional a => a -> a
recip)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => a -> a
negate forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Num a => a -> a
abs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(SumToProduct f r t, Object r a, Object r Bool, Object t (f a)) =>
r a Bool -> t (f a) (f a)
filter ((forall a. Eq a => a -> a -> Bool
/=ℝ
0) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar ℝ) =>
[(Int, ℝ ⊗ w)] -> Forest (Int, DualVector (ℝ ⊗ w))
tensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall s v w. Tensor s v w -> TensorProduct v w
getTensorProduct)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar ℝ) ℝ)]
-> Forest (Int, SymmetricTensor (Scalar ℝ) (DualVector ℝ))
symTensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor))
instance (Fractional' s, Ord s, SemiInner s) => SemiInner (V1 s) where
dualBasisCandidates :: [(Int, V1 s)] -> Forest (Int, DualVector (V1 s))
dualBasisCandidates = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((forall a. a -> [Tree a] -> Tree a
`Node`[]) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall a. Fractional a => a -> a
recip)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => a -> a
negate forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Num a => a -> a
abs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(SumToProduct f r t, Object r a, Object r Bool, Object t (f a)) =>
r a Bool -> t (f a) (f a)
filter ((forall a. Eq a => a -> a -> Bool
/=V1 s
0) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (V1 s)) =>
[(Int, V1 s ⊗ w)] -> Forest (Int, DualVector (V1 s ⊗ w))
tensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V1 w
w)) -> w
w)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. a -> V1 a
V1)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V1 s)) (V1 s))]
-> Forest
(Int, SymmetricTensor (Scalar (V1 s)) (DualVector (V1 s)))
symTensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor))
instance SemiInner (V2 ℝ) where
dualBasisCandidates :: [(Int, V2 ℝ)] -> Forest (Int, DualVector (V2 ℝ))
dualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall a. Num a => a -> a
abs)
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (V2 ℝ)) =>
[(Int, V2 ℝ ⊗ w)] -> Forest (Int, DualVector (V2 ℝ ⊗ w))
tensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V2 w
x w
y)) -> (w
x,w
y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \(DualVector w
dx,DualVector w
dy) -> forall a. a -> a -> V2 a
V2 DualVector w
dx DualVector w
dy)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V2 ℝ)) (V2 ℝ))]
-> Forest
(Int, SymmetricTensor (Scalar (V2 ℝ)) (DualVector (V2 ℝ)))
symTensorDualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
(forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. TensorProduct v w -> Tensor s v w
Tensorforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 ℝ
1 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
sqrt¹₂) (forall a. a -> a -> V2 a
V2 ℝ
sqrt¹₂ ℝ
0)
, forall a. a -> a -> V2 a
V2 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
1)])
(\(SymTensor (Tensor (V2 (V2 ℝ
xx ℝ
xy)
(V2 ℝ
yx ℝ
yy))))
-> forall a. Num a => a -> a
abs forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ℝ
xx, (ℝ
xyforall a. Num a => a -> a -> a
+ℝ
yx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, ℝ
yy])
where sqrt¹₂ :: ℝ
sqrt¹₂ = forall a. Floating a => a -> a
sqrt ℝ
0.5
instance SemiInner (V3 ℝ) where
dualBasisCandidates :: [(Int, V3 ℝ)] -> Forest (Int, DualVector (V3 ℝ))
dualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall a. Num a => a -> a
abs)
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (V3 ℝ)) =>
[(Int, V3 ℝ ⊗ w)] -> Forest (Int, DualVector (V3 ℝ ⊗ w))
tensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V3 w
x w
y w
z)) -> (w
x,(w
y,w
z)))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \(DualVector w
dx,(DualVector w
dy,DualVector w
dz)) -> forall a. a -> a -> a -> V3 a
V3 DualVector w
dx DualVector w
dy DualVector w
dz)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V3 ℝ)) (V3 ℝ))]
-> Forest
(Int, SymmetricTensor (Scalar (V3 ℝ)) (DualVector (V3 ℝ)))
symTensorDualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
(forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. TensorProduct v w -> Tensor s v w
Tensorforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ forall a. a -> a -> a -> V3 a
V3 (forall a. a -> a -> a -> V3 a
V3 ℝ
1 ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> V3 a
V3 (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
sqrt¹₂ ℝ
0) (forall a. a -> a -> a -> V3 a
V3 ℝ
sqrt¹₂ ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> V3 a
V3 (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
sqrt¹₂) forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> V3 a
V3 ℝ
sqrt¹₂ ℝ
0 ℝ
0)
, forall a. a -> a -> a -> V3 a
V3 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
1 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> V3 a
V3 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
sqrt¹₂) (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
sqrt¹₂ ℝ
0)
, forall a. a -> a -> a -> V3 a
V3 forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
1)])
(\(SymTensor (Tensor (V3 (V3 ℝ
xx ℝ
xy ℝ
xz)
(V3 ℝ
yx ℝ
yy ℝ
yz)
(V3 ℝ
zx ℝ
zy ℝ
zz))))
-> forall a. Num a => a -> a
abs forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ ℝ
xx, (ℝ
xyforall a. Num a => a -> a -> a
+ℝ
yx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xzforall a. Num a => a -> a -> a
+ℝ
zx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
, ℝ
yy , (ℝ
yzforall a. Num a => a -> a -> a
+ℝ
zy)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
, ℝ
zz ])
where sqrt¹₂ :: ℝ
sqrt¹₂ = forall a. Floating a => a -> a
sqrt ℝ
0.5
instance SemiInner (V4 ℝ) where
dualBasisCandidates :: [(Int, V4 ℝ)] -> Forest (Int, DualVector (V4 ℝ))
dualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall a. Num a => a -> a
abs)
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (V4 ℝ)) =>
[(Int, V4 ℝ ⊗ w)] -> Forest (Int, DualVector (V4 ℝ ⊗ w))
tensorDualBasisCandidates = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V4 w
x w
y w
z w
w)) -> ((w
x,w
y),(w
z,w
w)))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \((DualVector w
dx,DualVector w
dy),(DualVector w
dz,DualVector w
dw)) -> forall a. a -> a -> a -> a -> V4 a
V4 DualVector w
dx DualVector w
dy DualVector w
dz DualVector w
dw)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V4 ℝ)) (V4 ℝ))]
-> Forest
(Int, SymmetricTensor (Scalar (V4 ℝ)) (DualVector (V4 ℝ)))
symTensorDualBasisCandidates = forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
(forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. TensorProduct v w -> Tensor s v w
Tensorforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ forall a. a -> a -> a -> a -> V4 a
V4 (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
1 ℝ
0 ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0) (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0) forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0)
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
1 ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0) (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0)
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
1 ℝ
0) forall v. AdditiveGroup v => v
zeroV
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0)
, forall a. a -> a -> a -> a -> V4 a
V4 forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV (forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
1)])
(\(SymTensor (Tensor (V4 (V4 ℝ
xx ℝ
xy ℝ
xz ℝ
xw)
(V4 ℝ
yx ℝ
yy ℝ
yz ℝ
yw)
(V4 ℝ
zx ℝ
zy ℝ
zz ℝ
zw)
(V4 ℝ
wx ℝ
wy ℝ
wz ℝ
ww))))
-> forall a. Num a => a -> a
abs forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ ℝ
xx, (ℝ
xyforall a. Num a => a -> a -> a
+ℝ
yx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xzforall a. Num a => a -> a -> a
+ℝ
zx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xwforall a. Num a => a -> a -> a
+ℝ
wx)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
, ℝ
yy , (ℝ
yzforall a. Num a => a -> a -> a
+ℝ
zy)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
ywforall a. Num a => a -> a -> a
+ℝ
wy)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
, ℝ
zz , (ℝ
zwforall a. Num a => a -> a -> a
+ℝ
wz)forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
, ℝ
ww ])
where sqrt¹₂ :: ℝ
sqrt¹₂ = forall a. Floating a => a -> a
sqrt ℝ
0.5
infixl 4 ⊗<$>
(⊗<$>) :: ( Num' s
, Object (LinearFunction s) u
, Object (LinearFunction s) v
, Object (LinearFunction s) w )
=> LinearFunction s v w -> Tensor s u v -> Tensor s u w
LinearFunction s v w
f⊗<$> :: forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$>Tensor s u v
t = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap LinearFunction s v w
f forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor s u v
t
instance ∀ u v . ( SemiInner u, SemiInner v, Scalar u ~ Scalar v, Num' (Scalar u) )
=> SemiInner (u,v) where
dualBasisCandidates :: [(Int, (u, v))] -> Forest (Int, DualVector (u, v))
dualBasisCandidates = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(Int
i,(u
u,v
v))->((Int
i,u
u),(Int
i,v
v))) forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. [(a, b)] -> ([a], [b])
unzip
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness,forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness) Bool
False forall a. Monoid a => a
mempty
where combineBaseis :: (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> ( Forest (Int, DualVector u)
, Forest (Int, DualVector v) )
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis :: (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
_ Bool
_ Set Int
_ ([], []) = []
combineBaseis wit :: (DualSpaceWitness u, DualSpaceWitness v)
wit@(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
Bool
False Set Int
forbidden (Node (Int
i,DualVector u
du) Forest (Int, DualVector u)
bu' : Forest (Int, DualVector u)
abu, Forest (Int, DualVector v)
bv)
| Int
iforall a. Ord a => a -> Set a -> Bool
`Set.member`Set Int
forbidden = (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
False Set Int
forbidden (Forest (Int, DualVector u)
abu, Forest (Int, DualVector v)
bv)
| Bool
otherwise
= forall a. a -> [Tree a] -> Tree a
Node (Int
i, (DualVector u
du, forall v. AdditiveGroup v => v
zeroV))
((DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
True (forall a. Ord a => a -> Set a -> Set a
Set.insert Int
i Set Int
forbidden) (Forest (Int, DualVector u)
bu', Forest (Int, DualVector v)
bv))
forall a. a -> [a] -> [a]
: (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
False Set Int
forbidden (Forest (Int, DualVector u)
abu, Forest (Int, DualVector v)
bv)
combineBaseis wit :: (DualSpaceWitness u, DualSpaceWitness v)
wit@(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
Bool
True Set Int
forbidden (Forest (Int, DualVector u)
bu, Node (Int
i,DualVector v
dv) Forest (Int, DualVector v)
bv' : Forest (Int, DualVector v)
abv)
| Int
iforall a. Ord a => a -> Set a -> Bool
`Set.member`Set Int
forbidden = (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
True Set Int
forbidden (Forest (Int, DualVector u)
bu, Forest (Int, DualVector v)
abv)
| Bool
otherwise
= forall a. a -> [Tree a] -> Tree a
Node (Int
i, (forall v. AdditiveGroup v => v
zeroV, DualVector v
dv))
((DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
False (forall a. Ord a => a -> Set a -> Set a
Set.insert Int
i Set Int
forbidden) (Forest (Int, DualVector u)
bu, Forest (Int, DualVector v)
bv'))
forall a. a -> [a] -> [a]
: (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
True Set Int
forbidden (Forest (Int, DualVector u)
bu, Forest (Int, DualVector v)
abv)
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
_ Set Int
forbidden (Forest (Int, DualVector u)
bu, []) = (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
False Set Int
forbidden (Forest (Int, DualVector u)
bu,[])
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
_ Set Int
forbidden ([], Forest (Int, DualVector v)
bv) = (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Bool
True Set Int
forbidden ([],Forest (Int, DualVector v)
bv)
symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (u, v)) (u, v))]
-> Forest
(Int, SymmetricTensor (Scalar (u, v)) (DualVector (u, v)))
symTensorDualBasisCandidates = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(Int
i,SymTensor (Tensor (Tensor (Scalar v) u (u, v)
u_uv, Tensor (Scalar v) v (u, v)
v_uv)))
-> ( (Int
i, forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$> Tensor (Scalar v) u (u, v)
u_uv)
,((Int
i, forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$> Tensor (Scalar v) u (u, v)
u_uv)
, (Int
i, forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$> Tensor (Scalar v) v (u, v)
v_uv))) )
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. [(a, b)] -> ([a], [b])
unzip forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall a b. [(a, b)] -> ([a], [b])
unzip
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness,forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness) (forall a. a -> Maybe a
Just Bool
False) forall a. Monoid a => a
mempty
where combineBaseis :: (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> ( Forest (Int, LinearMap (Scalar u) u (DualVector v))
,(Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))) )
-> Forest (Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis :: (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
_ Maybe Bool
_ Set Int
_ ([], ([],[])) = []
combineBaseis wit :: (DualSpaceWitness u, DualSpaceWitness v)
wit@(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
Maybe Bool
Nothing Set Int
forbidden
(Node (Int
i, LinearMap (Scalar u) u (DualVector v)
duv) Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv' : Forest (Int, LinearMap (Scalar u) u (DualVector v))
abuv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
| Int
iforall a. Ord a => a -> Set a -> Bool
`Set.member`Set Int
forbidden
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit forall a. Maybe a
Nothing Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
abuv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
| Bool
otherwise
= forall a. a -> [Tree a] -> Tree a
Node (Int
i, forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor
( (forall v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$>(forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensorforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$LinearMap (Scalar u) u (DualVector v)
duv)
, (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV)forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$>(forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensorforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensorforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$LinearMap (Scalar u) u (DualVector v)
duv) ) )
((DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
False)
(forall a. Ord a => a -> Set a -> Set a
Set.insert Int
i Set Int
forbidden) (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv', (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv)))
forall a. a -> [a] -> [a]
: (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit forall a. Maybe a
Nothing Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
abuv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit Maybe Bool
Nothing Set Int
forbidden ([], (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
False) Set Int
forbidden ([], (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
combineBaseis wit :: (DualSpaceWitness u, DualSpaceWitness v)
wit@(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
(Just Bool
False) Set Int
forbidden
(Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Node (Int
i,SymTensor Tensor (Scalar u) (DualVector u) (DualVector u)
du) Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu' : Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
abu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
| Int
iforall a. Ord a => a -> Set a -> Bool
`Set.member`Set Int
forbidden
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
False) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
abu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
| Bool
otherwise
= forall a. a -> [Tree a] -> Tree a
Node (Int
i, forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor ((forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV)forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$> Tensor (Scalar u) (DualVector u) (DualVector u)
du, forall v. AdditiveGroup v => v
zeroV))
((DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
True)
(forall a. Ord a => a -> Set a -> Set a
Set.insert Int
i Set Int
forbidden) (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu', Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv)))
forall a. a -> [a] -> [a]
: (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
False) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
abu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (Just Bool
False) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, ([], Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
True) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, ([], Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv))
combineBaseis wit :: (DualSpaceWitness u, DualSpaceWitness v)
wit@(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
(Just Bool
True) Set Int
forbidden
(Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Node (Int
i,SymTensor Tensor (Scalar v) (DualVector v) (DualVector v)
dv) Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv' : Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
abv))
| Int
iforall a. Ord a => a -> Set a -> Bool
`Set.member`Set Int
forbidden
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
True) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
abv))
| Bool
otherwise
= forall a. a -> [Tree a] -> Tree a
Node (Int
i, forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor (forall v. AdditiveGroup v => v
zeroV, (forall v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)forall s u v w.
(Num' s, Object (LinearFunction s) u, Object (LinearFunction s) v,
Object (LinearFunction s) w) =>
LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$> Tensor (Scalar v) (DualVector v) (DualVector v)
dv))
((DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit forall a. Maybe a
Nothing
(forall a. Ord a => a -> Set a -> Set a
Set.insert Int
i Set Int
forbidden) (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
bv')))
forall a. a -> [a] -> [a]
: (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (forall a. a -> Maybe a
Just Bool
True) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
abv))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit (Just Bool
True) Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, []))
= (DualSpaceWitness u, DualSpaceWitness v)
-> Maybe Bool
-> Set Int
-> (Forest (Int, LinearMap (Scalar u) u (DualVector v)),
(Forest (Int, SymmetricTensor (Scalar u) (DualVector u)),
Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> Forest
(Int, SymmetricTensor (Scalar u) (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u, DualSpaceWitness v)
wit forall a. Maybe a
Nothing Set Int
forbidden (Forest (Int, LinearMap (Scalar u) u (DualVector v))
buv, (Forest (Int, SymmetricTensor (Scalar u) (DualVector u))
bu, []))
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (u, v)) =>
[(Int, (u, v) ⊗ w)] -> Forest (Int, DualVector ((u, v) ⊗ w))
tensorDualBasisCandidates = case forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness u of
ScalarSpaceWitness u
ScalarSpaceWitness -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (Tensor (Scalar v) u w
tu, Tensor (Scalar v) v w
tv)) -> (Tensor (Scalar v) u w
tu, Tensor (Scalar v) v w
tv))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct (DualVector u) (DualVector w)
lu, LinearMap TensorProduct (DualVector v) (DualVector w)
lv)
-> forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector u) (DualVector w)
lu, forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector v) (DualVector w)
lv) )
instance ∀ s u v . ( SemiInner u, SemiInner v, Scalar u ~ s, Scalar v ~ s )
=> SemiInner (Tensor s u v) where
dualBasisCandidates :: [(Int, Tensor s u v)] -> Forest (Int, DualVector (Tensor s u v))
dualBasisCandidates = forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
tensorDualBasisCandidates :: ∀ w
. (SemiInner w, Scalar w ~ s)
=> [(Int, Tensor s (Tensor s u v) w)]
-> Forest (Int, LinearMap s (Tensor s u v) (DualVector w))
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ s) =>
[(Int, Tensor s (Tensor s u v) w)]
-> Forest (Int, LinearMap s (Tensor s u v) (DualVector w))
tensorDualBasisCandidates = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @w of
DualSpaceWitness w
DualSpaceWitness -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap)
instance ∀ s v . ( Num' s, SemiInner v, Scalar v ~ s )
=> SemiInner (SymmetricTensor s v) where
dualBasisCandidates :: [(Int, SymmetricTensor s v)]
-> Forest (Int, DualVector (SymmetricTensor s v))
dualBasisCandidates = forall v.
SemiInner v =>
[(Int, SymmetricTensor (Scalar v) v)]
-> Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
symTensorDualBasisCandidates
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (SymmetricTensor s v)) =>
[(Int, SymmetricTensor s v ⊗ w)]
-> Forest (Int, DualVector (SymmetricTensor s v ⊗ w))
tensorDualBasisCandidates = forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, SymmetricTensor (Scalar v) v ⊗ w)]
-> Forest (Int, SymmetricTensor (Scalar v) v +> DualVector w)
symTensorTensorDualBasisCandidates
symTensorTensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ Scalar (SymmetricTensor s v)) =>
[(Int,
SymmetricTensor
(Scalar (SymmetricTensor s v)) (SymmetricTensor s v)
⊗ w)]
-> Forest
(Int,
SymmetricTensor
(Scalar (SymmetricTensor s v)) (SymmetricTensor s v)
+> DualVector w)
symTensorTensorDualBasisCandidates = case () of {}
instance ∀ s u v . ( LinearSpace u, SemiInner (DualVector u), SemiInner v
, Scalar u ~ s, Scalar v ~ s )
=> SemiInner (LinearMap s u v) where
dualBasisCandidates :: [(Int, LinearMap s u v)]
-> Forest (Int, DualVector (LinearMap s u v))
dualBasisCandidates = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u of
DualSpaceWitness u
DualSpaceWitness -> (coerce :: forall a b. Coercible a b => a -> b
coerce :: [(Int, LinearMap s u v)]
-> [(Int, Tensor s (DualVector u) v)])
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> coerce :: forall a b. Coercible a b => a -> b
coerce
tensorDualBasisCandidates :: ∀ w
. (SemiInner w, Scalar w ~ s)
=> [(Int, Tensor s (LinearMap s u v) w)]
-> Forest (Int, LinearMap s (LinearMap s u v) (DualVector w))
tensorDualBasisCandidates :: forall w.
(SemiInner w, Scalar w ~ s) =>
[(Int, Tensor s (LinearMap s u v) w)]
-> Forest (Int, LinearMap s (LinearMap s u v) (DualVector w))
tensorDualBasisCandidates = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @w of
DualSpaceWitness w
DualSpaceWitness -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
hasteLinearMap)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s,
TensorSpace w, Scalar w ~ s) =>
VSCCoercion
s (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
coUncurryLinearMap)
(^/^) :: (InnerSpace v, Eq (Scalar v), Fractional (Scalar v)) => v -> v -> Scalar v
v
v^/^ :: forall v.
(InnerSpace v, Eq (Scalar v), Fractional (Scalar v)) =>
v -> v -> Scalar v
^/^v
w = case (v
vforall v. InnerSpace v => v -> v -> Scalar v
<.>v
w) of
Scalar v
0 -> Scalar v
0
Scalar v
vw -> Scalar v
vw forall a. Fractional a => a -> a -> a
/ (v
wforall v. InnerSpace v => v -> v -> Scalar v
<.>v
w)
type DList x = [x]->[x]
data DualFinitenessWitness v where
DualFinitenessWitness
:: FiniteDimensional (DualVector v)
=> DualSpaceWitness v -> DualFinitenessWitness v
class (LSpace v, Eq v) => FiniteDimensional v where
data SubBasis v :: Type
entireBasis :: SubBasis v
enumerateSubBasis :: SubBasis v -> [v]
subbasisDimension :: SubBasis v -> Int
subbasisDimension = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis
decomposeLinMap :: (LSpace w, Scalar w ~ Scalar v) => (v+>w) -> (SubBasis v, DList w)
decomposeLinMapWithin :: (LSpace w, Scalar w ~ Scalar v)
=> SubBasis v -> (v+>w) -> Either (SubBasis v, DList w) (DList w)
recomposeSB :: SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSBTensor :: (FiniteDimensional w, Scalar w ~ Scalar v)
=> SubBasis v -> SubBasis w -> [Scalar v] -> (v⊗w, [Scalar v])
recomposeLinMap :: (LSpace w, Scalar w~Scalar v) => SubBasis v -> [w] -> (v+>w, [w])
recomposeContraLinMap :: (LinearSpace w, Scalar w ~ Scalar v, Hask.Functor f)
=> (f (Scalar w) -> w) -> f (DualVector v) -> v+>w
recomposeContraLinMapTensor
:: ( FiniteDimensional u, LinearSpace w
, Scalar u ~ Scalar v, Scalar w ~ Scalar v, Hask.Functor f )
=> (f (Scalar w) -> w) -> f (v+>DualVector u) -> (v⊗u)+>w
uncanonicallyFromDual :: DualVector v -+> v
uncanonicallyToDual :: v -+> DualVector v
tensorEquality :: (TensorSpace w, Eq w, Scalar w ~ Scalar v) => v⊗w -> v⊗w -> Bool
dualFinitenessWitness :: DualFinitenessWitness v
default dualFinitenessWitness :: FiniteDimensional (DualVector v)
=> DualFinitenessWitness v
dualFinitenessWitness = forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @v)
instance ( FiniteDimensional u, TensorSpace v
, Scalar u~s, Scalar v~s
, Eq u, Eq v ) => Eq (Tensor s u v) where
== :: Tensor s u v -> Tensor s u v -> Bool
(==) = forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality
instance ∀ s u v . ( FiniteDimensional u
, TensorSpace v
, Scalar u~s, Scalar v~s
, Eq v )
=> Eq (LinearMap s u v) where
LinearMap TensorProduct (DualVector u) v
f == :: LinearMap s u v -> LinearMap s u v -> Bool
== LinearMap TensorProduct (DualVector u) v
g = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u of
DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
-> (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector u) v
f :: Tensor s (DualVector u) v) forall a. Eq a => a -> a -> Bool
== forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector u) v
g
instance ∀ s u v . ( FiniteDimensional u
, TensorSpace v
, Scalar u~s, Scalar v~s
, Eq v )
=> Eq (LinearFunction s u v) where
LinearFunction s u v
f == :: LinearFunction s u v -> LinearFunction s u v -> Bool
== LinearFunction s u v
g = (forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunctionforall s v w. LinearFunction s v w -> v -> w
-+$>LinearFunction s u v
f) forall a. Eq a => a -> a -> Bool
== (forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunctionforall s v w. LinearFunction s v w -> v -> w
-+$>LinearFunction s u v
g)
instance (Num' s) => FiniteDimensional (ZeroDim s) where
data SubBasis (ZeroDim s) = ZeroBasis
entireBasis :: SubBasis (ZeroDim s)
entireBasis = forall s. SubBasis (ZeroDim s)
ZeroBasis
enumerateSubBasis :: SubBasis (ZeroDim s) -> [ZeroDim s]
enumerateSubBasis SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis = []
subbasisDimension :: SubBasis (ZeroDim s) -> Int
subbasisDimension SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis = Int
0
recomposeSB :: SubBasis (ZeroDim s)
-> [Scalar (ZeroDim s)] -> (ZeroDim s, [Scalar (ZeroDim s)])
recomposeSB SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis [Scalar (ZeroDim s)]
l = (forall s. ZeroDim s
Origin, [Scalar (ZeroDim s)]
l)
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (ZeroDim s)) =>
SubBasis (ZeroDim s)
-> SubBasis w
-> [Scalar (ZeroDim s)]
-> (ZeroDim s ⊗ w, [Scalar (ZeroDim s)])
recomposeSBTensor SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis SubBasis w
_ [Scalar (ZeroDim s)]
l = (forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall s. ZeroDim s
Origin, [Scalar (ZeroDim s)]
l)
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (ZeroDim s)) =>
SubBasis (ZeroDim s) -> [w] -> (ZeroDim s +> w, [w])
recomposeLinMap SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis [w]
l = (forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall s. ZeroDim s
Origin, [w]
l)
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (ZeroDim s)) =>
(ZeroDim s +> w) -> (SubBasis (ZeroDim s), DList w)
decomposeLinMap ZeroDim s +> w
_ = (forall s. SubBasis (ZeroDim s)
ZeroBasis, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar (ZeroDim s)) =>
SubBasis (ZeroDim s)
-> (ZeroDim s +> w)
-> Either (SubBasis (ZeroDim s), DList w) (DList w)
decomposeLinMapWithin SubBasis (ZeroDim s)
R:SubBasisZeroDim s
ZeroBasis ZeroDim s +> w
_ = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (ZeroDim s), Functor f) =>
(f (Scalar w) -> w) -> f (DualVector (ZeroDim s)) -> ZeroDim s +> w
recomposeContraLinMap f (Scalar w) -> w
_ f (DualVector (ZeroDim s))
_ = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall s. ZeroDim s
Origin
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w, Scalar u ~ Scalar (ZeroDim s),
Scalar w ~ Scalar (ZeroDim s), Functor f) =>
(f (Scalar w) -> w)
-> f (ZeroDim s +> DualVector u) -> (ZeroDim s ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
_ f (ZeroDim s +> DualVector u)
_ = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall s. ZeroDim s
Origin
uncanonicallyFromDual :: DualVector (ZeroDim s) -+> ZeroDim s
uncanonicallyFromDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
uncanonicallyToDual :: ZeroDim s -+> DualVector (ZeroDim s)
uncanonicallyToDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar (ZeroDim s)) =>
(ZeroDim s ⊗ w) -> (ZeroDim s ⊗ w) -> Bool
tensorEquality (Tensor ZeroDim s
TensorProduct (ZeroDim s) w
Origin) (Tensor ZeroDim s
TensorProduct (ZeroDim s) w
Origin) = Bool
True
instance (Num' s, Eq s, LinearSpace s) => FiniteDimensional (V0 s) where
data SubBasis (V0 s) = V0Basis
entireBasis :: SubBasis (V0 s)
entireBasis = forall s. SubBasis (V0 s)
V0Basis
enumerateSubBasis :: SubBasis (V0 s) -> [V0 s]
enumerateSubBasis SubBasis (V0 s)
R:SubBasisV0 s
V0Basis = []
subbasisDimension :: SubBasis (V0 s) -> Int
subbasisDimension SubBasis (V0 s)
R:SubBasisV0 s
V0Basis = Int
0
recomposeSB :: SubBasis (V0 s) -> [Scalar (V0 s)] -> (V0 s, [Scalar (V0 s)])
recomposeSB SubBasis (V0 s)
R:SubBasisV0 s
V0Basis [Scalar (V0 s)]
l = (forall a. V0 a
V0, [Scalar (V0 s)]
l)
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (V0 s)) =>
SubBasis (V0 s)
-> SubBasis w -> [Scalar (V0 s)] -> (V0 s ⊗ w, [Scalar (V0 s)])
recomposeSBTensor SubBasis (V0 s)
R:SubBasisV0 s
V0Basis SubBasis w
_ [Scalar (V0 s)]
l = (forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall a. V0 a
V0, [Scalar (V0 s)]
l)
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (V0 s)) =>
SubBasis (V0 s) -> [w] -> (V0 s +> w, [w])
recomposeLinMap SubBasis (V0 s)
R:SubBasisV0 s
V0Basis [w]
l = (forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall a. V0 a
V0, [w]
l)
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (V0 s)) =>
(V0 s +> w) -> (SubBasis (V0 s), DList w)
decomposeLinMap V0 s +> w
_ = (forall s. SubBasis (V0 s)
V0Basis, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar (V0 s)) =>
SubBasis (V0 s)
-> (V0 s +> w) -> Either (SubBasis (V0 s), DList w) (DList w)
decomposeLinMapWithin SubBasis (V0 s)
R:SubBasisV0 s
V0Basis V0 s +> w
_ = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (V0 s), Functor f) =>
(f (Scalar w) -> w) -> f (DualVector (V0 s)) -> V0 s +> w
recomposeContraLinMap f (Scalar w) -> w
_ f (DualVector (V0 s))
_ = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall a. V0 a
V0
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w, Scalar u ~ Scalar (V0 s),
Scalar w ~ Scalar (V0 s), Functor f) =>
(f (Scalar w) -> w) -> f (V0 s +> DualVector u) -> (V0 s ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
_ f (V0 s +> DualVector u)
_ = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall a. V0 a
V0
uncanonicallyFromDual :: DualVector (V0 s) -+> V0 s
uncanonicallyFromDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
uncanonicallyToDual :: V0 s -+> DualVector (V0 s)
uncanonicallyToDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar (V0 s)) =>
(V0 s ⊗ w) -> (V0 s ⊗ w) -> Bool
tensorEquality (Tensor V0 w
TensorProduct (V0 s) w
V0) (Tensor V0 w
TensorProduct (V0 s) w
V0) = Bool
True
instance FiniteDimensional ℝ where
data SubBasis ℝ = RealsBasis
entireBasis :: SubBasis ℝ
entireBasis = SubBasis ℝ
RealsBasis
enumerateSubBasis :: SubBasis ℝ -> [ℝ]
enumerateSubBasis SubBasis ℝ
R:SubBasisDouble
RealsBasis = [ℝ
1]
subbasisDimension :: SubBasis ℝ -> Int
subbasisDimension SubBasis ℝ
R:SubBasisDouble
RealsBasis = Int
1
recomposeSB :: SubBasis ℝ -> [Scalar ℝ] -> (ℝ, [Scalar ℝ])
recomposeSB SubBasis ℝ
R:SubBasisDouble
RealsBasis [] = (ℝ
0, [])
recomposeSB SubBasis ℝ
R:SubBasisDouble
RealsBasis (Scalar ℝ
μ:[Scalar ℝ]
cs) = (Scalar ℝ
μ, [Scalar ℝ]
cs)
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar ℝ) =>
SubBasis ℝ -> SubBasis w -> [Scalar ℝ] -> (ℝ ⊗ w, [Scalar ℝ])
recomposeSBTensor SubBasis ℝ
R:SubBasisDouble
RealsBasis SubBasis w
bw = forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
bw
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar ℝ) =>
SubBasis ℝ -> [w] -> (ℝ +> w, [w])
recomposeLinMap SubBasis ℝ
R:SubBasisDouble
RealsBasis (w
w:[w]
ws) = (forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap w
w, [w]
ws)
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar ℝ) =>
(ℝ +> w) -> (SubBasis ℝ, DList w)
decomposeLinMap (LinearMap TensorProduct (DualVector ℝ) w
v) = (SubBasis ℝ
RealsBasis, (TensorProduct (DualVector ℝ) w
vforall a. a -> [a] -> [a]
:))
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar ℝ) =>
SubBasis ℝ -> (ℝ +> w) -> Either (SubBasis ℝ, DList w) (DList w)
decomposeLinMapWithin SubBasis ℝ
R:SubBasisDouble
RealsBasis (LinearMap TensorProduct (DualVector ℝ) w
v) = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (TensorProduct (DualVector ℝ) w
vforall a. a -> [a] -> [a]
:)
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar ℝ, Functor f) =>
(f (Scalar w) -> w) -> f (DualVector ℝ) -> ℝ +> w
recomposeContraLinMap f (Scalar w) -> w
fw = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. f (Scalar w) -> w
fw
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w, Scalar u ~ Scalar ℝ,
Scalar w ~ Scalar ℝ, Functor f) =>
(f (Scalar w) -> w) -> f (ℝ +> DualVector u) -> (ℝ ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw = forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap f (Scalar w) -> w
fw forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall s v w. LinearMap s v w -> TensorProduct (DualVector v) w
getLinearMap
uncanonicallyFromDual :: DualVector ℝ -+> ℝ
uncanonicallyFromDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
uncanonicallyToDual :: ℝ -+> DualVector ℝ
uncanonicallyToDual = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar ℝ) =>
(ℝ ⊗ w) -> (ℝ ⊗ w) -> Bool
tensorEquality (Tensor TensorProduct ℝ w
v) (Tensor TensorProduct ℝ w
w) = TensorProduct ℝ w
vforall a. Eq a => a -> a -> Bool
==TensorProduct ℝ w
w
#define FreeFiniteDimensional(V, VB, dimens, take, give) \
instance (Num' s, Eq s, LSpace s) \
=> FiniteDimensional (V s) where { \
data SubBasis (V s) = VB deriving (Show); \
entireBasis = VB; \
enumerateSubBasis VB = toList $ Mat.identity; \
subbasisDimension VB = dimens; \
uncanonicallyFromDual = id; \
uncanonicallyToDual = id; \
recomposeSB _ (take:cs) = (give, cs); \
recomposeSB b cs = recomposeSB b $ cs ++ [0]; \
recomposeSBTensor VB bw cs = case recomposeMultiple bw dimens cs of \
{(take:[], cs') -> (Tensor (give), cs')}; \
recomposeLinMap VB (take:ws') = (LinearMap (give), ws'); \
decomposeLinMap (LinearMap m) = (VB, (toList m ++)); \
decomposeLinMapWithin VB (LinearMap m) = pure (toList m ++); \
recomposeContraLinMap fw mv \
= LinearMap $ (\v -> fw $ fmap (<.>^v) mv) <$> Mat.identity; \
recomposeContraLinMapTensor = rclmt dualSpaceWitness \
where {rclmt :: ∀ u w f . ( FiniteDimensional u, LinearSpace w \
, Scalar u ~ s, Scalar w ~ s, Hask.Functor f ) => DualSpaceWitness u \
-> (f (Scalar w) -> w) -> f (V s+>DualVector u) -> (V s⊗u)+>w \
; rclmt DualSpaceWitness fw mv = LinearMap $ \
(\v -> fromLinearMap $ recomposeContraLinMap fw \
$ fmap (\(LinearMap q) -> foldl' (^+^) zeroV $ liftA2 (*^) v q) mv) \
<$> Mat.identity }; \
tensorEquality (Tensor s) (Tensor t) = s==t }
FreeFiniteDimensional(V1, V1Basis, 1, c₀ , V1 c₀ )
FreeFiniteDimensional(V2, V2Basis, 2, c₀:c₁ , V2 c₀ c₁ )
FreeFiniteDimensional(V3, V3Basis, 3, c₀:c₁:c₂ , V3 c₀ c₁ c₂ )
FreeFiniteDimensional(V4, V4Basis, 4, c₀:c₁:c₂:c₃, V4 c₀ c₁ c₂ c₃)
recomposeMultiple :: FiniteDimensional w
=> SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
recomposeMultiple :: forall w.
FiniteDimensional w =>
SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
recomposeMultiple SubBasis w
bw Int
n [Scalar w]
dc
| Int
nforall a. Ord a => a -> a -> Bool
<Int
1 = ([], [Scalar w]
dc)
| Bool
otherwise = case forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
bw [Scalar w]
dc of
(w
w, [Scalar w]
dc') -> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (w
wforall a. a -> [a] -> [a]
:) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall w.
FiniteDimensional w =>
SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
recomposeMultiple SubBasis w
bw (Int
nforall a. Num a => a -> a -> a
-Int
1) [Scalar w]
dc'
deriving instance Show (SubBasis ℝ)
instance ∀ u v . ( FiniteDimensional u, FiniteDimensional v
, Scalar u ~ Scalar v )
=> FiniteDimensional (u,v) where
data SubBasis (u,v) = TupleBasis !(SubBasis u) !(SubBasis v)
entireBasis :: SubBasis (u, v)
entireBasis = forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis forall v. FiniteDimensional v => SubBasis v
entireBasis forall v. FiniteDimensional v => SubBasis v
entireBasis
enumerateSubBasis :: SubBasis (u, v) -> [(u, v)]
enumerateSubBasis (TupleBasis SubBasis u
bu SubBasis v
bv)
= ((,forall v. AdditiveGroup v => v
zeroV)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis u
bu) forall a. [a] -> [a] -> [a]
++ ((forall v. AdditiveGroup v => v
zeroV,)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
bv)
subbasisDimension :: SubBasis (u, v) -> Int
subbasisDimension (TupleBasis SubBasis u
bu SubBasis v
bv) = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu forall a. Num a => a -> a -> a
+ forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (u, v)) =>
((u, v) +> w) -> (SubBasis (u, v), DList w)
decomposeLinMap = forall w.
(LinearSpace w, Scalar w ~ Scalar u) =>
DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> ((u, v) +> w)
-> (SubBasis (u, v), DList w)
dclm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where dclm :: ∀ w . (LinearSpace w, Scalar w ~ Scalar u)
=> DualSpaceWitness u -> DualSpaceWitness v -> DualSpaceWitness w
-> ((u,v)+>w) -> (SubBasis (u,v), DList w)
dclm :: forall w.
(LinearSpace w, Scalar w ~ Scalar u) =>
DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> ((u, v) +> w)
-> (SubBasis (u, v), DList w)
dclm DualSpaceWitness u
DualSpaceWitness DualSpaceWitness v
DualSpaceWitness DualSpaceWitness w
DualSpaceWitness (LinearMap (Tensor (Scalar v) (DualVector u) w
fu, Tensor (Scalar v) (DualVector v) w
fv))
= case (forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector u) w
fu), forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector v) w
fv)) of
((SubBasis u
bu, DList w
du), (SubBasis v
bv, DList w
dv)) -> (forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu SubBasis v
bv, DList w
du forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. DList w
dv)
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar (u, v)) =>
SubBasis (u, v)
-> ((u, v) +> w) -> Either (SubBasis (u, v), DList w) (DList w)
decomposeLinMapWithin = forall w.
(LinearSpace w, Scalar w ~ Scalar u) =>
DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> SubBasis (u, v)
-> ((u, v) +> w)
-> Either (SubBasis (u, v), DList w) (DList w)
dclm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where dclm :: ∀ w . (LinearSpace w, Scalar w ~ Scalar u)
=> DualSpaceWitness u -> DualSpaceWitness v -> DualSpaceWitness w
-> SubBasis (u,v) -> ((u,v)+>w)
-> Either (SubBasis (u,v), DList w) (DList w)
dclm :: forall w.
(LinearSpace w, Scalar w ~ Scalar u) =>
DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> SubBasis (u, v)
-> ((u, v) +> w)
-> Either (SubBasis (u, v), DList w) (DList w)
dclm DualSpaceWitness u
DualSpaceWitness DualSpaceWitness v
DualSpaceWitness DualSpaceWitness w
DualSpaceWitness
(TupleBasis SubBasis u
bu SubBasis v
bv) (LinearMap (Tensor (Scalar v) (DualVector u) w
fu, Tensor (Scalar v) (DualVector v) w
fv))
= case ( forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis u
bu (forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector u) w
fu)
, forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis v
bv (forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector v) w
fv) ) of
(Left (SubBasis u
bu', [w] -> [w]
du), Left (SubBasis v
bv', [w] -> [w]
dv)) -> forall a b. a -> Either a b
Left (forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu' SubBasis v
bv', [w] -> [w]
du forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
dv)
(Left (SubBasis u
bu', [w] -> [w]
du), Right [w] -> [w]
dv) -> forall a b. a -> Either a b
Left (forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu' SubBasis v
bv, [w] -> [w]
du forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
dv)
(Right [w] -> [w]
du, Left (SubBasis v
bv', [w] -> [w]
dv)) -> forall a b. a -> Either a b
Left (forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu SubBasis v
bv', [w] -> [w]
du forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
dv)
(Right [w] -> [w]
du, Right [w] -> [w]
dv) -> forall a b. b -> Either a b
Right forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [w] -> [w]
du forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
dv
recomposeSB :: SubBasis (u, v) -> [Scalar (u, v)] -> ((u, v), [Scalar (u, v)])
recomposeSB (TupleBasis SubBasis u
bu SubBasis v
bv) [Scalar (u, v)]
coefs = case forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
bu [Scalar (u, v)]
coefs of
(u
u, [Scalar u]
coefs') -> case forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis v
bv [Scalar u]
coefs' of
(v
v, [Scalar v]
coefs'') -> ((u
u,v
v), [Scalar v]
coefs'')
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (u, v)) =>
SubBasis (u, v)
-> SubBasis w -> [Scalar (u, v)] -> ((u, v) ⊗ w, [Scalar (u, v)])
recomposeSBTensor (TupleBasis SubBasis u
bu SubBasis v
bv) SubBasis w
bw [Scalar (u, v)]
cs = case forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor SubBasis u
bu SubBasis w
bw [Scalar (u, v)]
cs of
(u ⊗ w
tuw, [Scalar u]
cs') -> case forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor SubBasis v
bv SubBasis w
bw [Scalar u]
cs' of
(v ⊗ w
tvw, [Scalar v]
cs'') -> (forall s v w. TensorProduct v w -> Tensor s v w
Tensor (u ⊗ w
tuw, v ⊗ w
tvw), [Scalar v]
cs'')
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (u, v)) =>
SubBasis (u, v) -> [w] -> ((u, v) +> w, [w])
recomposeLinMap (TupleBasis SubBasis u
bu SubBasis v
bv) [w]
ws = case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis u
bu [w]
ws of
(u +> w
lmu, [w]
ws') -> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (u +> w
lmuforall u w v. (u +> w) -> (v +> w) -> (u, v) +> w
⊕) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv [w]
ws'
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (u, v), Functor f) =>
(f (Scalar w) -> w) -> f (DualVector (u, v)) -> (u, v) +> w
recomposeContraLinMap f (Scalar w) -> w
fw f (DualVector (u, v))
dds
= forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap f (Scalar w) -> w
fw (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fstforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>f (DualVector (u, v))
dds)
forall u w v. (u +> w) -> (v +> w) -> (u, v) +> w
⊕ forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap f (Scalar w) -> w
fw (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>f (DualVector (u, v))
dds)
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w, Scalar u ~ Scalar (u, v),
Scalar w ~ Scalar (u, v), Functor f) =>
(f (Scalar w) -> w)
-> f ((u, v) +> DualVector u) -> ((u, v) ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw f ((u, v) +> DualVector u)
dds = case ( forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(ScalarSpaceWitness u
ScalarSpaceWitness,DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness) -> forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap ( forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw
(forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(LinearMap(Tensor TensorProduct (DualVector u) (DualVector u)
tu,Tensor (Scalar v) (DualVector v) (DualVector u)
_))->forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector u) (DualVector u)
tu) f ((u, v) +> DualVector u)
dds)
, forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw
(forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(LinearMap(Tensor (Scalar v) (DualVector u) (DualVector u)
_,Tensor TensorProduct (DualVector v) (DualVector u)
tv))->forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector v) (DualVector u)
tv) f ((u, v) +> DualVector u)
dds) )
uncanonicallyFromDual :: DualVector (u, v) -+> (u, v)
uncanonicallyFromDual = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
-> forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual
uncanonicallyToDual :: (u, v) -+> DualVector (u, v)
uncanonicallyToDual = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
-> forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar (u, v)) =>
((u, v) ⊗ w) -> ((u, v) ⊗ w) -> Bool
tensorEquality (Tensor (Tensor (Scalar v) u w
s₀,Tensor (Scalar v) v w
s₁)) (Tensor (Tensor (Scalar v) u w
t₀,Tensor (Scalar v) v w
t₁))
= forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality Tensor (Scalar v) u w
s₀ Tensor (Scalar v) u w
t₀ Bool -> Bool -> Bool
&& forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality Tensor (Scalar v) v w
s₁ Tensor (Scalar v) v w
t₁
dualFinitenessWitness :: DualFinitenessWitness (u, v)
dualFinitenessWitness = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
, forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
, DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
-> forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
DualVector (DualVector v) ~ v,
StaticDimension (DualVector v) ~ StaticDimension v) =>
DualSpaceWitness v
DualSpaceWitness
deriving instance (Show (SubBasis u), Show (SubBasis v))
=> Show (SubBasis (u,v))
instance ∀ s u v .
( FiniteDimensional u, FiniteDimensional v
, Scalar u~s, Scalar v~s, Scalar (DualVector u)~s, Scalar (DualVector v)~s
, Fractional' (Scalar v) )
=> FiniteDimensional (Tensor s u v) where
data SubBasis (Tensor s u v) = TensorBasis !(SubBasis u) !(SubBasis v)
entireBasis :: SubBasis (Tensor s u v)
entireBasis = forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis forall v. FiniteDimensional v => SubBasis v
entireBasis forall v. FiniteDimensional v => SubBasis v
entireBasis
enumerateSubBasis :: SubBasis (Tensor s u v) -> [Tensor s u v]
enumerateSubBasis (TensorBasis SubBasis u
bu SubBasis v
bv)
= [ u
uforall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗v
v | u
u <- forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis u
bu, v
v <- forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
bv ]
subbasisDimension :: SubBasis (Tensor s u v) -> Int
subbasisDimension (TensorBasis SubBasis u
bu SubBasis v
bv) = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu forall a. Num a => a -> a -> a
* forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (Tensor s u v)) =>
(Tensor s u v +> w) -> (SubBasis (Tensor s u v), DList w)
decomposeLinMap = forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w -> ((u ⊗ v) +> w) -> (SubBasis (u ⊗ v), DList w)
dlm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where dlm :: ∀ w . (LSpace w, Scalar w ~ Scalar v)
=> DualSpaceWitness w -> ((u⊗v)+>w) -> (SubBasis (u⊗v), DList w)
dlm :: forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w -> ((u ⊗ v) +> w) -> (SubBasis (u ⊗ v), DList w)
dlm DualSpaceWitness w
DualSpaceWitness (u ⊗ v) +> w
muvw = case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (u ⊗ v) +> w
muvw of
(SubBasis u
bu, [LinearMap (Scalar u) v w] -> [LinearMap (Scalar u) v w]
mvwsg) -> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
bu) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [LinearMap (Scalar u) v w] -> [LinearMap (Scalar u) v w]
mvwsg []
where ([LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go, SubBasis v
-> DList w
-> [LinearMap (Scalar v) v w]
-> DList (LinearMap (Scalar v) v w)
-> (Bool, (SubBasis v, DList w))
_) = forall v w s.
(FiniteDimensional v, LSpace w, Scalar v ~ s, Scalar w ~ s) =>
([v +> w] -> (SubBasis v, DList w),
SubBasis v
-> DList w
-> [v +> w]
-> DList (v +> w)
-> (Bool, (SubBasis v, DList w)))
tensorLinmapDecompositionhelpers
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar (Tensor s u v)) =>
SubBasis (Tensor s u v)
-> (Tensor s u v +> w)
-> Either (SubBasis (Tensor s u v), DList w) (DList w)
decomposeLinMapWithin = forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v)
-> ((u ⊗ v) +> w)
-> Either (SubBasis (u ⊗ v), DList w) (DList w)
dlm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where dlm :: ∀ w . (LSpace w, Scalar w ~ Scalar v)
=> DualSpaceWitness w -> SubBasis (u⊗v)
-> ((u⊗v)+>w) -> Either (SubBasis (u⊗v), DList w) (DList w)
dlm :: forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v)
-> ((u ⊗ v) +> w)
-> Either (SubBasis (u ⊗ v), DList w) (DList w)
dlm DualSpaceWitness w
DualSpaceWitness (TensorBasis SubBasis u
bu SubBasis v
bv) (u ⊗ v) +> w
muvw
= case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis u
bu forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (u ⊗ v) +> w
muvw of
Left (SubBasis u
bu', [LinearMap s v w] -> [LinearMap s v w]
mvwsg) -> let (Bool
_, (SubBasis v
bv', DList w
ws)) = SubBasis v
-> DList w
-> [LinearMap (Scalar v) v w]
-> DList (LinearMap (Scalar v) v w)
-> (Bool, (SubBasis v, DList w))
goWith SubBasis v
bv forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id ([LinearMap s v w] -> [LinearMap s v w]
mvwsg []) forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
in forall a b. a -> Either a b
Left (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
bu' SubBasis v
bv', DList w
ws)
Right [LinearMap s v w] -> [LinearMap s v w]
mvwsg -> let (Bool
changed, (SubBasis v
bv', DList w
ws)) = SubBasis v
-> DList w
-> [LinearMap (Scalar v) v w]
-> DList (LinearMap (Scalar v) v w)
-> (Bool, (SubBasis v, DList w))
goWith SubBasis v
bv forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id ([LinearMap s v w] -> [LinearMap s v w]
mvwsg []) forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
in if Bool
changed
then forall a b. a -> Either a b
Left (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
bu SubBasis v
bv', DList w
ws)
else forall a b. b -> Either a b
Right DList w
ws
where ([LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
_, SubBasis v
-> DList w
-> [LinearMap (Scalar v) v w]
-> DList (LinearMap (Scalar v) v w)
-> (Bool, (SubBasis v, DList w))
goWith) = forall v w s.
(FiniteDimensional v, LSpace w, Scalar v ~ s, Scalar w ~ s) =>
([v +> w] -> (SubBasis v, DList w),
SubBasis v
-> DList w
-> [v +> w]
-> DList (v +> w)
-> (Bool, (SubBasis v, DList w)))
tensorLinmapDecompositionhelpers
recomposeSB :: SubBasis (Tensor s u v)
-> [Scalar (Tensor s u v)]
-> (Tensor s u v, [Scalar (Tensor s u v)])
recomposeSB (TensorBasis SubBasis u
bu SubBasis v
bv) = forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor SubBasis u
bu SubBasis v
bv
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (Tensor s u v)) =>
SubBasis (Tensor s u v)
-> SubBasis w
-> [Scalar (Tensor s u v)]
-> (Tensor s u v ⊗ w, [Scalar (Tensor s u v)])
recomposeSBTensor = forall w.
(FiniteDimensional w, Scalar w ~ s) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> SubBasis w -> [s] -> ((u ⊗ v) ⊗ w, [s])
rst forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rst :: ∀ w . (FiniteDimensional w, Scalar w ~ s)
=> DualSpaceWitness w -> SubBasis (u⊗v)
-> SubBasis w -> [s] -> ((u⊗v)⊗w, [s])
rst :: forall w.
(FiniteDimensional w, Scalar w ~ s) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> SubBasis w -> [s] -> ((u ⊗ v) ⊗ w, [s])
rst DualSpaceWitness w
DualSpaceWitness (TensorBasis SubBasis u
bu SubBasis v
bv) SubBasis w
bw
= forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
lassocTensor) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor SubBasis u
bu (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
bv SubBasis w
bw)
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (Tensor s u v)) =>
SubBasis (Tensor s u v) -> [w] -> (Tensor s u v +> w, [w])
recomposeLinMap = forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> [w] -> ((u ⊗ v) +> w, [w])
rlm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rlm :: ∀ w . (LSpace w, Scalar w ~ Scalar v)
=> DualSpaceWitness w -> SubBasis (u⊗v) -> [w]
-> ((u⊗v)+>w, [w])
rlm :: forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> [w] -> ((u ⊗ v) +> w, [w])
rlm DualSpaceWitness w
DualSpaceWitness (TensorBasis SubBasis u
bu SubBasis v
bv) [w]
ws
= ( forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis u
bu
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv) [w]
ws
, forall a. Int -> [a] -> [a]
drop (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu forall a. Num a => a -> a -> a
* forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv) [w]
ws )
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (Tensor s u v), Functor f) =>
(f (Scalar w) -> w)
-> f (DualVector (Tensor s u v)) -> Tensor s u v +> w
recomposeContraLinMap = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u of
DualSpaceWitness u
DualSpaceWitness -> forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar (Tensor s u v), Scalar w ~ Scalar (Tensor s u v),
Functor f) =>
(f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u) -> (Tensor s u v ⊗ u) +> w
recomposeContraLinMapTensor = forall u' w (f :: * -> *).
(FiniteDimensional u', Scalar u' ~ s, LinearSpace w, Scalar w ~ s,
Functor f) =>
DualSpaceWitness u
-> DualSpaceWitness u'
-> (f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u')
-> (Tensor s u v ⊗ u') +> w
rclt forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rclt :: ∀ u' w f . ( FiniteDimensional u', Scalar u' ~ s
, LinearSpace w, Scalar w ~ s
, Hask.Functor f )
=> DualSpaceWitness u -> DualSpaceWitness u'
-> (f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u')
-> (Tensor s u v ⊗ u') +> w
rclt :: forall u' w (f :: * -> *).
(FiniteDimensional u', Scalar u' ~ s, LinearSpace w, Scalar w ~ s,
Functor f) =>
DualSpaceWitness u
-> DualSpaceWitness u'
-> (f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u')
-> (Tensor s u v ⊗ u') +> w
rclt DualSpaceWitness u
DualSpaceWitness DualSpaceWitness u'
DualSpaceWitness f (Scalar w) -> w
fw f (Tensor s u v +> DualVector u')
dds
= forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap) f (Tensor s u v +> DualVector u')
dds
uncanonicallyToDual :: Tensor s u v -+> DualVector (Tensor s u v)
uncanonicallyToDual = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor
uncanonicallyFromDual :: DualVector (Tensor s u v) -+> Tensor s u v
uncanonicallyFromDual = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar (Tensor s u v)) =>
(Tensor s u v ⊗ w) -> (Tensor s u v ⊗ w) -> Bool
tensorEquality = forall s u v w.
(FiniteDimensional u, FiniteDimensional v, TensorSpace w,
Scalar u ~ s, Scalar v ~ s, Scalar w ~ s, Eq w) =>
Tensor s (Tensor s u v) w -> Tensor s (Tensor s u v) w -> Bool
tensTensorEquality
dualFinitenessWitness :: DualFinitenessWitness (Tensor s u v)
dualFinitenessWitness = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
, forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
, DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
-> forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
DualVector (DualVector v) ~ v,
StaticDimension (DualVector v) ~ StaticDimension v) =>
DualSpaceWitness v
DualSpaceWitness
tensTensorEquality :: ∀ s u v w . ( FiniteDimensional u, FiniteDimensional v, TensorSpace w
, Scalar u ~ s, Scalar v ~ s, Scalar w ~ s
, Eq w )
=> Tensor s (Tensor s u v) w -> Tensor s (Tensor s u v) w -> Bool
tensTensorEquality :: forall s u v w.
(FiniteDimensional u, FiniteDimensional v, TensorSpace w,
Scalar u ~ s, Scalar v ~ s, Scalar w ~ s, Eq w) =>
Tensor s (Tensor s u v) w -> Tensor s (Tensor s u v) w -> Bool
tensTensorEquality (Tensor TensorProduct (Tensor s u v) w
s) (Tensor TensorProduct (Tensor s u v) w
t)
= forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (Tensor s u v) w
s :: Tensor s u (v⊗w)) (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (Tensor s u v) w
t)
tensorLinmapDecompositionhelpers
:: ( FiniteDimensional v, LSpace w , Scalar v~s, Scalar w~s )
=> ( [v+>w] -> (SubBasis v, DList w)
, SubBasis v -> DList w -> [v+>w] -> DList (v+>w)
-> (Bool, (SubBasis v, DList w)) )
tensorLinmapDecompositionhelpers :: forall v w s.
(FiniteDimensional v, LSpace w, Scalar v ~ s, Scalar w ~ s) =>
([v +> w] -> (SubBasis v, DList w),
SubBasis v
-> DList w
-> [v +> w]
-> DList (v +> w)
-> (Bool, (SubBasis v, DList w)))
tensorLinmapDecompositionhelpers = (forall {w} {v}.
(Scalar w ~ Scalar v, FiniteDimensional v, Num' (Scalar w),
LinearSpace w) =>
[LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go, forall {w} {v}.
(Scalar w ~ Scalar v, FiniteDimensional v, Num' (Scalar w),
LinearSpace w) =>
SubBasis v
-> ([w] -> [w])
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, [w] -> [w]))
goWith)
where go :: [LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go [] = forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap forall v. AdditiveGroup v => v
zeroV
go (LinearMap (Scalar v) v w
mvw:[LinearMap (Scalar v) v w]
mvws) = case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap LinearMap (Scalar v) v w
mvw of
(SubBasis v
bv, DList w
cfs) -> forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (forall {w} {v}.
(Scalar w ~ Scalar v, FiniteDimensional v, Num' (Scalar w),
LinearSpace w) =>
SubBasis v
-> ([w] -> [w])
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, [w] -> [w]))
goWith SubBasis v
bv DList w
cfs [LinearMap (Scalar v) v w]
mvws (LinearMap (Scalar v) v w
mvwforall a. a -> [a] -> [a]
:))
goWith :: SubBasis v
-> ([w] -> [w])
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, [w] -> [w]))
goWith SubBasis v
bv [w] -> [w]
prevdc [] [LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs = (Bool
False, (SubBasis v
bv, [w] -> [w]
prevdc))
goWith SubBasis v
bv [w] -> [w]
prevdc (LinearMap (Scalar v) v w
mvw:[LinearMap (Scalar v) v w]
mvws) [LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs = case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis v
bv LinearMap (Scalar v) v w
mvw of
Right [w] -> [w]
cfs -> SubBasis v
-> ([w] -> [w])
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, [w] -> [w]))
goWith SubBasis v
bv ([w] -> [w]
prevdc forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
cfs) [LinearMap (Scalar v) v w]
mvws ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (LinearMap (Scalar v) v w
mvwforall a. a -> [a] -> [a]
:))
Left (SubBasis v
bv', [w] -> [w]
cfs) -> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const Bool
True)
( SubBasis v
-> ([w] -> [w])
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, [w] -> [w]))
goWith SubBasis v
bv' (forall {w} {v}.
(Scalar w ~ Scalar v, FiniteDimensional v, Num' (Scalar w),
LinearSpace w) =>
SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
regoWith SubBasis v
bv' ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs[]) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [w]
cfs)
[LinearMap (Scalar v) v w]
mvws ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (LinearMap (Scalar v) v w
mvwforall a. a -> [a] -> [a]
:)) )
regoWith :: SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
regoWith SubBasis v
_ [] = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
regoWith SubBasis v
bv (LinearMap (Scalar v) v w
mvw:[LinearMap (Scalar v) v w]
mvws) = case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis v
bv LinearMap (Scalar v) v w
mvw of
Right [w] -> [w]
cfs -> [w] -> [w]
cfs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
regoWith SubBasis v
bv [LinearMap (Scalar v) v w]
mvws
Left (SubBasis v, [w] -> [w])
_ -> forall a. HasCallStack => [Char] -> a
error forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
"Misbehaved FiniteDimensional instance: `decomposeLinMapWithin` should,\
\\nif it cannot decompose in the given basis, do so in a proper\
\\nsuperbasis of the given one (so that any vector that could be\
\\ndecomposed in the old basis can also be decomposed in the new one)."
deriving instance (Show (SubBasis u), Show (SubBasis v))
=> Show (SubBasis (Tensor s u v))
instance ∀ s v . (FiniteDimensional v, Scalar v ~ s)
=> Eq (SymmetricTensor s v) where
SymTensor Tensor s v v
t == :: SymmetricTensor s v -> SymmetricTensor s v -> Bool
== SymTensor Tensor s v v
u = Tensor s v v
tforall a. Eq a => a -> a -> Bool
==Tensor s v v
u
instance ∀ s v .
( FiniteDimensional v, Scalar v~s, Scalar (DualVector v)~s
, RealFloat' s )
=> FiniteDimensional (SymmetricTensor s v) where
newtype SubBasis (SymmetricTensor s v) = SymTensBasis (SubBasis v)
entireBasis :: SubBasis (SymmetricTensor s v)
entireBasis = forall s v. SubBasis v -> SubBasis (SymmetricTensor s v)
SymTensBasis forall v. FiniteDimensional v => SubBasis v
entireBasis
enumerateSubBasis :: SubBasis (SymmetricTensor s v) -> [SymmetricTensor s v]
enumerateSubBasis (SymTensBasis SubBasis v
b) = do
v
v:[v]
vs <- forall a. [a] -> [[a]]
tails forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
b
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
v
forall a. a -> [a] -> [a]
: [ (forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV (v
vforall v. AdditiveGroup v => v -> v -> v
^+^v
w) forall v. AdditiveGroup v => v -> v -> v
^-^ forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
v forall v. AdditiveGroup v => v -> v -> v
^-^ forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
w) forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* s
sqrt¹₂ | v
w <- [v]
vs ]
where sqrt¹₂ :: s
sqrt¹₂ = forall a. Floating a => a -> a
sqrt s
0.5
subbasisDimension :: SubBasis (SymmetricTensor s v) -> Int
subbasisDimension (SymTensBasis SubBasis v
b) = (Int
nforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
+Int
1))forall a. Integral a => a -> a -> a
`quot`Int
2
where n :: Int
n = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (SymmetricTensor s v)) =>
(SymmetricTensor s v +> w)
-> (SubBasis (SymmetricTensor s v), DList w)
decomposeLinMap = DualFinitenessWitness v
-> LinearMap s (SymmetricTensor s v) w
-> (SubBasis (SymmetricTensor s v), DList w)
dclm forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness
where dclm :: DualFinitenessWitness v
-> LinearMap s (SymmetricTensor s v) w
-> (SubBasis (SymmetricTensor s v), DList w)
dclm (DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness :: DualFinitenessWitness v)
(LinearMap TensorProduct (DualVector (SymmetricTensor s v)) w
f)
= (forall s v. SubBasis v -> SubBasis (SymmetricTensor s v)
SymTensBasis SubBasis (DualVector (DualVector v))
bf, Int -> [[w]] -> DList w
rmRedundant Int
0 forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [w] -> [[w]]
symmetrise forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DList w
dlw [])
where rmRedundant :: Int -> [[w]] -> DList w
rmRedundant Int
_ [] = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
rmRedundant Int
k ([w]
row:[[w]]
rest)
= (DList w
sclOffdiag (forall a. Int -> [a] -> [a]
drop Int
k [w]
row)forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Int -> [[w]] -> DList w
rmRedundant (Int
kforall a. Num a => a -> a -> a
+Int
1) [[w]]
rest
symmetrise :: [w] -> [[w]]
symmetrise [w]
l = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. AdditiveGroup v => v -> v -> v
(^+^)) [[w]]
lm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. [[a]] -> [[a]]
transpose [[w]]
lm
where lm :: [[w]]
lm = [w] -> [[w]]
matr [w]
l
matr :: [w] -> [[w]]
matr [] = []
matr [w]
l = case forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [w]
l of
([w]
row,[w]
rest) -> [w]
row forall a. a -> [a] -> [a]
: [w] -> [[w]]
matr [w]
rest
n :: Int
n = case forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector (DualVector v))
bf of
Int
nbf | Int
nbf forall a. Eq a => a -> a -> Bool
== forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector (DualVector v))
bf' -> Int
nbf
(LinMapBasis SubBasis (DualVector (DualVector v))
bf SubBasis (DualVector (DualVector v))
bf', DList w
dlw)
= forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
lassocTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct (DualVector (SymmetricTensor s v)) w
f
sclOffdiag :: DList w
sclOffdiag (w
d:[w]
o) = Scalar w
0.5forall v. VectorSpace v => Scalar v -> v -> v
*^w
d forall a. a -> [a] -> [a]
: ((forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*s
sqrt¹₂)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[w]
o)
sqrt¹₂ :: s
sqrt¹₂ = forall a. Floating a => a -> a
sqrt s
0.5 :: s
recomposeSB :: SubBasis (SymmetricTensor s v)
-> [Scalar (SymmetricTensor s v)]
-> (SymmetricTensor s v, [Scalar (SymmetricTensor s v)])
recomposeSB = DualSpaceWitness v
-> SubBasis (SymmetricTensor s v)
-> [s]
-> (SymmetricTensor s v, [s])
rclm forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rclm :: DualSpaceWitness v
-> SubBasis (SymmetricTensor s v)
-> [s]
-> (SymmetricTensor s v, [s])
rclm (DualSpaceWitness v
DualSpaceWitness :: DualSpaceWitness v) (SymTensBasis SubBasis v
b) [s]
ws
= case forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
b SubBasis v
b)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall {a}. Floating a => Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (forall a. a -> [a]
repeat forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) [s]
ws of
(Tensor s v v
t, [s]
remws) -> (forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor Tensor s v v
t, [s]
remws)
mkSym :: Int -> [[a] -> [a]] -> [a] -> [a]
mkSym Int
_ [[a] -> [a]]
_ [] = []
mkSym Int
0 [[a] -> [a]]
_ [a]
ws = [a]
ws
mkSym Int
n ([a] -> [a]
sd₀:[[a] -> [a]]
sds) [a]
ws = let (a
d:[a]
o,[a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ws
oscld :: [a]
oscld = (forall a. Floating a => a -> a
sqrt a
0.5forall a. Num a => a -> a -> a
*)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[a]
o
in [a] -> [a]
sd₀ [] forall a. [a] -> [a] -> [a]
++ [a
d] forall a. [a] -> [a] -> [a]
++ [a]
oscld
forall a. [a] -> [a] -> [a]
++ Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
(.) [[a] -> [a]]
sds forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[a]
oscld) [a]
rest
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (SymmetricTensor s v)) =>
SubBasis (SymmetricTensor s v)
-> [w] -> (SymmetricTensor s v +> w, [w])
recomposeLinMap = DualFinitenessWitness v
-> SubBasis (SymmetricTensor s v)
-> [w]
-> (LinearMap s (SymmetricTensor s v) w, [w])
rclm forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness
where rclm :: DualFinitenessWitness v
-> SubBasis (SymmetricTensor s v)
-> [w]
-> (LinearMap s (SymmetricTensor s v) w, [w])
rclm (DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness :: DualFinitenessWitness v)
(SymTensBasis SubBasis v
b) [w]
ws
= case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap (forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis v
b SubBasis v
b)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall {a}.
(Floating (Scalar a), VectorSpace a) =>
Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (forall a. a -> [a]
repeat forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) [w]
ws of
(LinearMap (Scalar w) (LinearMap (Scalar w) (DualVector v) v) w
f, [w]
remws) -> (forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar w) (LinearMap (Scalar w) (DualVector v) v) w
f, [w]
remws)
mkSym :: Int -> [[a] -> [a]] -> [a] -> [a]
mkSym Int
_ [[a] -> [a]]
_ [] = []
mkSym Int
0 [[a] -> [a]]
_ [a]
ws = [a]
ws
mkSym Int
n ([a] -> [a]
sd₀:[[a] -> [a]]
sds) [a]
ws = let (a
d:[a]
o,[a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ws
oscld :: [a]
oscld = (forall a. Floating a => a -> a
sqrt Scalar a
0.5forall v. VectorSpace v => Scalar v -> v -> v
*^)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[a]
o
in [a] -> [a]
sd₀ [] forall a. [a] -> [a] -> [a]
++ [a
d] forall a. [a] -> [a] -> [a]
++ [a]
oscld
forall a. [a] -> [a] -> [a]
++ Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
(.) [[a] -> [a]]
sds forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[a]
oscld) [a]
rest
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (SymmetricTensor s v)) =>
SubBasis (SymmetricTensor s v)
-> SubBasis w
-> [Scalar (SymmetricTensor s v)]
-> (SymmetricTensor s v ⊗ w, [Scalar (SymmetricTensor s v)])
recomposeSBTensor = forall w.
(FiniteDimensional w, Scalar w ~ s) =>
SubBasis (SymmetricTensor s v)
-> SubBasis w -> [s] -> (Tensor s (SymmetricTensor s v) w, [s])
rcst
where rcst :: ∀ w . (FiniteDimensional w, Scalar w ~ s)
=> SubBasis (SymmetricTensor s v) -> SubBasis w
-> [s] -> (Tensor s (SymmetricTensor s v) w, [s])
rcst :: forall w.
(FiniteDimensional w, Scalar w ~ s) =>
SubBasis (SymmetricTensor s v)
-> SubBasis w -> [s] -> (Tensor s (SymmetricTensor s v) w, [s])
rcst (SymTensBasis SubBasis v
b) SubBasis w
bw [s]
μs
= case forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
b SubBasis v
b) SubBasis w
bw
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall {t :: * -> *} {a}.
(Foldable t, Floating a) =>
Int -> Int -> [[[a]] -> t [a]] -> [a] -> [a]
mkSym (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis w
bw) (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (forall a. a -> [a]
repeat forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) [s]
μs of
(Tensor TensorProduct (Tensor s v v) w
t, [s]
remws) -> ( forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (Tensor s v v) w
t
:: Tensor s (SymmetricTensor s v) w
, [s]
remws )
mkSym :: Int -> Int -> [[[a]] -> t [a]] -> [a] -> [a]
mkSym Int
_ Int
_ [[[a]] -> t [a]]
_ [] = []
mkSym Int
_ Int
0 [[[a]] -> t [a]]
_ [a]
ws = [a]
ws
mkSym Int
nw Int
n ([[a]] -> t [a]
sd₀:[[[a]] -> t [a]]
sds) [a]
ws = let ([a]
d:[[a]]
o,[a]
rest) = forall a. Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
nw Int
n [a]
ws
oscld :: [[a]]
oscld = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Floating a => a -> a
sqrt a
0.5forall a. Num a => a -> a -> a
*)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[[a]]
o
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> t [a]
sd₀ []) forall a. [a] -> [a] -> [a]
++ [a]
d forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
oscld
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [[[a]] -> t [a]] -> [a] -> [a]
mkSym Int
nw (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
(.) [[[a]] -> t [a]]
sds forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[[a]]
oscld) [a]
rest
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (SymmetricTensor s v),
Functor f) =>
(f (Scalar w) -> w)
-> f (DualVector (SymmetricTensor s v)) -> SymmetricTensor s v +> w
recomposeContraLinMap f (Scalar w) -> w
f f (DualVector (SymmetricTensor s v))
tenss = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @v of
DualSpaceWitness v
DualSpaceWitness ->
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (forall s u v w.
(TensorSpace u, TensorSpace v, TensorSpace w) =>
VSCCoercion
s (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) w.
(Functor f, LinearSpace w, s ~ Scalar w) =>
DualFinitenessWitness v
-> (f s -> w)
-> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (LinearMap s (DualVector v) v) w
rcCLM forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness f (Scalar w) -> w
f
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor f (DualVector (SymmetricTensor s v))
tenss
where rcCLM :: (Hask.Functor f, LinearSpace w, s~Scalar w)
=> DualFinitenessWitness v
-> (f s->w) -> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (LinearMap s (DualVector v) v) w
rcCLM :: forall (f :: * -> *) w.
(Functor f, LinearSpace w, s ~ Scalar w) =>
DualFinitenessWitness v
-> (f s -> w)
-> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (LinearMap s (DualVector v) v) w
rcCLM (DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness) f s -> w
f
= forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap f s -> w
f
uncanonicallyFromDual :: DualVector (SymmetricTensor s v) -+> SymmetricTensor s v
uncanonicallyFromDual = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness v of
DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness -> forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(SymTensor Tensor s (DualVector v) (DualVector v)
t) -> forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor s (DualVector v) (DualVector v)
t
uncanonicallyToDual :: SymmetricTensor s v -+> DualVector (SymmetricTensor s v)
uncanonicallyToDual = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness v of
DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness -> forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(SymTensor Tensor s v v
t) -> forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor s v v
t
dualFinitenessWitness :: DualFinitenessWitness (SymmetricTensor s v)
dualFinitenessWitness = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v of
DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness
-> forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
DualVector (DualVector v) ~ v,
StaticDimension (DualVector v) ~ StaticDimension v) =>
DualSpaceWitness v
DualSpaceWitness
deriving instance (Show (SubBasis v)) => Show (SubBasis (SymmetricTensor s v))
instance ∀ s u v .
( LSpace u, FiniteDimensional u, FiniteDimensional v
, Scalar u~s, Scalar v~s, Scalar (DualVector v)~s, Fractional' (Scalar v) )
=> FiniteDimensional (LinearMap s u v) where
data SubBasis (LinearMap s u v) = LinMapBasis !(SubBasis (DualVector u)) !(SubBasis v)
entireBasis :: SubBasis (LinearMap s u v)
entireBasis = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
-> case forall v. FiniteDimensional v => SubBasis v
entireBasis of TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv -> forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv
enumerateSubBasis :: SubBasis (LinearMap s u v) -> [LinearMap s u v]
enumerateSubBasis
= case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv)
-> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s a b. VSCCoercion s a b -> Coercion a b
getVSCCoercion forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv
subbasisDimension :: SubBasis (LinearMap s u v) -> Int
subbasisDimension (LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv)
= case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u ) of
(DualFinitenessWitness DualSpaceWitness u
_) -> forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector u)
bu forall a. Num a => a -> a -> a
* forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
decomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (LinearMap s u v)) =>
(LinearMap s u v +> w) -> (SubBasis (LinearMap s u v), DList w)
decomposeLinMap = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
-> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (\(TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv)->forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. coerce :: forall a b. Coercible a b => a -> b
coerce
decomposeLinMapWithin :: forall w.
(LSpace w, Scalar w ~ Scalar (LinearMap s u v)) =>
SubBasis (LinearMap s u v)
-> (LinearMap s u v +> w)
-> Either (SubBasis (LinearMap s u v), DList w) (DList w)
decomposeLinMapWithin = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
-> \(LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv) LinearMap s u v +> w
m
-> case forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) (coerce :: forall a b. Coercible a b => a -> b
coerce LinearMap s u v +> w
m) of
Right DList w
ws -> forall a b. b -> Either a b
Right DList w
ws
Left (TensorBasis SubBasis (DualVector u)
bu' SubBasis v
bv', DList w
ws) -> forall a b. a -> Either a b
Left (forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis (DualVector u)
bu' SubBasis v
bv', DList w
ws)
recomposeSB :: SubBasis (LinearMap s u v)
-> [Scalar (LinearMap s u v)]
-> (LinearMap s u v, [Scalar (LinearMap s u v)])
recomposeSB = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv)
-> forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor)
recomposeSBTensor :: forall w.
(FiniteDimensional w, Scalar w ~ Scalar (LinearMap s u v)) =>
SubBasis (LinearMap s u v)
-> SubBasis w
-> [Scalar (LinearMap s u v)]
-> (LinearMap s u v ⊗ w, [Scalar (LinearMap s u v)])
recomposeSBTensor = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv) SubBasis w
bw
-> forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor (forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) SubBasis w
bw forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first coerce :: forall a b. Coercible a b => a -> b
coerce
recomposeLinMap :: forall w.
(LSpace w, Scalar w ~ Scalar (LinearMap s u v)) =>
SubBasis (LinearMap s u v) -> [w] -> (LinearMap s u v +> w, [w])
recomposeLinMap = forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualFinitenessWitness u
-> DualSpaceWitness w
-> SubBasis (u +> v)
-> [w]
-> ((u +> v) +> w, [w])
rlm forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rlm :: ∀ w . (LSpace w, Scalar w ~ Scalar v)
=> DualFinitenessWitness u -> DualSpaceWitness w -> SubBasis (u+>v) -> [w]
-> ((u+>v)+>w, [w])
rlm :: forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualFinitenessWitness u
-> DualSpaceWitness w
-> SubBasis (u +> v)
-> [w]
-> ((u +> v) +> w, [w])
rlm (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness) DualSpaceWitness w
DualSpaceWitness (LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv) [w]
ws
= ( forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s,
TensorSpace w, Scalar w ~ s) =>
VSCCoercion
s (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
coUncurryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis (DualVector u)
bu
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv) [w]
ws
, forall a. Int -> [a] -> [a]
drop (forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector u)
bu forall a. Num a => a -> a -> a
* forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv) [w]
ws )
recomposeContraLinMap :: forall w (f :: * -> *).
(LinearSpace w, Scalar w ~ Scalar (LinearMap s u v), Functor f) =>
(f (Scalar w) -> w)
-> f (DualVector (LinearMap s u v)) -> LinearMap s u v +> w
recomposeContraLinMap = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \f (Scalar w) -> w
fw f (DualVector (LinearMap s u v))
dds
-> forall s v w x.
(LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s,
TensorSpace x, Scalar x ~ s) =>
VSCCoercion
s
(LinearMap s (Tensor s (DualVector v) w) x)
(LinearMap s (LinearMap s v w) x)
argFromTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap) f (DualVector (LinearMap s u v))
dds
recomposeContraLinMapTensor :: forall u w (f :: * -> *).
(FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar (LinearMap s u v),
Scalar w ~ Scalar (LinearMap s u v), Functor f) =>
(f (Scalar w) -> w)
-> f (LinearMap s u v +> DualVector u)
-> (LinearMap s u v ⊗ u) +> w
recomposeContraLinMapTensor = forall (f :: * -> *) u' w.
(LinearSpace w, FiniteDimensional u', Scalar w ~ s, Scalar u' ~ s,
Functor f) =>
DualFinitenessWitness u
-> DualSpaceWitness v
-> DualSpaceWitness u'
-> (f (Scalar w) -> w)
-> f ((u +> v) +> DualVector u')
-> ((u +> v) ⊗ u') +> w
rclmt forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where rclmt :: ∀ f u' w . ( LinearSpace w, FiniteDimensional u'
, Scalar w ~ s, Scalar u' ~ s
, Hask.Functor f )
=> DualFinitenessWitness u -> DualSpaceWitness v -> DualSpaceWitness u'
-> (f (Scalar w) -> w) -> f ((u+>v)+>DualVector u') -> ((u+>v)⊗u')+>w
rclmt :: forall (f :: * -> *) u' w.
(LinearSpace w, FiniteDimensional u', Scalar w ~ s, Scalar u' ~ s,
Functor f) =>
DualFinitenessWitness u
-> DualSpaceWitness v
-> DualSpaceWitness u'
-> (f (Scalar w) -> w)
-> f ((u +> v) +> DualVector u')
-> ((u +> v) ⊗ u') +> w
rclmt (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness)
DualSpaceWitness v
DualSpaceWitness DualSpaceWitness u'
DualSpaceWitness f (Scalar w) -> w
fw f ((u +> v) +> DualVector u')
dds
= forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s,
TensorSpace w, Scalar w ~ s) =>
VSCCoercion
s (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
coUncurryLinearMap
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall u v w s.
(LinearSpace u, LinearSpace v, TensorSpace w, Scalar u ~ s,
Scalar v ~ s, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s,
TensorSpace w, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
coCurryLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w x.
(LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s,
TensorSpace x, Scalar x ~ s) =>
VSCCoercion
s
(LinearMap s (Tensor s (DualVector v) w) x)
(LinearMap s (LinearMap s v w) x)
argFromTensor
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v u w (f :: * -> *).
(FiniteDimensional v, FiniteDimensional u, LinearSpace w,
Scalar u ~ Scalar v, Scalar w ~ Scalar v, Functor f) =>
(f (Scalar w) -> w) -> f (v +> DualVector u) -> (v ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s,
TensorSpace w, Scalar w ~ s) =>
VSCCoercion
s (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
coCurryLinearMap) f ((u +> v) +> DualVector u')
dds
uncanonicallyToDual :: LinearMap s u v -+> DualVector (LinearMap s u v)
uncanonicallyToDual = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
-> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
uncanonicallyFromDual :: DualVector (LinearMap s u v) -+> LinearMap s u v
uncanonicallyFromDual = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
-> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<< forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<< forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<< forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<< forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
tensorEquality :: forall w.
(TensorSpace w, Eq w, Scalar w ~ Scalar (LinearMap s u v)) =>
(LinearMap s u v ⊗ w) -> (LinearMap s u v ⊗ w) -> Bool
tensorEquality = forall s u v w.
(FiniteDimensional v, TensorSpace w, FiniteDimensional u,
Scalar u ~ s, Scalar v ~ s, Scalar w ~ s, Eq w) =>
Tensor s (LinearMap s u v) w
-> Tensor s (LinearMap s u v) w -> Bool
lmTensorEquality
dualFinitenessWitness :: DualFinitenessWitness (LinearMap s u v)
dualFinitenessWitness = case ( forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
, forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
(DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
, DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
-> forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
DualVector (DualVector v) ~ v,
StaticDimension (DualVector v) ~ StaticDimension v) =>
DualSpaceWitness v
DualSpaceWitness
lmTensorEquality :: ∀ s u v w . ( FiniteDimensional v, TensorSpace w
, FiniteDimensional u
, Scalar u ~ s, Scalar v ~ s, Scalar w ~ s
, Eq w )
=> Tensor s (LinearMap s u v) w -> Tensor s (LinearMap s u v) w -> Bool
lmTensorEquality :: forall s u v w.
(FiniteDimensional v, TensorSpace w, FiniteDimensional u,
Scalar u ~ s, Scalar v ~ s, Scalar w ~ s, Eq w) =>
Tensor s (LinearMap s u v) w
-> Tensor s (LinearMap s u v) w -> Bool
lmTensorEquality (Tensor TensorProduct (LinearMap s u v) w
s) (Tensor TensorProduct (LinearMap s u v) w
t) = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u of
DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
-> forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (LinearMap s u v) w
s :: Tensor s (DualVector u) (v⊗w)) (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (LinearMap s u v) w
t)
deriving instance (Show (SubBasis (DualVector u)), Show (SubBasis v))
=> Show (SubBasis (LinearMap s u v))
infixr 0 \$
(\$) :: ∀ u v . ( SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v )
=> (u+>v) -> v -> u
\$ :: forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v -> u
(\$) u +> v
m
| Int
du forall a. Ord a => a -> a -> Bool
> Int
dv = ((forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinearforall s v w. LinearFunction s v w -> v -> w
-+$>forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeRightInverse u +> v
m)forall s v w. LinearFunction s v w -> v -> w
-+$>)
| Int
du forall a. Ord a => a -> a -> Bool
< Int
dv = ((forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinearforall s v w. LinearFunction s v w -> v -> w
-+$>forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeLeftInverse u +> v
m)forall s v w. LinearFunction s v w -> v -> w
-+$>)
| Bool
otherwise = let v's :: [Maybe (DualVector v)]
v's = forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DList v
mdecomp []
(SubBasis u
mbas, DList v
mdecomp) = forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap u +> v
m
in forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \v
v -> forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
mbas [ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scalar v
0 (forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v) Maybe (DualVector v)
v' | Maybe (DualVector v)
v' <- [Maybe (DualVector v)]
v's ]
where du :: Int
du = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
dv :: Int
dv = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)
pseudoInverse :: ∀ u v . ( SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v )
=> (u+>v) -> v+>u
pseudoInverse :: forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
pseudoInverse u +> v
m
| Int
du forall a. Ord a => a -> a -> Bool
> Int
dv = forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeRightInverse u +> v
m
| Int
du forall a. Ord a => a -> a -> Bool
< Int
dv = forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeLeftInverse u +> v
m
| Bool
otherwise = forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse u +> v
m
where du :: Int
du = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
dv :: Int
dv = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)
unsafeLeftInverse :: ∀ u v . ( SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v )
=> (u+>v) -> v+>u
unsafeLeftInverse :: forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeLeftInverse = DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uli forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where uli :: DualSpaceWitness u -> DualSpaceWitness v -> (u+>v) -> v+>u
uli :: DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uli DualSpaceWitness u
DualSpaceWitness DualSpaceWitness v
DualSpaceWitness u +> v
m
= forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse (DualVector v +> DualVector u
m' forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
m))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. DualVector v +> DualVector u
m' forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
where m' :: DualVector v +> DualVector u
m' = forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
m :: DualVector v +> DualVector u
unsafeRightInverse :: ∀ u v . ( SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v )
=> (u+>v) -> v+>u
unsafeRightInverse :: forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeRightInverse = DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uri forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where uri :: DualSpaceWitness u -> DualSpaceWitness v -> (u+>v) -> v+>u
uri :: DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uri DualSpaceWitness u
DualSpaceWitness DualSpaceWitness v
DualSpaceWitness u +> v
m
= (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualVector v +> DualVector u
m')
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse (u +> v
m forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualVector v +> DualVector u
m'))
where m' :: DualVector v +> DualVector u
m' = forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
m :: DualVector v +> DualVector u
unsafeInverse :: ( FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v )
=> (u+>v) -> v+>u
unsafeInverse :: forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse u +> v
m = forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
mbas)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall v. AdditiveGroup v => v
zeroV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id Maybe (DualVector v)
v' | Maybe (DualVector v)
v'<-[Maybe (DualVector v)]
v's]
where v's :: [Maybe (DualVector v)]
v's = forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DList v
mdecomp []
(SubBasis u
mbas, DList v
mdecomp) = forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap u +> v
m
riesz :: ∀ v . ( FiniteDimensional v, InnerSpace v
, SimpleSpace v )
=> DualVector v -+> v
riesz :: forall v.
(FiniteDimensional v, InnerSpace v, SimpleSpace v) =>
DualVector v -+> v
riesz = case forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v of
DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness
-> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall v. (LSpace v, InnerSpace v) => v -+> DualVector v
coRiesz
sRiesz :: ∀ v . FiniteDimensional v => DualSpace v -+> v
sRiesz :: forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz = case ( forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness) -> forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \DualSpace v
dv ->
let (SubBasis v
bas, [Scalar v] -> [Scalar v]
compos) = forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualSpace v
dv
in forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis v
bas forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Scalar v] -> [Scalar v]
compos []
coRiesz :: ∀ v . (LSpace v, InnerSpace v) => v -+> DualVector v
coRiesz :: forall v. (LSpace v, InnerSpace v) => v -+> DualVector v
coRiesz = case ( forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
-> forall v. TensorSpace v => (v ⊗ Scalar v) -+> v
fromFlatTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunction forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. InnerSpace v => Bilinear v v (Scalar v)
inner
showsPrecAsRiesz :: ∀ v . ( FiniteDimensional v, InnerSpace v, Show v
, HasBasis (Scalar v), Basis (Scalar v) ~ () )
=> Int -> DualSpace v -> ShowS
showsPrecAsRiesz :: forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz = case ( forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
(ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
-> \Int
p DualSpace v
dv -> Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
0) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"().<"forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 (forall v. FiniteDimensional v => DualSpace v -+> v
sRieszforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$DualSpace v
dv)
instance Show (LinearMap ℝ (ZeroDim ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (ZeroDim ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ (V0 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V0 ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ ℝ ℝ) where showsPrec :: Int -> LinearMap ℝ ℝ ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ (V1 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V1 ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ (V2 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V2 ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ (V3 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V3 ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance Show (LinearMap ℝ (V4 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V4 ℝ) ℝ -> ShowS
showsPrec = forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
instance ∀ s v w .
( FiniteDimensional v, InnerSpace v, Show v
, FiniteDimensional w, InnerSpace w, Show w
, Scalar v ~ s, Scalar w ~ s
, HasBasis s, Basis s ~ () )
=> Show (LinearMap s (v,w) s ) where
showsPrec :: Int -> LinearMap s (v, w) s -> ShowS
showsPrec = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w ) of
(DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness) -> forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> ShowS
showsPrecAsRiesz
class TensorDecomposable u => RieszDecomposable u where
rieszDecomposition :: (FiniteDimensional v, v ~ DualVector v, Scalar v ~ Scalar u)
=> (v +> u) -> [(Basis u, v)]
instance RieszDecomposable ℝ where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v, Scalar v ~ Scalar ℝ) =>
(v +> ℝ) -> [(Basis ℝ, v)]
rieszDecomposition (LinearMap TensorProduct (DualVector v) ℝ
r) = [((), forall v. TensorSpace v => (v ⊗ Scalar v) -+> v
fromFlatTensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector v) ℝ
r)]
instance ( RieszDecomposable x, RieszDecomposable y
, Scalar x ~ Scalar y, Scalar (DualVector x) ~ Scalar (DualVector y) )
=> RieszDecomposable (x,y) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (x, y)) =>
(v +> (x, y)) -> [(Basis (x, y), v)]
rieszDecomposition v +> (x, y)
m = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall a b. a -> Either a b
Left) (forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall s v w. LinearFunction s v w -> v -> w
-+$> v +> (x, y)
m)
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) (forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall s v w. LinearFunction s v w -> v -> w
-+$> v +> (x, y)
m)
instance RieszDecomposable (ZeroDim ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (ZeroDim ℝ)) =>
(v +> ZeroDim ℝ) -> [(Basis (ZeroDim ℝ), v)]
rieszDecomposition v +> ZeroDim ℝ
_ = []
instance RieszDecomposable (V0 ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (V0 ℝ)) =>
(v +> V0 ℝ) -> [(Basis (V0 ℝ), v)]
rieszDecomposition v +> V0 ℝ
_ = []
instance RieszDecomposable (V1 ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (V1 ℝ)) =>
(v +> V1 ℝ) -> [(Basis (V1 ℝ), v)]
rieszDecomposition v +> V1 ℝ
m = [(forall (t :: * -> *). R1 t => E t
ex, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V1 ℝ
m)]
#if MIN_VERSION_free_vector_spaces(0,2,0)
where ex = e @0
#endif
instance RieszDecomposable (V2 ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (V2 ℝ)) =>
(v +> V2 ℝ) -> [(Basis (V2 ℝ), v)]
rieszDecomposition v +> V2 ℝ
m = [ (forall (t :: * -> *). R1 t => E t
ex, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V2 ℝ
m)
, (forall (t :: * -> *). R2 t => E t
ey, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V2 ℝ
m) ]
#if MIN_VERSION_free_vector_spaces(0,2,0)
where ex = e @0
ey = e @1
#endif
instance RieszDecomposable (V3 ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (V3 ℝ)) =>
(v +> V3 ℝ) -> [(Basis (V3 ℝ), v)]
rieszDecomposition v +> V3 ℝ
m = [ (forall (t :: * -> *). R1 t => E t
ex, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V3 ℝ
m)
, (forall (t :: * -> *). R2 t => E t
ey, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V3 ℝ
m)
, (forall (t :: * -> *). R3 t => E t
ez, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V3 ℝ
m) ]
#if MIN_VERSION_free_vector_spaces(0,2,0)
where ex = e @0
ey = e @1
ez = e @2
#endif
instance RieszDecomposable (V4 ℝ) where
rieszDecomposition :: forall v.
(FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar (V4 ℝ)) =>
(v +> V4 ℝ) -> [(Basis (V4 ℝ), v)]
rieszDecomposition v +> V4 ℝ
m = [ (forall (t :: * -> *). R1 t => E t
ex, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V4 ℝ
m)
, (forall (t :: * -> *). R2 t => E t
ey, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V4 ℝ
m)
, (forall (t :: * -> *). R3 t => E t
ez, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V4 ℝ
m)
, (forall (t :: * -> *). R4 t => E t
ew, forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) a. R4 t => Lens' (t a) a
_w)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v +> V4 ℝ
m) ]
#if MIN_VERSION_free_vector_spaces(0,2,0)
where ex = e @0
ey = e @1
ez = e @2
ew = e @3
#endif
infixl 7 .<
(.<) :: ( FiniteDimensional v, Num' (Scalar v)
, InnerSpace v, LSpace w, HasBasis w, Scalar v ~ Scalar w )
=> Basis w -> v -> v+>w
Basis w
bw .< :: forall v w.
(FiniteDimensional v, Num' (Scalar v), InnerSpace v, LSpace w,
HasBasis w, Scalar v ~ Scalar w) =>
Basis w -> v -> v +> w
.< v
v = forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \v
v' -> forall v. HasBasis v => [(Basis v, Scalar v)] -> v
recompose [(Basis w
bw, v
vforall v. InnerSpace v => v -> v -> Scalar v
<.>v
v')]
rieszDecomposeShowsPrec :: ∀ u v s . ( RieszDecomposable u
, FiniteDimensional v, v ~ DualVector v, Show v
, Scalar u ~ s, Scalar v ~ s )
=> Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec :: forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec Int
p LinearMap s v u
m = case forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition LinearMap s v u
m of
[] -> ([Char]
"zeroV"forall a. [a] -> [a] -> [a]
++)
((Basis u
b₀,v
dv₀):[(Basis u, v)]
dvs) -> Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
6)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \[Char]
s -> forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @u Int
7 Basis u
b₀
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ([Char]
".<"forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 v
dv₀
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Basis u
b,v
dv)
-> ([Char]
" ^+^ "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @u Int
7 Basis u
b
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ([Char]
".<"forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 v
dv) [Char]
s [(Basis u, v)]
dvs
instance Show (LinearMap s v (ZeroDim s)) where
show :: LinearMap s v (ZeroDim s) -> [Char]
show LinearMap s v (ZeroDim s)
_ = [Char]
"zeroV"
instance Show (LinearMap s v (V0 s)) where
show :: LinearMap s v (V0 s) -> [Char]
show LinearMap s v (V0 s)
_ = [Char]
"zeroV"
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (LinearMap ℝ v (V1 ℝ)) where
showsPrec :: Int -> LinearMap ℝ v (V1 ℝ) -> ShowS
showsPrec = forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (LinearMap ℝ v (V2 ℝ)) where
showsPrec :: Int -> LinearMap ℝ v (V2 ℝ) -> ShowS
showsPrec = forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (LinearMap ℝ v (V3 ℝ)) where
showsPrec :: Int -> LinearMap ℝ v (V3 ℝ) -> ShowS
showsPrec = forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (LinearMap ℝ v (V4 ℝ)) where
showsPrec :: Int -> LinearMap ℝ v (V4 ℝ) -> ShowS
showsPrec = forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec
instance ( FiniteDimensional v, v ~ DualVector v, Show v
, RieszDecomposable x, RieszDecomposable y
, Scalar x ~ s, Scalar y ~ s, Scalar v ~ s
, Scalar (DualVector x) ~ s, Scalar (DualVector y) ~ s )
=> Show (LinearMap s v (x,y)) where
showsPrec :: Int -> LinearMap s v (x, y) -> ShowS
showsPrec = case
(forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness x, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness y) of
(DualSpaceWitness x
DualSpaceWitness, DualSpaceWitness y
DualSpaceWitness) -> forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> ShowS
rieszDecomposeShowsPrec
infixr 7 .⊗
(.⊗) :: ( TensorSpace v, HasBasis v, TensorSpace w
, Num' (Scalar v), Scalar v ~ Scalar w )
=> Basis v -> w -> v⊗w
Basis v
b .⊗ :: forall v w.
(TensorSpace v, HasBasis v, TensorSpace w, Num' (Scalar v),
Scalar v ~ Scalar w) =>
Basis v -> w -> v ⊗ w
.⊗ w
w = forall v. HasBasis v => Basis v -> v
basisValue Basis v
b forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗ w
w
class (FiniteDimensional v, HasBasis v) => TensorDecomposable v where
tensorDecomposition :: (TensorSpace w, Scalar w ~ Scalar v)
=> v⊗w -> [(Basis v, w)]
tensorDecompose' :: (TensorSpace w, Scalar w ~ Scalar v)
=> v⊗w -> Basis v -> w
showsPrecBasis :: Int -> Basis v -> ShowS
instance ( TensorDecomposable u, TensorSpace v
, HasBasis u, HasBasis v
, Num' s, Scalar u ~ s, Scalar v ~ s
) => HasBasis (Tensor s u v) where
type Basis (Tensor s u v) = (Basis u, Basis v)
basisValue :: Basis (Tensor s u v) -> Tensor s u v
basisValue (Basis u
bu, Basis v
bv) = forall v. HasBasis v => Basis v -> v
basisValue Basis u
bu forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗ forall v. HasBasis v => Basis v -> v
basisValue Basis v
bv
decompose :: Tensor s u v -> [(Basis (Tensor s u v), Scalar (Tensor s u v))]
decompose Tensor s u v
t = [ ((Basis u
bu,Basis v
bv),s
s)
| (Basis u
bu,v
v) <- forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor s u v
t
, (Basis v
bv,s
s) <- forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose v
v ]
decompose' :: Tensor s u v -> Basis (Tensor s u v) -> Scalar (Tensor s u v)
decompose' Tensor s u v
t (Basis u
bu, Basis v
bv) = forall v. HasBasis v => v -> Basis v -> Scalar v
decompose' (forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> Basis v -> w
tensorDecompose' Tensor s u v
t Basis u
bu) Basis v
bv
instance TensorDecomposable ℝ where
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar ℝ) =>
(ℝ ⊗ w) -> [(Basis ℝ, w)]
tensorDecomposition (Tensor TensorProduct ℝ w
r) = [((), TensorProduct ℝ w
r)]
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar ℝ) =>
(ℝ ⊗ w) -> Basis ℝ -> w
tensorDecompose' (Tensor TensorProduct ℝ w
r) () = TensorProduct ℝ w
r
showsPrecBasis :: Int -> Basis ℝ -> ShowS
showsPrecBasis Int
_ = forall a. Show a => a -> ShowS
shows
instance ∀ x y . ( TensorDecomposable x, TensorDecomposable y
, Scalar x ~ Scalar y, Scalar (DualVector x) ~ Scalar (DualVector y) )
=> TensorDecomposable (x,y) where
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (x, y)) =>
((x, y) ⊗ w) -> [(Basis (x, y), w)]
tensorDecomposition (Tensor (Tensor (Scalar y) x w
tx,Tensor (Scalar y) y w
ty))
= forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall a b. a -> Either a b
Left) (forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor (Scalar y) x w
tx)
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) (forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor (Scalar y) y w
ty)
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (x, y)) =>
((x, y) ⊗ w) -> Basis (x, y) -> w
tensorDecompose' (Tensor (Tensor (Scalar y) x w
tx,Tensor (Scalar y) y w
ty)) (Left Basis x
bx)
= forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> Basis v -> w
tensorDecompose' Tensor (Scalar y) x w
tx Basis x
bx
tensorDecompose' (Tensor (Tensor (Scalar y) x w
tx,Tensor (Scalar y) y w
ty)) (Right Basis y
by)
= forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> Basis v -> w
tensorDecompose' Tensor (Scalar y) y w
ty Basis y
by
showsPrecBasis :: Int -> Basis (x, y) -> ShowS
showsPrecBasis Int
p (Left Basis x
bx)
= Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
9) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"Left "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @x Int
10 Basis x
bx
showsPrecBasis Int
p (Right Basis y
by)
= Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
9) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"Right "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @y Int
10 Basis y
by
instance TensorDecomposable (ZeroDim ℝ) where
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (ZeroDim ℝ)) =>
(ZeroDim ℝ ⊗ w) -> [(Basis (ZeroDim ℝ), w)]
tensorDecomposition ZeroDim ℝ ⊗ w
_ = []
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (ZeroDim ℝ)) =>
(ZeroDim ℝ ⊗ w) -> Basis (ZeroDim ℝ) -> w
tensorDecompose' ZeroDim ℝ ⊗ w
_ = forall a. Void -> a
absurd
showsPrecBasis :: Int -> Basis (ZeroDim ℝ) -> ShowS
showsPrecBasis Int
_ = forall a. Void -> a
absurd
instance TensorDecomposable (V0 ℝ) where
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V0 ℝ)) =>
(V0 ℝ ⊗ w) -> [(Basis (V0 ℝ), w)]
tensorDecomposition V0 ℝ ⊗ w
_ = []
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V0 ℝ)) =>
(V0 ℝ ⊗ w) -> Basis (V0 ℝ) -> w
tensorDecompose' V0 ℝ ⊗ w
_ Basis (V0 ℝ)
b = case Basis (V0 ℝ)
b of {}
#if MIN_VERSION_free_vector_spaces(0,2,0)
showsPrecBasis = showsPrec
#else
showsPrecBasis :: Int -> Basis (V0 ℝ) -> ShowS
showsPrecBasis Int
_ (Mat.E forall x. Lens' (V0 x) x
q) = (forall a. V0 a
V0forall s a. s -> Getting a s a -> a
^.forall x. Lens' (V0 x) x
q forall a. [a] -> [a] -> [a]
++)
#endif
instance TensorDecomposable (V1 ℝ) where
#if MIN_VERSION_free_vector_spaces(0,2,0)
tensorDecomposition (Tensor (V1 w)) = [(e @0, w)]
tensorDecompose' (Tensor (V1 w)) _ = w
showsPrecBasis = showsPrec
#else
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V1 ℝ)) =>
(V1 ℝ ⊗ w) -> [(Basis (V1 ℝ), w)]
tensorDecomposition (Tensor (V1 w
w)) = [(forall (t :: * -> *). R1 t => E t
ex, w
w)]
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V1 ℝ)) =>
(V1 ℝ ⊗ w) -> Basis (V1 ℝ) -> w
tensorDecompose' (Tensor TensorProduct (V1 ℝ) w
w) (Mat.E forall x. Lens' (V1 x) x
q) = TensorProduct (V1 ℝ) w
wforall s a. s -> Getting a s a -> a
^.forall x. Lens' (V1 x) x
q
showsPrecBasis :: Int -> Basis (V1 ℝ) -> ShowS
showsPrecBasis Int
_ (Mat.E forall x. Lens' (V1 x) x
q) = (forall a. a -> V1 a
V1[Char]
"ex"forall s a. s -> Getting a s a -> a
^.forall x. Lens' (V1 x) x
q forall a. [a] -> [a] -> [a]
++)
#endif
instance TensorDecomposable (V2 ℝ) where
#if MIN_VERSION_free_vector_spaces(0,2,0)
tensorDecomposition (Tensor (V2 x y)) = [ (e @0, x), (e @1, y) ]
tensorDecompose' (Tensor (V2 x y)) b = case getEuclideanBasisIndex b of
{ 0 -> x; 1 -> y }
showsPrecBasis = showsPrec
#else
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V2 ℝ)) =>
(V2 ℝ ⊗ w) -> [(Basis (V2 ℝ), w)]
tensorDecomposition (Tensor (V2 w
x w
y)) = [ (forall (t :: * -> *). R1 t => E t
ex, w
x), (forall (t :: * -> *). R2 t => E t
ey, w
y) ]
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V2 ℝ)) =>
(V2 ℝ ⊗ w) -> Basis (V2 ℝ) -> w
tensorDecompose' (Tensor TensorProduct (V2 ℝ) w
w) (Mat.E forall x. Lens' (V2 x) x
q) = TensorProduct (V2 ℝ) w
wforall s a. s -> Getting a s a -> a
^.forall x. Lens' (V2 x) x
q
showsPrecBasis :: Int -> Basis (V2 ℝ) -> ShowS
showsPrecBasis Int
_ (Mat.E forall x. Lens' (V2 x) x
q) = (forall a. a -> a -> V2 a
V2[Char]
"ex"[Char]
"ey"forall s a. s -> Getting a s a -> a
^.forall x. Lens' (V2 x) x
q forall a. [a] -> [a] -> [a]
++)
#endif
instance TensorDecomposable (V3 ℝ) where
#if MIN_VERSION_free_vector_spaces(0,2,0)
tensorDecomposition (Tensor (V3 x y z)) = [ (e @0, x), (e @1, y), (e @2, z) ]
tensorDecompose' (Tensor (V3 x y z)) b = case getEuclideanBasisIndex b of
{ 0 -> x; 1 -> y; 2 -> z }
showsPrecBasis = showsPrec
#else
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V3 ℝ)) =>
(V3 ℝ ⊗ w) -> [(Basis (V3 ℝ), w)]
tensorDecomposition (Tensor (V3 w
x w
y w
z)) = [ (forall (t :: * -> *). R1 t => E t
ex, w
x), (forall (t :: * -> *). R2 t => E t
ey, w
y), (forall (t :: * -> *). R3 t => E t
ez, w
z) ]
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V3 ℝ)) =>
(V3 ℝ ⊗ w) -> Basis (V3 ℝ) -> w
tensorDecompose' (Tensor TensorProduct (V3 ℝ) w
w) (Mat.E forall x. Lens' (V3 x) x
q) = TensorProduct (V3 ℝ) w
wforall s a. s -> Getting a s a -> a
^.forall x. Lens' (V3 x) x
q
showsPrecBasis :: Int -> Basis (V3 ℝ) -> ShowS
showsPrecBasis Int
_ (Mat.E forall x. Lens' (V3 x) x
q) = (forall a. a -> a -> a -> V3 a
V3[Char]
"ex"[Char]
"ey"[Char]
"ez"forall s a. s -> Getting a s a -> a
^.forall x. Lens' (V3 x) x
q forall a. [a] -> [a] -> [a]
++)
#endif
instance TensorDecomposable (V4 ℝ) where
#if MIN_VERSION_free_vector_spaces(0,2,0)
tensorDecomposition (Tensor (V4 x y z w)) = [(e @0,x), (e @1,y), (e @2,z), (e @3,w)]
tensorDecompose' (Tensor (V4 x y z w)) b = case getEuclideanBasisIndex b of
{ 0 -> x; 1 -> y; 2 -> z; 3 -> w }
showsPrecBasis = showsPrec
#else
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V4 ℝ)) =>
(V4 ℝ ⊗ w) -> [(Basis (V4 ℝ), w)]
tensorDecomposition (Tensor (V4 w
x w
y w
z w
w)) = [ (forall (t :: * -> *). R1 t => E t
ex, w
x), (forall (t :: * -> *). R2 t => E t
ey, w
y), (forall (t :: * -> *). R3 t => E t
ez, w
z), (forall (t :: * -> *). R4 t => E t
ew, w
w) ]
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ Scalar (V4 ℝ)) =>
(V4 ℝ ⊗ w) -> Basis (V4 ℝ) -> w
tensorDecompose' (Tensor TensorProduct (V4 ℝ) w
w) (Mat.E forall x. Lens' (V4 x) x
q) = TensorProduct (V4 ℝ) w
wforall s a. s -> Getting a s a -> a
^.forall x. Lens' (V4 x) x
q
showsPrecBasis :: Int -> Basis (V4 ℝ) -> ShowS
showsPrecBasis Int
_ (Mat.E forall x. Lens' (V4 x) x
q) = (forall a. a -> a -> a -> a -> V4 a
V4[Char]
"ex"[Char]
"ey"[Char]
"ez"[Char]
"ew"forall s a. s -> Getting a s a -> a
^.forall x. Lens' (V4 x) x
q forall a. [a] -> [a] -> [a]
++)
#endif
instance ∀ u v s
. ( TensorDecomposable u, TensorDecomposable v
, Fractional' s, Scalar u ~ s, Scalar v ~ s
, Scalar (DualVector u) ~ s, Scalar (DualVector v) ~ s )
=> TensorDecomposable (Tensor s u v) where
tensorDecomposition :: ∀ w . (TensorSpace w, Scalar w ~ s)
=> (Tensor s u v)⊗w -> [((Basis u, Basis v), w)]
tensorDecomposition :: forall w.
(TensorSpace w, Scalar w ~ s) =>
(Tensor s u v ⊗ w) -> [((Basis u, Basis v), w)]
tensorDecomposition (Tensor TensorProduct (Tensor s u v) w
t) = [ ((Basis u
bu,Basis v
bv),w
w)
| (Basis u
bu,Tensor s v w
vw) <- forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition @u (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (Tensor s u v) w
t)
, (Basis v
bv,w
w) <- forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition @v Tensor s v w
vw ]
tensorDecompose' :: ∀ w . (TensorSpace w, Scalar w ~ s)
=> (Tensor s u v)⊗w -> (Basis u, Basis v) -> w
tensorDecompose' :: forall w.
(TensorSpace w, Scalar w ~ s) =>
(Tensor s u v ⊗ w) -> (Basis u, Basis v) -> w
tensorDecompose' (Tensor TensorProduct (Tensor s u v) w
t) (Basis u
bu,Basis v
bv)
= forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> Basis v -> w
tensorDecompose' @v (forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> Basis v -> w
tensorDecompose' @u (forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (Tensor s u v) w
t) Basis u
bu) Basis v
bv
showsPrecBasis :: Int -> (Basis u, Basis v) -> ShowS
showsPrecBasis :: Int -> (Basis u, Basis v) -> ShowS
showsPrecBasis = forall a. HasCallStack => a
undefined
tensorDecomposeShowsPrec :: ∀ u v s
. ( TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s, Scalar v ~ s )
=> Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec :: forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec Int
p Tensor s u v
t = case forall v w.
(TensorDecomposable v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor s u v
t of
[] -> ([Char]
"zeroV"forall a. [a] -> [a] -> [a]
++)
((Basis u
b₀,v
dv₀):[(Basis u, v)]
dvs) -> Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
6)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \[Char]
s -> forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @u Int
7 Basis u
b₀
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ([Char]
".⊗"forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 v
dv₀
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Basis u
b,v
dv)
-> ([Char]
" ^+^ "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. TensorDecomposable v => Int -> Basis v -> ShowS
showsPrecBasis @u Int
7 Basis u
b
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ([Char]
".⊗"forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 v
dv) [Char]
s [(Basis u, v)]
dvs
instance Show (Tensor s (V0 s) v) where
show :: Tensor s (V0 s) v -> [Char]
show Tensor s (V0 s) v
_ = [Char]
"zeroV"
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (Tensor ℝ (V1 ℝ) v) where
showsPrec :: Int -> Tensor ℝ (V1 ℝ) v -> ShowS
showsPrec = forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (Tensor ℝ (V2 ℝ) v) where
showsPrec :: Int -> Tensor ℝ (V2 ℝ) v -> ShowS
showsPrec = forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (Tensor ℝ (V3 ℝ) v) where
showsPrec :: Int -> Tensor ℝ (V3 ℝ) v -> ShowS
showsPrec = forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
=> Show (Tensor ℝ (V4 ℝ) v) where
showsPrec :: Int -> Tensor ℝ (V4 ℝ) v -> ShowS
showsPrec = forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec
instance ( FiniteDimensional v, v ~ DualVector v, Show v
, TensorDecomposable x, TensorDecomposable y
, Scalar x ~ s, Scalar y ~ s, Scalar v ~ s )
=> Show (Tensor s (x,y) v) where
showsPrec :: Int -> Tensor s (x, y) v -> ShowS
showsPrec = case
(forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness x, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness y) of
(DualSpaceWitness x
DualSpaceWitness, DualSpaceWitness y
DualSpaceWitness) -> forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
Scalar v ~ s) =>
Int -> Tensor s u v -> ShowS
tensorDecomposeShowsPrec
instance ( TensorDecomposable u
, Scalar u ~ s )
=> Show (Tensor s (Tensor s u v) w) where
showsPrec :: Int -> Tensor s (Tensor s u v) w -> ShowS
showsPrec = case (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness u) of
DualSpaceWitness u
DualSpaceWitness -> forall a. HasCallStack => a
undefined
(^) :: Num a => a -> Int -> a
^ :: forall a. Num a => a -> Int -> a
(^) = forall a b. (Num a, Integral b) => a -> b -> a
(Hask.^)
type HilbertSpace v = (LSpace v, InnerSpace v, DualVector v ~ v)
type RealFrac' s = (Fractional' s, IEEE s, InnerSpace s)
type RealFloat' s = (RealFrac' s, Floating s)
type SimpleSpace v = ( FiniteDimensional v, FiniteDimensional (DualVector v)
, SemiInner v, SemiInner (DualVector v)
, RealFrac' (Scalar v) )
instance ∀ s u v .
( FiniteDimensional u, LSpace v, FiniteFreeSpace v
, Scalar u~s, Scalar v~s ) => FiniteFreeSpace (LinearMap s u v) where
freeDimension :: forall (p :: * -> *). Functor p => p (LinearMap s u v) -> Int
freeDimension p (LinearMap s u v)
_ = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
forall a. Num a => a -> a -> a
* forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
toFullUnboxVect :: Unbox (Scalar (LinearMap s u v)) =>
LinearMap s u v -> Vector (Scalar (LinearMap s u v))
toFullUnboxVect = forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin forall v. FiniteDimensional v => SubBasis v
entireBasis forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \case
Right DList v
l -> forall a. Unbox a => [Vector a] -> Vector a
UArr.concat forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> DList v
l []
unsafeFromFullUnboxVect :: Unbox (Scalar (LinearMap s u v)) =>
Vector (Scalar (LinearMap s u v)) -> LinearMap s u v
unsafeFromFullUnboxVect Vector (Scalar (LinearMap s u v))
arrv = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap forall v. FiniteDimensional v => SubBasis v
entireBasis
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => Int -> Int -> Vector a -> Vector a
UArr.slice (Int
dvforall a. Num a => a -> a -> a
*Int
j) Int
dv Vector (Scalar (LinearMap s u v))
arrv | Int
j <- [Int
0 .. Int
duforall a. Num a => a -> a -> a
-Int
1]]
where du :: Int
du = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
dv :: Int
dv = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
instance ∀ s u v .
( LSpace u, FiniteDimensional (DualVector u), LSpace v, FiniteFreeSpace v
, Scalar u~s, Scalar v~s, Scalar (DualVector u)~s, Scalar (DualVector v)~s )
=> FiniteFreeSpace (Tensor s u v) where
freeDimension :: forall (p :: * -> *). Functor p => p (Tensor s u v) -> Int
freeDimension p (Tensor s u v)
_ = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (DualVector u))
forall a. Num a => a -> a -> a
* forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
toFullUnboxVect :: Unbox (Scalar (Tensor s u v)) =>
Tensor s u v -> Vector (Scalar (Tensor s u v))
toFullUnboxVect = forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin forall v. FiniteDimensional v => SubBasis v
entireBasis forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \case
Right DList v
l -> forall a. Unbox a => [Vector a] -> Vector a
UArr.concat forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> DList v
l []
unsafeFromFullUnboxVect :: Unbox (Scalar (Tensor s u v)) =>
Vector (Scalar (Tensor s u v)) -> Tensor s u v
unsafeFromFullUnboxVect Vector (Scalar (Tensor s u v))
arrv = forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion s (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap forall v. FiniteDimensional v => SubBasis v
entireBasis
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => Int -> Int -> Vector a -> Vector a
UArr.slice (Int
dvforall a. Num a => a -> a -> a
*Int
j) Int
dv Vector (Scalar (Tensor s u v))
arrv | Int
j <- [Int
0 .. Int
duforall a. Num a => a -> a -> a
-Int
1]]
where du :: Int
du = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (DualVector u))
dv :: Int
dv = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
instance ∀ s u v .
( FiniteDimensional u, LSpace v, FiniteFreeSpace v
, Scalar u~s, Scalar v~s ) => FiniteFreeSpace (LinearFunction s u v) where
freeDimension :: forall (p :: * -> *). Functor p => p (LinearFunction s u v) -> Int
freeDimension p (LinearFunction s u v)
_ = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
forall a. Num a => a -> a -> a
* forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
toFullUnboxVect :: Unbox (Scalar (LinearFunction s u v)) =>
LinearFunction s u v -> Vector (Scalar (LinearFunction s u v))
toFullUnboxVect LinearFunction s u v
f = forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearFunction s u v
f :: LinearMap s u v)
unsafeFromFullUnboxVect :: Unbox (Scalar (LinearFunction s u v)) =>
Vector (Scalar (LinearFunction s u v)) -> LinearFunction s u v
unsafeFromFullUnboxVect Vector (Scalar (LinearFunction s u v))
arrv = forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect Vector (Scalar (LinearFunction s u v))
arrv :: LinearMap s u v)
adjoint :: ∀ v w . (LinearSpace v, LinearSpace w, Scalar v ~ Scalar w)
=> (v +> DualVector w) -+> (w +> DualVector v)
adjoint :: forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w ) of
(DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness)
-> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr forall s v w.
LinearSpace v =>
VSCCoercion s (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor
multiSplit :: Int -> Int -> [a] -> ([[a]], [a])
multiSplit :: forall a. Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
chunkSize Int
0 [a]
l = ([],[a]
l)
multiSplit Int
chunkSize Int
nChunks [a]
l = case forall a. Int -> [a] -> ([a], [a])
splitAt Int
chunkSize [a]
l of
([a]
chunk, [a]
rest) -> forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first ([a]
chunkforall a. a -> [a] -> [a]
:) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
chunkSize (Int
nChunksforall a. Num a => a -> a -> a
-Int
1) [a]
rest