-- |
-- Module      : Math.VectorSpace.Docile
-- Copyright   : (c) Justus Sagemüller 2016
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 


{-# 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 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




-- | 'SemiInner' is the class of vector spaces with finite subspaces in which
--   you can define a basis that can be used to project from the whole space
--   into the subspace. The usual application is for using a kind of
--   <https://en.wikipedia.org/wiki/Galerkin_method Galerkin method> to
--   give an approximate solution (see '\$') to a linear equation in a possibly
--   infinite-dimensional space.
-- 
--   Of course, this also works for spaces which are already finite-dimensional themselves.
class LinearSpace v => SemiInner v where
  -- | Lazily enumerate choices of a basis of functionals that can be made dual
  --   to the given vectors, in order of preference (which roughly means, large in
  --   the normal direction.) I.e., if the vector @𝑣@ is assigned early to the
  --   dual vector @𝑣'@, then @(𝑣' $ 𝑣)@ should be large and all the other products
  --   comparably small.
  -- 
  --   The purpose is that we should be able to make this basis orthonormal
  --   with a ~Gaussian-elimination approach, in a way that stays numerically
  --   stable. This is otherwise known as the /choice of a pivot element/.
  -- 
  --   For simple finite-dimensional array-vectors, you can easily define this
  --   method using 'cartesianDualBasisCandidates'.
  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)
  -- Delegate to the transposed tensor. This is a hack that will sooner or
  -- later catch up with us. TODO: make a proper implementation.
  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.
VSCCoercion (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.
VSCCoercion (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor)

cartesianDualBasisCandidates
     :: [DualVector v]  -- ^ Set of canonical basis functionals.
     -> (v -> [ℝ])      -- ^ Decompose a vector in /absolute value/ components.
                        --   the list indices should correspond to those in
                        --   the functional list.
     -> ([(Int,v)] -> Forest (Int, DualVector v))
                        -- ^ Suitable definition of 'dualBasisCandidates'.
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 -- ^ Dual vectors needed for complete dual basis
                       -> Int -- ^ Maximum numbers of alternatives to consider
                              --   (to prevent exponential blowup of possibilities)
                       -> 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.
VSCCoercion (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.
VSCCoercion (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    -- ^ “Bias flag”: iff True, v will be preferred.
                 -> Set Int -- ^ Set of already-assigned basis indices.
                 -> ( 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  -- ^ @Just True@: prefer v⊗v, @Nothing@: prefer u⊗v
                 -> 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.
VSCCoercion (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.
VSCCoercion (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 :: forall w.
(SemiInner w, Scalar w ~ Scalar (Tensor s u v)) =>
[(Int, Tensor s u v ⊗ w)]
-> Forest (Int, DualVector (Tensor s u v ⊗ 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
$ 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.
VSCCoercion (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, Scalar u ~ s) =>
VSCCoercion
  (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 :: forall w.
(SemiInner w, Scalar w ~ Scalar (LinearMap s u v)) =>
[(Int, LinearMap s u v ⊗ w)]
-> Forest (Int, DualVector (LinearMap s u v ⊗ 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
$ 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.
VSCCoercion
  (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) =>
VSCCoercion
  (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
  -- | Whereas 'Basis'-values refer to a single basis vector, a single
  --   'SubBasis' value represents a collection of such basis vectors,
  --   which can be used to associate a vector with a list of coefficients.
  -- 
  --   For spaces with a canonical finite basis, 'SubBasis' does not actually
  --   need to contain any information, it can simply have the full finite
  --   basis as its only value. Even for large sparse spaces, it should only
  --   have a very coarse structure that can be shared by many vectors.
  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
  
  -- | Split up a linear map in “column vectors” WRT some suitable basis.
  decomposeLinMap :: (LSpace w, Scalar w ~ Scalar v) => (v+>w) -> (SubBasis v, DList w)
  
  -- | Expand in the given basis, if possible. Else yield a superbasis of the given
  --   one, in which this /is/ possible, and the decomposition therein.
  decomposeLinMapWithin :: (LSpace w, Scalar w ~ Scalar v)
      => SubBasis v -> (v+>w) -> Either (SubBasis v, DList w) (DList w)
  
  -- | Assemble a vector from coefficients in some basis. Return any excess coefficients.
  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])
  
  -- | Given a function that interprets a coefficient-container as a vector representation,
  --   build a linear function mapping to that space.
  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
  
  -- | The existance of a finite basis gives us an isomorphism between a space
  --   and its dual space. Note that this isomorphism is not natural (i.e. it
  --   depends on the actual choice of basis, unlike everything else in this
  --   library).
  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, Scalar u ~ s) =>
VSCCoercion
  (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 (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 (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 (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 (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, Scalar u ~ s) =>
VSCCoercion
  (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 (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, Scalar u ~ s) =>
VSCCoercion
  (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 (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, Scalar u ~ s) =>
VSCCoercion
  (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) =>
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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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.
VSCCoercion (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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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.
VSCCoercion (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.
VSCCoercion (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) =>
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
                           -- dim Sym(𝑘,𝑉) = nCr (dim 𝑉 + 𝑘 - 1, 𝑘)
                           -- dim Sym(2,𝑉) = nCr (𝑛 + 1, 2) = 𝑛⋅(𝑛+1)/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 (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.
VSCCoercion (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.
VSCCoercion (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.
VSCCoercion (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
           = 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.
VSCCoercion (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.
VSCCoercion (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 (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 (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) =>
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 a b. VSCCoercion a b -> Coercion a b
getVSCCoercion forall s v w.
(LinearSpace v, Scalar v ~ s) =>
VSCCoercion (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.
VSCCoercion (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) =>
VSCCoercion
  (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 (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) =>
VSCCoercion
  (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 (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, Scalar u ~ s) =>
VSCCoercion
  (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) =>
VSCCoercion
  (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, Scalar u ~ s) =>
VSCCoercion
  (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) =>
VSCCoercion
  (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) =>
VSCCoercion
  (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 (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) =>
VSCCoercion
  (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.
VSCCoercion (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.
VSCCoercion (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) =>
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 \$

-- | Inverse function application, aka solving of a linear system:
--   
-- @
-- f '\$' f '$' v  ≡  v
-- 
-- f '$' f '\$' u  ≡  u
-- @
-- 
-- If @f@ does not have full rank, the behaviour is undefined. However, it
-- does not need to be a proper isomorphism: the
-- first of the above equations is still fulfilled if only @f@ is /injective/
-- (overdetermined system) and the second if it is /surjective/.
-- 
-- If you want to solve for multiple RHS vectors, be sure to partially
-- apply this operator to the linear map, like
-- 
-- @
-- map (f '\$') [v₁, v₂, ...]
-- @
-- 
-- Since most of the work is actually done in triangularising the operator,
-- this may be much faster than
-- 
-- @
-- [f '\$' v₁, f '\$' v₂, ...]
-- @
(\$) :: ∀ 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)

-- | If @f@ is injective, then
-- 
-- @
-- unsafeLeftInverse f . f  ≡  id
-- @
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

-- | If @f@ is surjective, then
-- 
-- @
-- f . unsafeRightInverse f  ≡  id
-- @
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

-- | Invert an isomorphism. For other linear maps, the result is undefined.
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


-- | The <https://en.wikipedia.org/wiki/Riesz_representation_theorem Riesz representation theorem>
--   provides an isomorphism between a Hilbert space and its (continuous) dual space.
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.
VSCCoercion (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

-- | Functions are generally a pain to display, but since linear functionals
--   in a Hilbert space can be represented by /vectors/ in that space,
--   this can be used for implementing a 'Show' instance.
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 (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 +> (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 (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
. 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 .<

-- | Outer product of a general @v@-vector and a basis element from @w@.
--   Note that this operation is in general pretty inefficient; it is
--   provided mostly to lay out matrix definitions neatly.
(.<) :: ( 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')]


-- | This is the preferred method for showing linear maps, resulting in a
--   matrix view involving the '.<' operator.
--   We don't provide a generic `Show` instance; to make linear maps with
--   your own finite-dimensional type @V@ (with scalar @S@) showable,
--   this is the recommended way:
--
--   @
--   instance RieszDecomposable V where
--     rieszDecomposition = ...
--   instance (FiniteDimensional w, w ~ DualVector w, Scalar w ~ S, Show w)
--         => Show (LinearMap S w V) where
--     showsPrec = rieszDecomposeShowsPrec
--   @
-- 
--   Note that the custom type should always be the /codomain/ type, whereas
--   the domain should be kept parametric.
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 :: v⊗w -> [(Basis v, w)]
  showsPrecBasis :: Int -> Basis v -> ShowS

instance TensorDecomposable ℝ where
  tensorDecomposition :: forall w. (ℝ ⊗ w) -> [(Basis ℝ, w)]
tensorDecomposition (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. ((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 => (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 => (v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor (Scalar y) y w
ty)
  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. (ZeroDim ℝ ⊗ w) -> [(Basis (ZeroDim ℝ), w)]
tensorDecomposition ZeroDim ℝ ⊗ w
_ = []
  showsPrecBasis :: Int -> Basis (ZeroDim ℝ) -> ShowS
showsPrecBasis Int
_ = forall a. Void -> a
absurd
instance TensorDecomposable (V0 ℝ) where
  tensorDecomposition :: forall w. (V0 ℝ ⊗ w) -> [(Basis (V0 ℝ), w)]
tensorDecomposition V0 ℝ ⊗ w
_ = []
#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)]
  showsPrecBasis = showsPrec
#else
  tensorDecomposition :: forall w. (V1 ℝ ⊗ w) -> [(Basis (V1 ℝ), w)]
tensorDecomposition (Tensor (V1 w
w)) = [(forall (t :: * -> *). R1 t => E t
ex, w
w)]
  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) ]
  showsPrecBasis = showsPrec
#else
  tensorDecomposition :: forall w. (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) ]
  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) ]
  showsPrecBasis = showsPrec
#else
  tensorDecomposition :: forall w. (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) ]
  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)]
  showsPrecBasis = showsPrec
#else
  tensorDecomposition :: forall w. (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) ]
  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

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 => (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


(^) :: 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 (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 (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)
                                     
  

-- | For real matrices, this boils down to 'transpose'.
--   For free complex spaces it also incurs complex conjugation.
--   
-- The signature can also be understood as
--
-- @
-- adjoint :: (v +> w) -> (DualVector w +> DualVector v)
-- @
-- 
-- Or
--
-- @
-- adjoint :: (DualVector v +> DualVector w) -> (w +> v)
-- @
-- 
-- But /not/ @(v+>w) -> (w+>v)@, in general (though in a Hilbert space, this too is
-- equivalent, via 'riesz' isomorphism).
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.
VSCCoercion (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.
VSCCoercion (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