-- |
-- 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 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 ( DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
                     , DualSpaceWitness w
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w
                     , ScalarSpaceWitness v
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v ) of
         (DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness, ScalarSpaceWitness v
ScalarSpaceWitness)
             -> ((Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
 -> (Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v)))
-> [(Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)]
-> [(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w
 -> Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
-> (Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
-> (Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w
  -> Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
 -> (Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
 -> (Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v)))
-> (Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w
    -> Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
-> (Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
-> (Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction
  (Scalar v)
  (Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
  (Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
-> Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w
-> Tensor (Scalar w) w (SymmetricTensor (Scalar v) v)
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  (Scalar v)
  (Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)
  (Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor)
                  ([(Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)]
 -> [(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))])
-> ([(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))]
    -> [Tree
          (Int,
           LinearMap
             (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))])
-> [(Int, Tensor (Scalar v) (SymmetricTensor (Scalar v) v) w)]
-> [Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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
>>> [(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))]
-> [Tree
      (Int,
       LinearMap
         (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                  ([(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))]
 -> [Tree
       (Int,
        LinearMap
          (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))])
-> ([Tree
       (Int,
        LinearMap
          (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))]
    -> [Tree
          (Int,
           LinearMap
             (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))])
-> [(Int, Tensor (Scalar w) w (SymmetricTensor (Scalar v) v))]
-> [Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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
>>> (Tree
   (Int,
    LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
 -> Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
-> [Tree
      (Int,
       LinearMap
         (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))]
-> [Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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 (((Int,
  LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
 -> (Int,
     LinearMap
       (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
-> Tree
     (Int,
      LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
-> Tree
     (Int,
      LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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 (((Int,
   LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
  -> (Int,
      LinearMap
        (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
 -> Tree
      (Int,
       LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
 -> Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
-> ((LinearMap
       (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
     -> LinearMap
          (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
    -> (Int,
        LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
    -> (Int,
        LinearMap
          (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
-> (LinearMap
      (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
    -> LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> Tree
     (Int,
      LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
-> Tree
     (Int,
      LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
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) w (SymmetricTensor (Scalar v) (DualVector v))
 -> LinearMap
      (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> (Int,
    LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
-> (Int,
    LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((LinearMap
    (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
  -> LinearMap
       (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
 -> Tree
      (Int,
       LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
 -> Tree
      (Int,
       LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)))
-> (LinearMap
      (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
    -> LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> Tree
     (Int,
      LinearMap (Scalar w) w (SymmetricTensor (Scalar v) (DualVector v)))
-> Tree
     (Int,
      LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                        Coercion
  (LinearMap
     (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v)))
  (Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v)))
-> LinearMap
     (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
-> Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v))
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 Coercion
  (LinearMap
     (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v)))
  (Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v)))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor (LinearMap (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
 -> Tensor
      (Scalar v)
      (DualVector w)
      (SymmetricTensor (Scalar v) (DualVector v)))
-> (Tensor
      (Scalar v)
      (DualVector w)
      (SymmetricTensor (Scalar v) (DualVector v))
    -> LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> LinearMap
     (Scalar v) w (SymmetricTensor (Scalar v) (DualVector v))
-> LinearMap
     (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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
>>> LinearFunction
  (Scalar v)
  (Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v)))
  (Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w))
-> Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v))
-> Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w)
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
  (Scalar v)
  (Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v)))
  (Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor (Tensor
   (Scalar v)
   (DualVector w)
   (SymmetricTensor (Scalar v) (DualVector v))
 -> Tensor
      (Scalar v)
      (SymmetricTensor (Scalar v) (DualVector v))
      (DualVector w))
-> (Tensor
      (Scalar v)
      (SymmetricTensor (Scalar v) (DualVector v))
      (DualVector w)
    -> LinearMap
         (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> Tensor
     (Scalar v)
     (DualVector w)
     (SymmetricTensor (Scalar v) (DualVector v))
-> LinearMap
     (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector 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
>>> Coercion
  (Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w))
  (LinearMap
     (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
-> Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w)
-> LinearMap
     (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w)
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 Coercion
  (Tensor
     (Scalar v)
     (SymmetricTensor (Scalar v) (DualVector v))
     (DualVector w))
  (LinearMap
     (Scalar v) (SymmetricTensor (Scalar v) v) (DualVector w))
forall s v w.
Coercion (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 :: [DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates [DualVector v]
dvs v -> [ℝ]
abss [(Int, v)]
vcas = Int -> Int -> [(Int, ([ℝ], ℝ))] -> Forest (Int, DualVector v)
go Int
0 Int
0 [(Int, ([ℝ], ℝ))]
sorted
 where sorted :: [(Int, ([ℝ], ℝ))]
sorted = ((Int, ([ℝ], ℝ)) -> (Int, ([ℝ], ℝ)) -> Ordering)
-> [(Int, ([ℝ], ℝ))] -> [(Int, ([ℝ], ℝ))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, ([ℝ], ℝ)) -> ℝ)
-> (Int, ([ℝ], ℝ)) -> (Int, ([ℝ], ℝ)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, ([ℝ], ℝ)) -> ℝ)
 -> (Int, ([ℝ], ℝ)) -> (Int, ([ℝ], ℝ)) -> Ordering)
-> ((Int, ([ℝ], ℝ)) -> ℝ)
-> (Int, ([ℝ], ℝ))
-> (Int, ([ℝ], ℝ))
-> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ
forall a. Num a => a -> a
negate (ℝ -> ℝ) -> ((Int, ([ℝ], ℝ)) -> ℝ) -> (Int, ([ℝ], ℝ)) -> ℝ
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, ([ℝ], ℝ)) -> ([ℝ], ℝ)) -> (Int, ([ℝ], ℝ)) -> ℝ
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, ([ℝ], ℝ)) -> ([ℝ], ℝ)
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, ([ℝ], ℝ))] -> Forest (Int, DualVector v)
go Int
k Int
nDelay scs :: [(Int, ([ℝ], ℝ))]
scs@((Int
i,([ℝ]
av,ℝ
_)):[(Int, ([ℝ], ℝ))]
scs')
          | Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n   = (Int, DualVector v)
-> Forest (Int, DualVector v) -> Tree (Int, DualVector v)
forall a. a -> Forest a -> Tree a
Node (Int
i, DualVector v
dv) (Int -> Int -> [(Int, ([ℝ], ℝ))] -> Forest (Int, DualVector v)
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0 [(Int
i',(Int -> [ℝ] -> [ℝ]
zeroAt Int
j [ℝ]
av',ℝ
m)) | (Int
i',([ℝ]
av',ℝ
m))<-[(Int, ([ℝ], ℝ))]
scs'])
                                Tree (Int, DualVector v)
-> Forest (Int, DualVector v) -> Forest (Int, DualVector v)
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, ([ℝ], ℝ))] -> Forest (Int, DualVector v)
go Int
k (Int
nDelayInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> [(Int, ([ℝ], ℝ))] -> [(Int, ([ℝ], ℝ))]
forall a. Int -> [a] -> [a]
bringToFront (Int
nDelayInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, ([ℝ], ℝ))]
scs)
        where (Int
j,ℝ
_) = ((Int, ℝ) -> (Int, ℝ) -> Ordering) -> [(Int, ℝ)] -> (Int, ℝ)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) ([(Int, ℝ)] -> (Int, ℝ)) -> [(Int, ℝ)] -> (Int, ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Int] -> [ℝ] -> [(Int, ℝ)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
jfus [ℝ]
av
              dv :: DualVector v
dv = [DualVector v]
dvs [DualVector v] -> Int -> DualVector v
forall a. [a] -> Int -> a
!! Int
j
       go Int
_ Int
_ [(Int, ([ℝ], ℝ))]
_ = []
       
       jfus :: [Int]
jfus = [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
       n :: Int
n = [DualVector v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
dvs
       
       zeroAt :: Int -> [ℝ] -> [ℝ]
       zeroAt :: Int -> [ℝ] -> [ℝ]
zeroAt Int
_ [] = []
       zeroAt Int
0 (ℝ
_:[ℝ]
l) = (-ℝ
1ℝ -> ℝ -> ℝ
forall 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
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ℝ]
l
       
       bringToFront :: Int -> [a] -> [a]
       bringToFront :: Int -> [a] -> [a]
bringToFront Int
i [a]
l = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
l of
           ([a]
_,[]) -> []
           ([a]
f,a
s:[a]
l') -> a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
f[a] -> [a] -> [a]
forall 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 :: [(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 :: [(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 :: Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals = DualSpaceWitness v
-> Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
od DualSpaceWitness v
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'₀):[(v, DualVector v)]
ws)
         | Scalar v -> Scalar v
forall a. Num a => a -> a
abs Scalar v
ovl₀ Scalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
> Scalar v
0, Scalar v -> Scalar v
forall a. Num a => a -> a
abs Scalar v
ovl₁ Scalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
> Scalar v
ε
                        = (v
v,DualVector v -> Maybe (DualVector v)
forall a. a -> Maybe a
Just DualVector v
v')
                        (v, Maybe (DualVector v))
-> [(v, Maybe (DualVector v))] -> [(v, Maybe (DualVector v))]
forall a. a -> [a] -> [a]
: [ (v
w, (DualVector v -> DualVector v)
-> Maybe (DualVector v) -> Maybe (DualVector v)
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' DualVector v -> DualVector v -> DualVector v
forall v. AdditiveGroup v => v -> v -> v
^-^ (DualVector v
w'DualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v)Scalar (DualVector v) -> DualVector v -> DualVector 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,Maybe (DualVector v)
forall a. Maybe a
Nothing) (v, Maybe (DualVector v))
-> [(v, Maybe (DualVector v))] -> [(v, Maybe (DualVector v))]
forall a. a -> [a] -> [a]
: [(v, Maybe (DualVector v))]
wssys
        where wssys :: [(v, Maybe (DualVector v))]
wssys = Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
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'₁ = (DualVector v -> (v, Maybe (DualVector v)) -> DualVector v)
-> DualVector v -> [(v, Maybe (DualVector v))] -> DualVector 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)
                             -> (DualVector v -> DualVector v -> DualVector v)
-> DualVector v -> Maybe (DualVector v) -> DualVector v
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 DualVector v -> DualVector v -> DualVector v
forall v. AdditiveGroup v => v -> v -> v
^-^ (DualVector v
v'iDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
w)Scalar (DualVector v) -> DualVector v -> DualVector v
forall v. VectorSpace v => Scalar v -> v -> v
*^DualVector v
w') DualVector v
v'i₀ Maybe (DualVector v)
w's)
                           (DualVector v
v'₀ DualVector v -> Scalar v -> DualVector 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'₁ DualVector v -> Scalar v -> DualVector v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
ovl₁
              ovl₀ :: Scalar v
ovl₀ = DualVector v
v'₀DualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v
              ovl₁ :: Scalar v
ovl₁ = DualVector v
v'₁DualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
v

dualBasis :: ∀ v . (SemiInner v, RealFrac' (Scalar v))
                => [v] -> [Maybe (DualVector v)]
dualBasis :: [v] -> [Maybe (DualVector v)]
dualBasis [v]
vs = (v, Maybe (DualVector v)) -> Maybe (DualVector v)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((v, Maybe (DualVector v)) -> Maybe (DualVector v))
-> [(v, Maybe (DualVector v))] -> [Maybe (DualVector v)]
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
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
j   = [(a, a)] -> [(a, b)] -> [(a, b)]
zip' [(a, a)]
vs ((a
j,b
v')(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ds)
        | a
ia -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
j  = (a
v,b
v') (a, b) -> [(a, b)] -> [(a, b)]
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 (Forest (Int, DualVector v)
 -> Either
      (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)])
-> Forest (Int, DualVector v)
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(Int, v)] -> Forest (Int, DualVector v)
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates [(Int, v)]
vsIxed of
                       Right [(Int, DualVector v)]
bestCandidates
                           -> Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals Scalar v
forall a. IEEE a => a
epsilon
                                 ([(Int, v)] -> [(Int, DualVector v)] -> [(v, DualVector v)]
forall a a b. Ord a => [(a, a)] -> [(a, b)] -> [(a, b)]
zip' [(Int, v)]
vsIxed ([(Int, DualVector v)] -> [(v, DualVector v)])
-> [(Int, DualVector v)] -> [(v, DualVector v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Int, DualVector v) -> (Int, DualVector v) -> Ordering)
-> [(Int, DualVector v)] -> [(Int, DualVector v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, DualVector v) -> Int)
-> (Int, DualVector v) -> (Int, DualVector v) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, DualVector v) -> Int
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)
                                    = ([(Int, DualVector v)] -> [(Int, DualVector v)])
-> ([Int], [(Int, DualVector v)]) -> ([Int], [(Int, DualVector v)])
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (((Int, DualVector v) -> (Int, DualVector v) -> Ordering)
-> [(Int, DualVector v)] -> [(Int, DualVector v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, DualVector v) -> (Int, DualVector v) -> Ordering)
 -> [(Int, DualVector v)] -> [(Int, DualVector v)])
-> ((Int, DualVector v) -> (Int, DualVector v) -> Ordering)
-> [(Int, DualVector v)]
-> [(Int, DualVector v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Int, DualVector v) -> Int)
-> (Int, DualVector v) -> (Int, DualVector v) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, DualVector v) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                        (([Int], [(Int, DualVector v)]) -> ([Int], [(Int, DualVector v)]))
-> ([Int], [(Int, DualVector v)]) -> ([Int], [(Int, DualVector v)])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Int, Maybe (DualVector v)) -> Int + (Int, DualVector v))
-> [(Int, Maybe (DualVector v))] -> ([Int], [(Int, DualVector v)])
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) -> Int -> Int + (Int, DualVector v)
forall a b. a -> Either a b
Left Int
i
                                                       (Int
i,Just DualVector v
v') -> (Int, DualVector v) -> Int + (Int, DualVector 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 = Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
Scalar v -> [(v, DualVector v)] -> [(v, Maybe (DualVector v))]
orthonormaliseDuals Scalar v
forall a. IEEE a => a
epsilon
                                    [ (Vector v
lookupArr Vector v -> Int -> v
forall a. Vector a -> Int -> a
Arr.! Int
i, DualVector v
v')
                                    | (Int
i,DualVector v
v') <- [(Int, DualVector v)]
survivors ]
                              in ((Int, (v, Maybe (DualVector v))) -> (v, Maybe (DualVector v)))
-> [(Int, (v, Maybe (DualVector v)))]
-> [(v, Maybe (DualVector v))]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (v, Maybe (DualVector v))) -> (v, Maybe (DualVector v))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ([(Int, (v, Maybe (DualVector v)))] -> [(v, Maybe (DualVector v))])
-> ([(Int, (v, Maybe (DualVector v)))]
    -> [(Int, (v, Maybe (DualVector v)))])
-> [(Int, (v, Maybe (DualVector v)))]
-> [(v, Maybe (DualVector v))]
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, (v, Maybe (DualVector v)))
 -> (Int, (v, Maybe (DualVector v))) -> Ordering)
-> [(Int, (v, Maybe (DualVector v)))]
-> [(Int, (v, Maybe (DualVector v)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (v, Maybe (DualVector v))) -> Int)
-> (Int, (v, Maybe (DualVector v)))
-> (Int, (v, Maybe (DualVector v)))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (v, Maybe (DualVector v))) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                   ([(Int, (v, Maybe (DualVector v)))] -> [(v, Maybe (DualVector v))])
-> [(Int, (v, Maybe (DualVector v)))]
-> [(v, Maybe (DualVector v))]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Int, DualVector v)
 -> (v, Maybe (DualVector v)) -> (Int, (v, Maybe (DualVector v))))
-> [(Int, DualVector v)]
-> [(v, Maybe (DualVector v))]
-> [(Int, (v, Maybe (DualVector v)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((,) (Int
 -> (v, Maybe (DualVector v)) -> (Int, (v, Maybe (DualVector v))))
-> ((Int, DualVector v) -> Int)
-> (Int, DualVector v)
-> (v, Maybe (DualVector v))
-> (Int, (v, Maybe (DualVector v)))
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, DualVector v) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) [(Int, DualVector v)]
survivors [(v, Maybe (DualVector v))]
bestEffort
                                  [(Int, (v, Maybe (DualVector v)))]
-> [(Int, (v, Maybe (DualVector v)))]
-> [(Int, (v, Maybe (DualVector v)))]
forall a. [a] -> [a] -> [a]
++ [ (Int
i,(Vector v
lookupArr Vector v -> Int -> v
forall a. Vector a -> Int -> a
Arr.! Int
i, Maybe (DualVector v)
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)
_ = [(Int, DualVector v)]
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall a b. b -> Either a b
Right []
              findBest Int
nMissing Int
_ [] = (Int, [(Int, Maybe (DualVector v))])
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
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 = [(Int, DualVector v)]
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall a b. b -> Either a b
Right ([(Int, DualVector v)]
 -> Either
      (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)])
-> [(Int, DualVector v)]
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int
i,DualVector v
v') (Int, DualVector v)
-> [(Int, DualVector v)] -> [(Int, DualVector v)]
forall a. a -> [a] -> [a]
: [(Int, DualVector v)]
best'
                | Int
maxCompromises Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                , Right [(Int, DualVector v)]
goodAlt <- Either (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
alternative = [(Int, DualVector v)]
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
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 -> (Int, [(Int, Maybe (DualVector v))])
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall a b. a -> Either a b
Left (Int
1, (DualVector v -> Maybe (DualVector v))
-> (Int, DualVector v) -> (Int, Maybe (DualVector v))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second DualVector v -> Maybe (DualVector v)
forall a. a -> Maybe a
Just ((Int, DualVector v) -> (Int, Maybe (DualVector v)))
-> [(Int, DualVector v)] -> [(Int, Maybe (DualVector v))]
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nBad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
myBadness
                                       -> (Int, [(Int, Maybe (DualVector v))])
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall a b. a -> Either a b
Left (Int
nBadAlt, [(Int, Maybe (DualVector v))]
badAlt)
                           | Bool
otherwise -> (Int, [(Int, Maybe (DualVector v))])
-> Either
     (Int, [(Int, Maybe (DualVector v))]) [(Int, DualVector v)]
forall a b. a -> Either a b
Left ( Int
nBad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
myBadness
                                               , (Int
i, Maybe (DualVector v)
guardedv') (Int, Maybe (DualVector v))
-> [(Int, Maybe (DualVector v))] -> [(Int, Maybe (DualVector v))]
forall a. a -> [a] -> [a]
: [(Int, Maybe (DualVector v))]
badAnyway )
               where guardedv' :: Maybe (DualVector v)
guardedv' = case DualVector v
v'DualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^(Vector v
lookupArr Vector v -> Int -> v
forall a. Vector a -> Int -> a
Arr.! Int
i) of
                                   Scalar v
0 -> Maybe (DualVector v)
forall a. Maybe a
Nothing
                                   Scalar v
_ -> DualVector v -> Maybe (DualVector 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
maxCompromisesInt -> Int -> Int
forall 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
maxCompromisesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Forest (Int, DualVector v)
alts
       vsIxed :: [(Int, v)]
vsIxed = [Int] -> [v] -> [(Int, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [v]
vs
       lookupArr :: Vector v
lookupArr = [v] -> Vector v
forall a. [a] -> Vector a
Arr.fromList [v]
vs
       n :: Int
n = Vector v -> Int
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' :: [DualVector v] -> [Maybe v]
dualBasis' = case DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
      DualSpaceWitness v
DualSpaceWitness -> [DualVector v] -> [Maybe v]
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 :: (a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith a -> b -> c
f = StateT [b] Maybe (t c) -> [b] -> Maybe (t c)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT [b] Maybe (t c) -> [b] -> Maybe (t c))
-> (t a -> StateT [b] Maybe (t c)) -> t a -> [b] -> Maybe (t c)
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 -> StateT [b] Maybe c) -> t a -> StateT [b] Maybe (t 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 <- StateT [b] Maybe [b]
forall (m :: * -> *) s. Monad m => StateT s m s
get
           case [b]
bs of
              [] -> ([b] -> Maybe (c, [b])) -> StateT [b] Maybe c
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (([b] -> Maybe (c, [b])) -> StateT [b] Maybe c)
-> ([b] -> Maybe (c, [b])) -> StateT [b] Maybe c
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Maybe (c, [b]) -> [b] -> Maybe (c, [b])
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const Maybe (c, [b])
forall a. Maybe a
Nothing
              (b
b:[b]
bs') -> [b] -> StateT [b] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
bs' StateT [b] Maybe () -> StateT [b] Maybe c -> StateT [b] Maybe c
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)
>> c -> StateT [b] Maybe c
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 :: t v -> Maybe (ReifiedLens' v (t (Scalar v)))
embedFreeSubspace t v
vs = ((v -> t (Scalar v), v -> t (Scalar v) -> v)
 -> ReifiedLens' v (t (Scalar v)))
-> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
-> Maybe (ReifiedLens' v (t (Scalar v)))
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) -> Lens v v (t (Scalar v)) (t (Scalar v))
-> ReifiedLens' v (t (Scalar v))
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens ((v -> t (Scalar v))
-> (v -> t (Scalar v) -> v)
-> Lens v v (t (Scalar v)) (t (Scalar v))
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 = t v -> [v]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t v
vs
       result :: Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
result = ([DualVector v] -> (v -> t (Scalar v), v -> t (Scalar v) -> v))
-> Maybe [DualVector v]
-> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
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)
genGet([DualVector v] -> v -> t (Scalar v))
-> ([DualVector v] -> v -> t (Scalar v) -> v)
-> [DualVector v]
-> (v -> t (Scalar v), v -> t (Scalar v) -> v)
forall (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) (Maybe [DualVector v]
 -> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v))
-> ([Maybe (DualVector v)] -> Maybe [DualVector v])
-> [Maybe (DualVector v)]
-> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
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
. [Maybe (DualVector v)] -> Maybe [DualVector v]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([Maybe (DualVector v)]
 -> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v))
-> [Maybe (DualVector v)]
-> Maybe (v -> t (Scalar v), v -> t (Scalar v) -> v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [v] -> [Maybe (DualVector v)]
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 (v -> DualVector v -> Scalar v)
-> t v -> [DualVector v] -> Maybe (t (Scalar v))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith (\v
_v DualVector v
dv -> DualVector v
dvDualVector v -> v -> Scalar v
forall 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 -> [Char] -> t (Scalar v)
forall a. HasCallStack => [Char] -> a
error ([Char] -> t (Scalar v)) -> [Char] -> t (Scalar v)
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 "
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vsList)
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" vectors and " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([DualVector v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
vsDuals)
                                 [Char] -> [Char] -> [Char]
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 (Scalar v -> (v, DualVector v) -> (Scalar v, (v, DualVector v)))
-> t (Scalar v)
-> [(v, DualVector v)]
-> Maybe (t (Scalar v, (v, DualVector v)))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> c) -> t a -> [b] -> Maybe (t c)
zipTravWith (,) t (Scalar v)
coefs ([(v, DualVector v)] -> Maybe (t (Scalar v, (v, DualVector v))))
-> [(v, DualVector v)] -> Maybe (t (Scalar v, (v, DualVector v)))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [v] -> [DualVector v] -> [(v, DualVector v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vsList [DualVector v]
vsDuals of
                Just t (Scalar v, (v, DualVector v))
updators -> (v -> (Scalar v, (v, DualVector v)) -> v)
-> v -> t (Scalar v, (v, DualVector v)) -> v
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 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
vv -> Scalar v -> v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*(Scalar v
c Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
- DualVector v
v'DualVector v -> v -> Scalar 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 -> [Char] -> v
forall a. HasCallStack => [Char] -> a
error ([Char] -> v) -> [Char] -> v
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 "
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vsList)
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" vectors, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([DualVector v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DualVector v]
vsDuals)
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" dual vectors and "
                                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (t (Scalar v) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t (Scalar v)
coefs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" coefficients."


instance SemiInner ℝ where
  dualBasisCandidates :: [(Int, ℝ)] -> Forest (Int, DualVector ℝ)
dualBasisCandidates = ((Int, ℝ) -> Tree (Int, ℝ)) -> [(Int, ℝ)] -> [Tree (Int, ℝ)]
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, ℝ) -> [Tree (Int, ℝ)] -> Tree (Int, ℝ)
forall a. a -> Forest a -> Tree a
`Node`[]) ((Int, ℝ) -> Tree (Int, ℝ))
-> ((Int, ℝ) -> (Int, ℝ)) -> (Int, ℝ) -> Tree (Int, ℝ)
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, ℝ) -> (Int, ℝ)
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)
                ([(Int, ℝ)] -> [Tree (Int, ℝ)])
-> ([(Int, ℝ)] -> [(Int, ℝ)]) -> [(Int, ℝ)] -> [Tree (Int, ℝ)]
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, ℝ) -> (Int, ℝ) -> Ordering) -> [(Int, ℝ)] -> [(Int, ℝ)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering)
-> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ
forall a. Num a => a -> a
negate (ℝ -> ℝ) -> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> ℝ
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 (ℝ -> ℝ) -> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> ℝ
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, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                ([(Int, ℝ)] -> [(Int, ℝ)])
-> ([(Int, ℝ)] -> [(Int, ℝ)]) -> [(Int, ℝ)] -> [(Int, ℝ)]
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, ℝ) -> Bool) -> [(Int, ℝ)] -> [(Int, ℝ)]
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 ((ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
/=ℝ
0) (ℝ -> Bool) -> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> Bool
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, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
  tensorDualBasisCandidates :: [(Int, ℝ ⊗ w)] -> Forest (Int, DualVector (ℝ ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor ℝ ℝ w) -> (Int, w))
-> [(Int, Tensor ℝ ℝ w)] -> [(Int, w)]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor ℝ ℝ w -> w) -> (Int, Tensor ℝ ℝ w) -> (Int, w)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second Tensor ℝ ℝ w -> w
forall s v w. Tensor s v w -> TensorProduct v w
getTensorProduct)
                 ([(Int, Tensor ℝ ℝ w)] -> [(Int, w)])
-> ([(Int, w)] -> [Tree (Int, LinearMap ℝ ℝ (DualVector w))])
-> [(Int, Tensor ℝ ℝ w)]
-> [Tree (Int, LinearMap ℝ ℝ (DualVector 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
>>> [(Int, w)] -> Forest (Int, DualVector w)
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, w)] -> Forest (Int, DualVector w))
-> (Forest (Int, DualVector w)
    -> [Tree (Int, LinearMap ℝ ℝ (DualVector w))])
-> [(Int, w)]
-> [Tree (Int, LinearMap ℝ ℝ (DualVector 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
>>> (Tree (Int, DualVector w)
 -> Tree (Int, LinearMap ℝ ℝ (DualVector w)))
-> Forest (Int, DualVector w)
-> [Tree (Int, LinearMap ℝ ℝ (DualVector 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 (((Int, DualVector w) -> (Int, LinearMap ℝ ℝ (DualVector w)))
-> Tree (Int, DualVector w)
-> Tree (Int, LinearMap ℝ ℝ (DualVector 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 (((Int, DualVector w) -> (Int, LinearMap ℝ ℝ (DualVector w)))
 -> Tree (Int, DualVector w)
 -> Tree (Int, LinearMap ℝ ℝ (DualVector w)))
-> ((Int, DualVector w) -> (Int, LinearMap ℝ ℝ (DualVector w)))
-> Tree (Int, DualVector w)
-> Tree (Int, LinearMap ℝ ℝ (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (DualVector w -> LinearMap ℝ ℝ (DualVector w))
-> (Int, DualVector w) -> (Int, LinearMap ℝ ℝ (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second DualVector w -> LinearMap ℝ ℝ (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap)
  symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar ℝ) ℝ)]
-> Forest (Int, SymmetricTensor (Scalar ℝ) (DualVector ℝ))
symTensorDualBasisCandidates = ((Int, SymmetricTensor ℝ ℝ) -> (Int, Tensor ℝ ℝ ℝ))
-> [(Int, SymmetricTensor ℝ ℝ)] -> [(Int, Tensor ℝ ℝ ℝ)]
forall a b. (a -> b) -> [a] -> [b]
map ((SymmetricTensor ℝ ℝ -> Tensor ℝ ℝ ℝ)
-> (Int, SymmetricTensor ℝ ℝ) -> (Int, Tensor ℝ ℝ ℝ)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second SymmetricTensor ℝ ℝ -> Tensor ℝ ℝ ℝ
forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor)
                 ([(Int, SymmetricTensor ℝ ℝ)] -> [(Int, Tensor ℝ ℝ ℝ)])
-> ([(Int, Tensor ℝ ℝ ℝ)] -> [Tree (Int, SymmetricTensor ℝ ℝ)])
-> [(Int, SymmetricTensor ℝ ℝ)]
-> [Tree (Int, SymmetricTensor ℝ ℝ)]
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
>>> [(Int, Tensor ℝ ℝ ℝ)] -> [Tree (Int, LinearMap ℝ ℝ ℝ)]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, Tensor ℝ ℝ ℝ)] -> [Tree (Int, LinearMap ℝ ℝ ℝ)])
-> ([Tree (Int, LinearMap ℝ ℝ ℝ)]
    -> [Tree (Int, SymmetricTensor ℝ ℝ)])
-> [(Int, Tensor ℝ ℝ ℝ)]
-> [Tree (Int, SymmetricTensor ℝ ℝ)]
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
>>> (Tree (Int, LinearMap ℝ ℝ ℝ) -> Tree (Int, SymmetricTensor ℝ ℝ))
-> [Tree (Int, LinearMap ℝ ℝ ℝ)]
-> [Tree (Int, SymmetricTensor ℝ ℝ)]
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, LinearMap ℝ ℝ ℝ) -> (Int, SymmetricTensor ℝ ℝ))
-> Tree (Int, LinearMap ℝ ℝ ℝ) -> Tree (Int, SymmetricTensor ℝ ℝ)
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, LinearMap ℝ ℝ ℝ) -> (Int, SymmetricTensor ℝ ℝ))
 -> Tree (Int, LinearMap ℝ ℝ ℝ) -> Tree (Int, SymmetricTensor ℝ ℝ))
-> ((Int, LinearMap ℝ ℝ ℝ) -> (Int, SymmetricTensor ℝ ℝ))
-> Tree (Int, LinearMap ℝ ℝ ℝ)
-> Tree (Int, SymmetricTensor ℝ ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap ℝ ℝ ℝ -> SymmetricTensor ℝ ℝ)
-> (Int, LinearMap ℝ ℝ ℝ) -> (Int, SymmetricTensor ℝ ℝ)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (Coercion (LinearMap ℝ ℝ ℝ) (Tensor ℝ ℝ ℝ)
-> LinearMap ℝ ℝ ℝ -> Tensor ℝ ℝ ℝ
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 Coercion (LinearMap ℝ ℝ ℝ) (Tensor ℝ ℝ ℝ)
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor (LinearMap ℝ ℝ ℝ -> Tensor ℝ ℝ ℝ)
-> (Tensor ℝ ℝ ℝ -> SymmetricTensor ℝ ℝ)
-> LinearMap ℝ ℝ ℝ
-> SymmetricTensor ℝ ℝ
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
>>> Tensor ℝ ℝ ℝ -> SymmetricTensor ℝ ℝ
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 = ((Int, V1 s) -> Tree (Int, V1 s))
-> [(Int, V1 s)] -> [Tree (Int, V1 s)]
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, V1 s) -> [Tree (Int, V1 s)] -> Tree (Int, V1 s)
forall a. a -> Forest a -> Tree a
`Node`[]) ((Int, V1 s) -> Tree (Int, V1 s))
-> ((Int, V1 s) -> (Int, V1 s)) -> (Int, V1 s) -> Tree (Int, V1 s)
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
. (V1 s -> V1 s) -> (Int, V1 s) -> (Int, V1 s)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second V1 s -> V1 s
forall a. Fractional a => a -> a
recip)
                ([(Int, V1 s)] -> [Tree (Int, V1 s)])
-> ([(Int, V1 s)] -> [(Int, V1 s)])
-> [(Int, V1 s)]
-> [Tree (Int, V1 s)]
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, V1 s) -> (Int, V1 s) -> Ordering)
-> [(Int, V1 s)] -> [(Int, V1 s)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, V1 s) -> V1 s) -> (Int, V1 s) -> (Int, V1 s) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, V1 s) -> V1 s) -> (Int, V1 s) -> (Int, V1 s) -> Ordering)
-> ((Int, V1 s) -> V1 s) -> (Int, V1 s) -> (Int, V1 s) -> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ V1 s -> V1 s
forall a. Num a => a -> a
negate (V1 s -> V1 s) -> ((Int, V1 s) -> V1 s) -> (Int, V1 s) -> V1 s
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
. V1 s -> V1 s
forall a. Num a => a -> a
abs (V1 s -> V1 s) -> ((Int, V1 s) -> V1 s) -> (Int, V1 s) -> V1 s
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, V1 s) -> V1 s
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                ([(Int, V1 s)] -> [(Int, V1 s)])
-> ([(Int, V1 s)] -> [(Int, V1 s)])
-> [(Int, V1 s)]
-> [(Int, V1 s)]
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, V1 s) -> Bool) -> [(Int, V1 s)] -> [(Int, V1 s)]
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 ((V1 s -> V1 s -> Bool
forall a. Eq a => a -> a -> Bool
/=V1 s
0) (V1 s -> Bool) -> ((Int, V1 s) -> V1 s) -> (Int, V1 s) -> Bool
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, V1 s) -> V1 s
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
  tensorDualBasisCandidates :: [(Int, V1 s ⊗ w)] -> Forest (Int, DualVector (V1 s ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor s (V1 s) w) -> (Int, w))
-> [(Int, Tensor s (V1 s) w)] -> [(Int, w)]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor s (V1 s) w -> w) -> (Int, Tensor s (V1 s) w) -> (Int, w)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor s (V1 s) w -> w) -> (Int, Tensor s (V1 s) w) -> (Int, w))
-> (Tensor s (V1 s) w -> w) -> (Int, Tensor s (V1 s) w) -> (Int, w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V1 w)) -> w
w)
                 ([(Int, Tensor s (V1 s) w)] -> [(Int, w)])
-> ([(Int, w)] -> [Tree (Int, LinearMap s (V1 s) (DualVector w))])
-> [(Int, Tensor s (V1 s) w)]
-> [Tree (Int, LinearMap s (V1 s) (DualVector 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
>>> [(Int, w)] -> Forest (Int, DualVector w)
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, w)] -> Forest (Int, DualVector w))
-> (Forest (Int, DualVector w)
    -> [Tree (Int, LinearMap s (V1 s) (DualVector w))])
-> [(Int, w)]
-> [Tree (Int, LinearMap s (V1 s) (DualVector 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
>>> (Tree (Int, DualVector w)
 -> Tree (Int, LinearMap s (V1 s) (DualVector w)))
-> Forest (Int, DualVector w)
-> [Tree (Int, LinearMap s (V1 s) (DualVector 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 (((Int, DualVector w) -> (Int, LinearMap s (V1 s) (DualVector w)))
-> Tree (Int, DualVector w)
-> Tree (Int, LinearMap s (V1 s) (DualVector 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 (((Int, DualVector w) -> (Int, LinearMap s (V1 s) (DualVector w)))
 -> Tree (Int, DualVector w)
 -> Tree (Int, LinearMap s (V1 s) (DualVector w)))
-> ((DualVector w -> LinearMap s (V1 s) (DualVector w))
    -> (Int, DualVector w) -> (Int, LinearMap s (V1 s) (DualVector w)))
-> (DualVector w -> LinearMap s (V1 s) (DualVector w))
-> Tree (Int, DualVector w)
-> Tree (Int, LinearMap s (V1 s) (DualVector w))
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 -> LinearMap s (V1 s) (DualVector w))
-> (Int, DualVector w) -> (Int, LinearMap s (V1 s) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((DualVector w -> LinearMap s (V1 s) (DualVector w))
 -> Tree (Int, DualVector w)
 -> Tree (Int, LinearMap s (V1 s) (DualVector w)))
-> (DualVector w -> LinearMap s (V1 s) (DualVector w))
-> Tree (Int, DualVector w)
-> Tree (Int, LinearMap s (V1 s) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ V1 (DualVector w) -> LinearMap s (V1 s) (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (V1 (DualVector w) -> LinearMap s (V1 s) (DualVector w))
-> (DualVector w -> V1 (DualVector w))
-> DualVector w
-> LinearMap s (V1 s) (DualVector w)
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 -> V1 (DualVector w)
forall a. a -> V1 a
V1)
  symTensorDualBasisCandidates :: [(Int, SymmetricTensor (Scalar (V1 s)) (V1 s))]
-> Forest
     (Int, SymmetricTensor (Scalar (V1 s)) (DualVector (V1 s)))
symTensorDualBasisCandidates = ((Int, SymmetricTensor s (V1 s)) -> (Int, Tensor s (V1 s) (V1 s)))
-> [(Int, SymmetricTensor s (V1 s))]
-> [(Int, Tensor s (V1 s) (V1 s))]
forall a b. (a -> b) -> [a] -> [b]
map ((SymmetricTensor s (V1 s) -> Tensor s (V1 s) (V1 s))
-> (Int, SymmetricTensor s (V1 s)) -> (Int, Tensor s (V1 s) (V1 s))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second SymmetricTensor s (V1 s) -> Tensor s (V1 s) (V1 s)
forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor)
                 ([(Int, SymmetricTensor s (V1 s))]
 -> [(Int, Tensor s (V1 s) (V1 s))])
-> ([(Int, Tensor s (V1 s) (V1 s))]
    -> [Tree (Int, SymmetricTensor s (V1 s))])
-> [(Int, SymmetricTensor s (V1 s))]
-> [Tree (Int, SymmetricTensor s (V1 s))]
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
>>> [(Int, Tensor s (V1 s) (V1 s))]
-> [Tree (Int, LinearMap s (V1 s) (V1 s))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, Tensor s (V1 s) (V1 s))]
 -> [Tree (Int, LinearMap s (V1 s) (V1 s))])
-> ([Tree (Int, LinearMap s (V1 s) (V1 s))]
    -> [Tree (Int, SymmetricTensor s (V1 s))])
-> [(Int, Tensor s (V1 s) (V1 s))]
-> [Tree (Int, SymmetricTensor s (V1 s))]
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
>>> (Tree (Int, LinearMap s (V1 s) (V1 s))
 -> Tree (Int, SymmetricTensor s (V1 s)))
-> [Tree (Int, LinearMap s (V1 s) (V1 s))]
-> [Tree (Int, SymmetricTensor s (V1 s))]
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, LinearMap s (V1 s) (V1 s))
 -> (Int, SymmetricTensor s (V1 s)))
-> Tree (Int, LinearMap s (V1 s) (V1 s))
-> Tree (Int, SymmetricTensor s (V1 s))
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, LinearMap s (V1 s) (V1 s))
  -> (Int, SymmetricTensor s (V1 s)))
 -> Tree (Int, LinearMap s (V1 s) (V1 s))
 -> Tree (Int, SymmetricTensor s (V1 s)))
-> ((Int, LinearMap s (V1 s) (V1 s))
    -> (Int, SymmetricTensor s (V1 s)))
-> Tree (Int, LinearMap s (V1 s) (V1 s))
-> Tree (Int, SymmetricTensor s (V1 s))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (V1 s) (V1 s) -> SymmetricTensor s (V1 s))
-> (Int, LinearMap s (V1 s) (V1 s))
-> (Int, SymmetricTensor s (V1 s))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (Coercion (LinearMap s (V1 s) (V1 s)) (Tensor s (V1 s) (V1 s))
-> LinearMap s (V1 s) (V1 s) -> Tensor s (V1 s) (V1 s)
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 Coercion (LinearMap s (V1 s) (V1 s)) (Tensor s (V1 s) (V1 s))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor (LinearMap s (V1 s) (V1 s) -> Tensor s (V1 s) (V1 s))
-> (Tensor s (V1 s) (V1 s) -> SymmetricTensor s (V1 s))
-> LinearMap s (V1 s) (V1 s)
-> SymmetricTensor s (V1 s)
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
>>> Tensor s (V1 s) (V1 s) -> SymmetricTensor s (V1 s)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor))

instance SemiInner (V2 ℝ) where
  dualBasisCandidates :: [(Int, V2 ℝ)] -> Forest (Int, DualVector (V2 ℝ))
dualBasisCandidates = [DualVector (V2 ℝ)]
-> (V2 ℝ -> [ℝ])
-> [(Int, V2 ℝ)]
-> Forest (Int, DualVector (V2 ℝ))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates [DualVector (V2 ℝ)]
forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (V2 ℝ -> [ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (V2 ℝ -> [ℝ]) -> (V2 ℝ -> V2 ℝ) -> V2 ℝ -> [ℝ]
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
. (ℝ -> ℝ) -> V2 ℝ -> V2 ℝ
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 :: [(Int, V2 ℝ ⊗ w)] -> Forest (Int, DualVector (V2 ℝ ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor ℝ (V2 ℝ) w) -> (Int, (w, w)))
-> [(Int, Tensor ℝ (V2 ℝ) w)] -> [(Int, (w, w))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor ℝ (V2 ℝ) w -> (w, w))
-> (Int, Tensor ℝ (V2 ℝ) w) -> (Int, (w, w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor ℝ (V2 ℝ) w -> (w, w))
 -> (Int, Tensor ℝ (V2 ℝ) w) -> (Int, (w, w)))
-> (Tensor ℝ (V2 ℝ) w -> (w, w))
-> (Int, Tensor ℝ (V2 ℝ) w)
-> (Int, (w, w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V2 x y)) -> (w
x,w
y))
                 ([(Int, Tensor ℝ (V2 ℝ) w)] -> [(Int, (w, w))])
-> ([(Int, (w, w))]
    -> [Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w))])
-> [(Int, Tensor ℝ (V2 ℝ) w)]
-> [Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector 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
>>> [(Int, (w, w))] -> [Tree (Int, (DualVector w, DualVector w))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, (w, w))] -> [Tree (Int, (DualVector w, DualVector w))])
-> ([Tree (Int, (DualVector w, DualVector w))]
    -> [Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w))])
-> [(Int, (w, w))]
-> [Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector 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
>>> (Tree (Int, (DualVector w, DualVector w))
 -> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
-> [Tree (Int, (DualVector w, DualVector w))]
-> [Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, (DualVector w, DualVector w))
 -> (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
-> Tree (Int, (DualVector w, DualVector w))
-> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector 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 (((Int, (DualVector w, DualVector w))
  -> (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
 -> Tree (Int, (DualVector w, DualVector w))
 -> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
-> (((DualVector w, DualVector w)
     -> LinearMap ℝ (V2 ℝ) (DualVector w))
    -> (Int, (DualVector w, DualVector w))
    -> (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
-> ((DualVector w, DualVector w)
    -> LinearMap ℝ (V2 ℝ) (DualVector w))
-> Tree (Int, (DualVector w, DualVector w))
-> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w))
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, DualVector w) -> LinearMap ℝ (V2 ℝ) (DualVector w))
-> (Int, (DualVector w, DualVector w))
-> (Int, LinearMap ℝ (V2 ℝ) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (((DualVector w, DualVector w)
  -> LinearMap ℝ (V2 ℝ) (DualVector w))
 -> Tree (Int, (DualVector w, DualVector w))
 -> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w)))
-> ((DualVector w, DualVector w)
    -> LinearMap ℝ (V2 ℝ) (DualVector w))
-> Tree (Int, (DualVector w, DualVector w))
-> Tree (Int, LinearMap ℝ (V2 ℝ) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ V2 (DualVector w) -> LinearMap ℝ (V2 ℝ) (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (V2 (DualVector w) -> LinearMap ℝ (V2 ℝ) (DualVector w))
-> ((DualVector w, DualVector w) -> V2 (DualVector w))
-> (DualVector w, DualVector w)
-> LinearMap ℝ (V2 ℝ) (DualVector w)
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 -> DualVector w -> V2 (DualVector w)
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 = [DualVector (SymmetricTensor ℝ (V2 ℝ))]
-> (SymmetricTensor ℝ (V2 ℝ) -> [ℝ])
-> [(Int, SymmetricTensor ℝ (V2 ℝ))]
-> Forest (Int, DualVector (SymmetricTensor ℝ (V2 ℝ)))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
             (Tensor ℝ (V2 ℝ) (V2 ℝ) -> SymmetricTensor ℝ (V2 ℝ)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor ℝ (V2 ℝ) (V2 ℝ) -> SymmetricTensor ℝ (V2 ℝ))
-> (V2 (V2 ℝ) -> Tensor ℝ (V2 ℝ) (V2 ℝ))
-> V2 (V2 ℝ)
-> SymmetricTensor ℝ (V2 ℝ)
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
. V2 (V2 ℝ) -> Tensor ℝ (V2 ℝ) (V2 ℝ)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor(V2 (V2 ℝ) -> SymmetricTensor ℝ (V2 ℝ))
-> [V2 (V2 ℝ)] -> [SymmetricTensor ℝ (V2 ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ V2 ℝ -> V2 ℝ -> V2 (V2 ℝ)
forall a. a -> a -> V2 a
V2 (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
1 ℝ
0)      V2 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V2 ℝ -> V2 ℝ -> V2 (V2 ℝ)
forall a. a -> a -> V2 a
V2 (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
sqrt¹₂) (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
sqrt¹₂ ℝ
0)
                                   , V2 ℝ -> V2 ℝ -> V2 (V2 ℝ)
forall a. a -> a -> V2 a
V2 V2 ℝ
forall v. AdditiveGroup v => v
zeroV         (ℝ -> ℝ -> V2 ℝ
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, (ℝ
xyℝ -> ℝ -> ℝ
forall 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 = [DualVector (V3 ℝ)]
-> (V3 ℝ -> [ℝ])
-> [(Int, V3 ℝ)]
-> Forest (Int, DualVector (V3 ℝ))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates [DualVector (V3 ℝ)]
forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (V3 ℝ -> [ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (V3 ℝ -> [ℝ]) -> (V3 ℝ -> V3 ℝ) -> V3 ℝ -> [ℝ]
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
. (ℝ -> ℝ) -> V3 ℝ -> V3 ℝ
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 :: [(Int, V3 ℝ ⊗ w)] -> Forest (Int, DualVector (V3 ℝ ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor ℝ (V3 ℝ) w) -> (Int, (w, (w, w))))
-> [(Int, Tensor ℝ (V3 ℝ) w)] -> [(Int, (w, (w, w)))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor ℝ (V3 ℝ) w -> (w, (w, w)))
-> (Int, Tensor ℝ (V3 ℝ) w) -> (Int, (w, (w, w)))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor ℝ (V3 ℝ) w -> (w, (w, w)))
 -> (Int, Tensor ℝ (V3 ℝ) w) -> (Int, (w, (w, w))))
-> (Tensor ℝ (V3 ℝ) w -> (w, (w, w)))
-> (Int, Tensor ℝ (V3 ℝ) w)
-> (Int, (w, (w, w)))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V3 x y z)) -> (w
x,(w
y,w
z)))
                 ([(Int, Tensor ℝ (V3 ℝ) w)] -> [(Int, (w, (w, w)))])
-> ([(Int, (w, (w, w)))]
    -> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))])
-> [(Int, Tensor ℝ (V3 ℝ) w)]
-> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector 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
>>> [(Int, (w, (w, w)))]
-> [Tree (Int, (DualVector w, (DualVector w, DualVector w)))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, (w, (w, w)))]
 -> [Tree (Int, (DualVector w, (DualVector w, DualVector w)))])
-> ([Tree (Int, (DualVector w, (DualVector w, DualVector w)))]
    -> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))])
-> [(Int, (w, (w, w)))]
-> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector 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
>>> (Tree (Int, (DualVector w, (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
-> [Tree (Int, (DualVector w, (DualVector w, DualVector w)))]
-> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, (DualVector w, (DualVector w, DualVector w)))
 -> (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
-> Tree (Int, (DualVector w, (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector 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 (((Int, (DualVector w, (DualVector w, DualVector w)))
  -> (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
 -> Tree (Int, (DualVector w, (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
-> (((DualVector w, (DualVector w, DualVector w))
     -> LinearMap ℝ (V3 ℝ) (DualVector w))
    -> (Int, (DualVector w, (DualVector w, DualVector w)))
    -> (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
-> ((DualVector w, (DualVector w, DualVector w))
    -> LinearMap ℝ (V3 ℝ) (DualVector w))
-> Tree (Int, (DualVector w, (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
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, (DualVector w, DualVector w))
 -> LinearMap ℝ (V3 ℝ) (DualVector w))
-> (Int, (DualVector w, (DualVector w, DualVector w)))
-> (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (((DualVector w, (DualVector w, DualVector w))
  -> LinearMap ℝ (V3 ℝ) (DualVector w))
 -> Tree (Int, (DualVector w, (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w)))
-> ((DualVector w, (DualVector w, DualVector w))
    -> LinearMap ℝ (V3 ℝ) (DualVector w))
-> Tree (Int, (DualVector w, (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ V3 (DualVector w) -> LinearMap ℝ (V3 ℝ) (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (V3 (DualVector w) -> LinearMap ℝ (V3 ℝ) (DualVector w))
-> ((DualVector w, (DualVector w, DualVector w))
    -> V3 (DualVector w))
-> (DualVector w, (DualVector w, DualVector w))
-> LinearMap ℝ (V3 ℝ) (DualVector w)
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 -> DualVector w -> DualVector w -> V3 (DualVector w)
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 = [DualVector (SymmetricTensor ℝ (V3 ℝ))]
-> (SymmetricTensor ℝ (V3 ℝ) -> [ℝ])
-> [(Int, SymmetricTensor ℝ (V3 ℝ))]
-> Forest (Int, DualVector (SymmetricTensor ℝ (V3 ℝ)))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
             (Tensor ℝ (V3 ℝ) (V3 ℝ) -> SymmetricTensor ℝ (V3 ℝ)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor ℝ (V3 ℝ) (V3 ℝ) -> SymmetricTensor ℝ (V3 ℝ))
-> (V3 (V3 ℝ) -> Tensor ℝ (V3 ℝ) (V3 ℝ))
-> V3 (V3 ℝ)
-> SymmetricTensor ℝ (V3 ℝ)
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
. V3 (V3 ℝ) -> Tensor ℝ (V3 ℝ) (V3 ℝ)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor(V3 (V3 ℝ) -> SymmetricTensor ℝ (V3 ℝ))
-> [V3 (V3 ℝ)] -> [SymmetricTensor ℝ (V3 ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
1 ℝ
0 ℝ
0)      V3 ℝ
forall v. AdditiveGroup v => v
zeroV           V3 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
sqrt¹₂ ℝ
0) (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
sqrt¹₂ ℝ
0 ℝ
0) V3 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
sqrt¹₂) V3 ℝ
forall v. AdditiveGroup v => v
zeroV           (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
sqrt¹₂ ℝ
0 ℝ
0)
                                   , V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 V3 ℝ
forall v. AdditiveGroup v => v
zeroV           (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
1 ℝ
0)      V3 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 V3 ℝ
forall v. AdditiveGroup v => v
zeroV           (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 ℝ
sqrt¹₂) (ℝ -> ℝ -> ℝ -> V3 ℝ
forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
sqrt¹₂ ℝ
0)
                                   , V3 ℝ -> V3 ℝ -> V3 ℝ -> V3 (V3 ℝ)
forall a. a -> a -> a -> V3 a
V3 V3 ℝ
forall v. AdditiveGroup v => v
zeroV           V3 ℝ
forall v. AdditiveGroup v => v
zeroV           (ℝ -> ℝ -> ℝ -> V3 ℝ
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, (ℝ
xyℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
yx)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xzℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
zx)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
                                 ,       ℝ
yy      , (ℝ
yzℝ -> ℝ -> ℝ
forall 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 = [DualVector (V4 ℝ)]
-> (V4 ℝ -> [ℝ])
-> [(Int, V4 ℝ)]
-> Forest (Int, DualVector (V4 ℝ))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates [DualVector (V4 ℝ)]
forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
Mat.basis (V4 ℝ -> [ℝ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (V4 ℝ -> [ℝ]) -> (V4 ℝ -> V4 ℝ) -> V4 ℝ -> [ℝ]
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
. (ℝ -> ℝ) -> V4 ℝ -> V4 ℝ
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 :: [(Int, V4 ℝ ⊗ w)] -> Forest (Int, DualVector (V4 ℝ ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor ℝ (V4 ℝ) w) -> (Int, ((w, w), (w, w))))
-> [(Int, Tensor ℝ (V4 ℝ) w)] -> [(Int, ((w, w), (w, w)))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor ℝ (V4 ℝ) w -> ((w, w), (w, w)))
-> (Int, Tensor ℝ (V4 ℝ) w) -> (Int, ((w, w), (w, w)))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor ℝ (V4 ℝ) w -> ((w, w), (w, w)))
 -> (Int, Tensor ℝ (V4 ℝ) w) -> (Int, ((w, w), (w, w))))
-> (Tensor ℝ (V4 ℝ) w -> ((w, w), (w, w)))
-> (Int, Tensor ℝ (V4 ℝ) w)
-> (Int, ((w, w), (w, w)))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V4 x y z w)) -> ((w
x,w
y),(w
z,w
w)))
                 ([(Int, Tensor ℝ (V4 ℝ) w)] -> [(Int, ((w, w), (w, w)))])
-> ([(Int, ((w, w), (w, w)))]
    -> [Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w))])
-> [(Int, Tensor ℝ (V4 ℝ) w)]
-> [Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector 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
>>> [(Int, ((w, w), (w, w)))]
-> [Tree
      (Int,
       ((DualVector w, DualVector w), (DualVector w, DualVector w)))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                 ([(Int, ((w, w), (w, w)))]
 -> [Tree
       (Int,
        ((DualVector w, DualVector w), (DualVector w, DualVector w)))])
-> ([Tree
       (Int,
        ((DualVector w, DualVector w), (DualVector w, DualVector w)))]
    -> [Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w))])
-> [(Int, ((w, w), (w, w)))]
-> [Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector 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
>>> (Tree
   (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
-> [Tree
      (Int,
       ((DualVector w, DualVector w), (DualVector w, DualVector w)))]
-> [Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int,
  ((DualVector w, DualVector w), (DualVector w, DualVector w)))
 -> (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
-> Tree
     (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector 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 (((Int,
   ((DualVector w, DualVector w), (DualVector w, DualVector w)))
  -> (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
 -> Tree
      (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
-> ((((DualVector w, DualVector w), (DualVector w, DualVector w))
     -> LinearMap ℝ (V4 ℝ) (DualVector w))
    -> (Int,
        ((DualVector w, DualVector w), (DualVector w, DualVector w)))
    -> (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
-> (((DualVector w, DualVector w), (DualVector w, DualVector w))
    -> LinearMap ℝ (V4 ℝ) (DualVector w))
-> Tree
     (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w))
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, DualVector w), (DualVector w, DualVector w))
 -> LinearMap ℝ (V4 ℝ) (DualVector w))
-> (Int,
    ((DualVector w, DualVector w), (DualVector w, DualVector w)))
-> (Int, LinearMap ℝ (V4 ℝ) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((((DualVector w, DualVector w), (DualVector w, DualVector w))
  -> LinearMap ℝ (V4 ℝ) (DualVector w))
 -> Tree
      (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
 -> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w)))
-> (((DualVector w, DualVector w), (DualVector w, DualVector w))
    -> LinearMap ℝ (V4 ℝ) (DualVector w))
-> Tree
     (Int, ((DualVector w, DualVector w), (DualVector w, DualVector w)))
-> Tree (Int, LinearMap ℝ (V4 ℝ) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ V4 (DualVector w) -> LinearMap ℝ (V4 ℝ) (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (V4 (DualVector w) -> LinearMap ℝ (V4 ℝ) (DualVector w))
-> (((DualVector w, DualVector w), (DualVector w, DualVector w))
    -> V4 (DualVector w))
-> ((DualVector w, DualVector w), (DualVector w, DualVector w))
-> LinearMap ℝ (V4 ℝ) (DualVector w)
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)) -> DualVector w
-> DualVector w
-> DualVector w
-> DualVector w
-> V4 (DualVector w)
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 = [DualVector (SymmetricTensor ℝ (V4 ℝ))]
-> (SymmetricTensor ℝ (V4 ℝ) -> [ℝ])
-> [(Int, SymmetricTensor ℝ (V4 ℝ))]
-> Forest (Int, DualVector (SymmetricTensor ℝ (V4 ℝ)))
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
             (Tensor ℝ (V4 ℝ) (V4 ℝ) -> SymmetricTensor ℝ (V4 ℝ)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor ℝ (V4 ℝ) (V4 ℝ) -> SymmetricTensor ℝ (V4 ℝ))
-> (V4 (V4 ℝ) -> Tensor ℝ (V4 ℝ) (V4 ℝ))
-> V4 (V4 ℝ)
-> SymmetricTensor ℝ (V4 ℝ)
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
. V4 (V4 ℝ) -> Tensor ℝ (V4 ℝ) (V4 ℝ)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor(V4 (V4 ℝ) -> SymmetricTensor ℝ (V4 ℝ))
-> [V4 (V4 ℝ)] -> [SymmetricTensor ℝ (V4 ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[ V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
1 ℝ
0 ℝ
0 ℝ
0)      V4 ℝ
forall v. AdditiveGroup v => v
zeroV           V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0) (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0) V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0) V4 ℝ
forall v. AdditiveGroup v => v
zeroV    (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0) V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) V4 ℝ
forall v. AdditiveGroup v => v
zeroV    V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
sqrt¹₂ ℝ
0 ℝ
0 ℝ
0)
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
1 ℝ
0 ℝ
0)      V4 ℝ
forall v. AdditiveGroup v => v
zeroV           V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0) (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0) V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
sqrt¹₂ ℝ
0 ℝ
0)
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
1 ℝ
0)      V4 ℝ
forall v. AdditiveGroup v => v
zeroV
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
0 ℝ
sqrt¹₂) (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
forall a. a -> a -> a -> a -> V4 a
V4 ℝ
0 ℝ
0 ℝ
sqrt¹₂ ℝ
0)
                                   , V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 ℝ -> V4 (V4 ℝ)
forall a. a -> a -> a -> a -> V4 a
V4 V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV V4 ℝ
forall v. AdditiveGroup v => v
zeroV           (ℝ -> ℝ -> ℝ -> ℝ -> V4 ℝ
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, (ℝ
xyℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
yx)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xzℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
zx)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
xwℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
wx)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
                                 ,       ℝ
yy      , (ℝ
yzℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
zy)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂, (ℝ
ywℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
wy)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
sqrt¹₂
                                                 ,       ℝ
zz      , (ℝ
zwℝ -> ℝ -> ℝ
forall 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⊗<$> :: LinearFunction s v w -> Tensor s u v -> Tensor s u w
⊗<$>Tensor s u v
t = LinearFunction s v w
-> LinearFunction s (Tensor s u v) (Tensor s u 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 LinearFunction s v w
f LinearFunction s (Tensor s u v) (Tensor s u w)
-> Tensor s u v -> Tensor s u w
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 = ((Int, (u, v)) -> ((Int, u), (Int, v)))
-> [(Int, (u, v))] -> [((Int, u), (Int, v))]
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))) ([(Int, (u, v))] -> [((Int, u), (Int, v))])
-> ([((Int, u), (Int, v))]
    -> Forest (Int, (DualVector u, DualVector v)))
-> [(Int, (u, v))]
-> Forest (Int, (DualVector u, DualVector 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
>>> [((Int, u), (Int, v))] -> ([(Int, u)], [(Int, v)])
forall a b. [(a, b)] -> ([a], [b])
unzip
              ([((Int, u), (Int, v))] -> ([(Int, u)], [(Int, v)]))
-> (([(Int, u)], [(Int, v)])
    -> Forest (Int, (DualVector u, DualVector v)))
-> [((Int, u), (Int, v))]
-> Forest (Int, (DualVector u, DualVector 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
>>> [(Int, u)] -> Forest (Int, DualVector u)
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates ([(Int, u)] -> Forest (Int, DualVector u))
-> ([(Int, v)] -> Forest (Int, DualVector v))
-> ([(Int, u)], [(Int, v)])
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
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')
*** [(Int, v)] -> Forest (Int, DualVector v)
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
              (([(Int, u)], [(Int, v)])
 -> (Forest (Int, DualVector u), Forest (Int, DualVector v)))
-> ((Forest (Int, DualVector u), Forest (Int, DualVector v))
    -> Forest (Int, (DualVector u, DualVector v)))
-> ([(Int, u)], [(Int, v)])
-> Forest (Int, (DualVector u, DualVector 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
>>> (DualSpaceWitness u, DualSpaceWitness v)
-> Bool
-> Set Int
-> (Forest (Int, DualVector u), Forest (Int, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
combineBaseis (DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness,DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness) Bool
False Set Int
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
iInt -> Set Int -> Bool
forall 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
                 = (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
-> Tree (Int, (DualVector u, DualVector v))
forall a. a -> Forest a -> Tree a
Node (Int
i, (DualVector u
du, DualVector v
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 (Int -> Set Int -> Set Int
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))
                       Tree (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
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
iInt -> Set Int -> Bool
forall 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
                 = (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
-> Tree (Int, (DualVector u, DualVector v))
forall a. a -> Forest a -> Tree a
Node (Int
i, (DualVector u
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 (Int -> Set Int -> Set Int
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'))
                       Tree (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
-> Forest (Int, (DualVector u, DualVector v))
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 = ((Int, SymmetricTensor (Scalar v) (u, v))
 -> ((Int, Tensor (Scalar v) u v),
     ((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v))))
-> [(Int, SymmetricTensor (Scalar v) (u, v))]
-> [((Int, Tensor (Scalar v) u v),
     ((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v)))]
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 (u_uv, v_uv)))
                                    -> ( (Int
i, LinearFunction (Scalar v) (u, v) v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd LinearFunction (Scalar v) (u, v) v
-> Tensor (Scalar v) u (u, v) -> Tensor (Scalar v) u v
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, Tensor (Scalar v) u u -> SymmetricTensor (Scalar v) u
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor (Scalar v) u u -> SymmetricTensor (Scalar v) u)
-> Tensor (Scalar v) u u -> SymmetricTensor (Scalar v) u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction (Scalar v) (u, v) u
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst LinearFunction (Scalar v) (u, v) u
-> Tensor (Scalar v) u (u, v) -> Tensor (Scalar v) u u
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, Tensor (Scalar v) v v -> SymmetricTensor (Scalar v) v
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor (Scalar v) v v -> SymmetricTensor (Scalar v) v)
-> Tensor (Scalar v) v v -> SymmetricTensor (Scalar v) v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction (Scalar v) (u, v) v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd LinearFunction (Scalar v) (u, v) v
-> Tensor (Scalar v) v (u, v) -> Tensor (Scalar v) v v
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))) )
                                      ([(Int, SymmetricTensor (Scalar v) (u, v))]
 -> [((Int, Tensor (Scalar v) u v),
      ((Int, SymmetricTensor (Scalar v) u),
       (Int, SymmetricTensor (Scalar v) v)))])
-> ([((Int, Tensor (Scalar v) u v),
      ((Int, SymmetricTensor (Scalar v) u),
       (Int, SymmetricTensor (Scalar v) v)))]
    -> Forest
         (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v)))
-> [(Int, SymmetricTensor (Scalar v) (u, v))]
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector 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
>>> [((Int, Tensor (Scalar v) u v),
  ((Int, SymmetricTensor (Scalar v) u),
   (Int, SymmetricTensor (Scalar v) v)))]
-> ([(Int, Tensor (Scalar v) u v)],
    [((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Int, Tensor (Scalar v) u v),
   ((Int, SymmetricTensor (Scalar v) u),
    (Int, SymmetricTensor (Scalar v) v)))]
 -> ([(Int, Tensor (Scalar v) u v)],
     [((Int, SymmetricTensor (Scalar v) u),
       (Int, SymmetricTensor (Scalar v) v))]))
-> (([(Int, Tensor (Scalar v) u v)],
     [((Int, SymmetricTensor (Scalar v) u),
       (Int, SymmetricTensor (Scalar v) v))])
    -> Forest
         (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v)))
-> [((Int, Tensor (Scalar v) u v),
     ((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v)))]
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector 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
>>> ([((Int, SymmetricTensor (Scalar v) u),
   (Int, SymmetricTensor (Scalar v) v))]
 -> ([(Int, SymmetricTensor (Scalar v) u)],
     [(Int, SymmetricTensor (Scalar v) v)]))
-> ([(Int, Tensor (Scalar v) u v)],
    [((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v))])
-> ([(Int, Tensor (Scalar v) u v)],
    ([(Int, SymmetricTensor (Scalar v) u)],
     [(Int, SymmetricTensor (Scalar v) v)]))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second [((Int, SymmetricTensor (Scalar v) u),
  (Int, SymmetricTensor (Scalar v) v))]
-> ([(Int, SymmetricTensor (Scalar v) u)],
    [(Int, SymmetricTensor (Scalar v) v)])
forall a b. [(a, b)] -> ([a], [b])
unzip
            (([(Int, Tensor (Scalar v) u v)],
  [((Int, SymmetricTensor (Scalar v) u),
    (Int, SymmetricTensor (Scalar v) v))])
 -> ([(Int, Tensor (Scalar v) u v)],
     ([(Int, SymmetricTensor (Scalar v) u)],
      [(Int, SymmetricTensor (Scalar v) v)])))
-> (([(Int, Tensor (Scalar v) u v)],
     ([(Int, SymmetricTensor (Scalar v) u)],
      [(Int, SymmetricTensor (Scalar v) v)]))
    -> Forest
         (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v)))
-> ([(Int, Tensor (Scalar v) u v)],
    [((Int, SymmetricTensor (Scalar v) u),
      (Int, SymmetricTensor (Scalar v) v))])
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector 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
>>> [(Int, Tensor (Scalar v) u v)]
-> [Tree (Int, LinearMap (Scalar v) u (DualVector v))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates ([(Int, Tensor (Scalar v) u v)]
 -> [Tree (Int, LinearMap (Scalar v) u (DualVector v))])
-> (([(Int, SymmetricTensor (Scalar v) u)],
     [(Int, SymmetricTensor (Scalar v) v)])
    -> (Forest (Int, SymmetricTensor (Scalar v) (DualVector u)),
        Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
-> ([(Int, Tensor (Scalar v) u v)],
    ([(Int, SymmetricTensor (Scalar v) u)],
     [(Int, SymmetricTensor (Scalar v) v)]))
-> ([Tree (Int, LinearMap (Scalar v) u (DualVector v))],
    (Forest (Int, SymmetricTensor (Scalar v) (DualVector u)),
     Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
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')
*** [(Int, SymmetricTensor (Scalar v) u)]
-> Forest (Int, SymmetricTensor (Scalar v) (DualVector u))
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates ([(Int, SymmetricTensor (Scalar v) u)]
 -> Forest (Int, SymmetricTensor (Scalar v) (DualVector u)))
-> ([(Int, SymmetricTensor (Scalar v) v)]
    -> Forest (Int, SymmetricTensor (Scalar v) (DualVector v)))
-> ([(Int, SymmetricTensor (Scalar v) u)],
    [(Int, SymmetricTensor (Scalar v) v)])
-> (Forest (Int, SymmetricTensor (Scalar v) (DualVector u)),
    Forest (Int, SymmetricTensor (Scalar v) (DualVector v)))
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')
*** [(Int, SymmetricTensor (Scalar v) v)]
-> Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
            (([(Int, Tensor (Scalar v) u v)],
  ([(Int, SymmetricTensor (Scalar v) u)],
   [(Int, SymmetricTensor (Scalar v) v)]))
 -> ([Tree (Int, LinearMap (Scalar v) u (DualVector v))],
     (Forest (Int, SymmetricTensor (Scalar v) (DualVector u)),
      Forest (Int, SymmetricTensor (Scalar v) (DualVector v)))))
-> (([Tree (Int, LinearMap (Scalar v) u (DualVector v))],
     (Forest (Int, SymmetricTensor (Scalar v) (DualVector u)),
      Forest (Int, SymmetricTensor (Scalar v) (DualVector v))))
    -> Forest
         (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v)))
-> ([(Int, Tensor (Scalar v) u v)],
    ([(Int, SymmetricTensor (Scalar v) u)],
     [(Int, SymmetricTensor (Scalar v) v)]))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector 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
>>> (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
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness,DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) Set Int
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
iInt -> Set Int -> Bool
forall 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 Maybe Bool
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
                 = (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tree
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
forall a. a -> Forest a -> Tree a
Node (Int
i, Tensor
  (Scalar v)
  (DualVector u, DualVector v)
  (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor
   (Scalar v)
   (DualVector u, DualVector v)
   (DualVector u, DualVector v)
 -> SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct
  (DualVector u, DualVector v) (DualVector u, DualVector v)
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor
                             ( (LinearFunction (Scalar v) (DualVector v) (DualVector u)
forall v. AdditiveGroup v => v
zeroVLinearFunction (Scalar v) (DualVector v) (DualVector u)
-> LinearFunction (Scalar v) (DualVector v) (DualVector v)
-> LinearFunction
     (Scalar v) (DualVector v) (DualVector u, DualVector v)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&LinearFunction (Scalar v) (DualVector v) (DualVector v)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)LinearFunction
  (Scalar v) (DualVector v) (DualVector u, DualVector v)
-> Tensor (Scalar v) (DualVector u) (DualVector v)
-> Tensor (Scalar v) (DualVector u) (DualVector u, DualVector v)
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
⊗<$>(Coercion
  (LinearMap (Scalar v) u (DualVector v))
  (Tensor (Scalar v) (DualVector u) (DualVector v))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensorCoercion
  (LinearMap (Scalar v) u (DualVector v))
  (Tensor (Scalar v) (DualVector u) (DualVector v))
-> LinearMap (Scalar v) u (DualVector v)
-> Tensor (Scalar v) (DualVector u) (DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$LinearMap (Scalar u) u (DualVector v)
LinearMap (Scalar v) u (DualVector v)
duv)
                             , (LinearFunction (Scalar v) (DualVector u) (DualVector u)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idLinearFunction (Scalar v) (DualVector u) (DualVector u)
-> LinearFunction (Scalar v) (DualVector u) (DualVector v)
-> LinearFunction
     (Scalar v) (DualVector u) (DualVector u, DualVector v)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&LinearFunction (Scalar v) (DualVector u) (DualVector v)
forall v. AdditiveGroup v => v
zeroV)LinearFunction
  (Scalar v) (DualVector u) (DualVector u, DualVector v)
-> Tensor (Scalar v) (DualVector v) (DualVector u)
-> Tensor (Scalar v) (DualVector v) (DualVector u, DualVector v)
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
⊗<$>(LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
  (Tensor (Scalar v) (DualVector v) (DualVector u))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensorLinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
  (Tensor (Scalar v) (DualVector v) (DualVector u))
-> Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v)
-> Tensor (Scalar v) (DualVector v) (DualVector u)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Coercion
  (LinearMap (Scalar v) u (DualVector v))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensorCoercion
  (LinearMap (Scalar v) u (DualVector v))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
-> LinearMap (Scalar v) u (DualVector v)
-> Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$LinearMap (Scalar u) u (DualVector v)
LinearMap (Scalar v) 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 (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
                                 (Int -> Set Int -> Set Int
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)))
                       Tree (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
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 Maybe Bool
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 (Bool -> Maybe Bool
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
iInt -> Set Int -> Bool
forall 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 (Bool -> Maybe Bool
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
                 = (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tree
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
forall a. a -> Forest a -> Tree a
Node (Int
i, Tensor
  (Scalar v)
  (DualVector u, DualVector v)
  (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor
   (Scalar v)
   (DualVector u, DualVector v)
   (DualVector u, DualVector v)
 -> SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct
  (DualVector u, DualVector v) (DualVector u, DualVector v)
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor ((LinearFunction (Scalar v) (DualVector u) (DualVector u)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idLinearFunction (Scalar v) (DualVector u) (DualVector u)
-> LinearFunction (Scalar v) (DualVector u) (DualVector v)
-> LinearFunction
     (Scalar v) (DualVector u) (DualVector u, DualVector v)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&LinearFunction (Scalar v) (DualVector u) (DualVector v)
forall v. AdditiveGroup v => v
zeroV)LinearFunction
  (Scalar v) (DualVector u) (DualVector u, DualVector v)
-> Tensor (Scalar v) (DualVector u) (DualVector u)
-> Tensor (Scalar v) (DualVector u) (DualVector u, DualVector v)
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)
Tensor (Scalar v) (DualVector u) (DualVector u)
du, Tensor (Scalar v) (DualVector v) (DualVector u, DualVector v)
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 (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
                                 (Int -> Set Int -> Set Int
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)))
                       Tree (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
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 (Bool -> Maybe Bool
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 (Bool -> Maybe Bool
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
iInt -> Set Int -> Bool
forall 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 (Bool -> Maybe Bool
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
                 = (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tree
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
forall a. a -> Forest a -> Tree a
Node (Int
i, Tensor
  (Scalar v)
  (DualVector u, DualVector v)
  (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor
   (Scalar v)
   (DualVector u, DualVector v)
   (DualVector u, DualVector v)
 -> SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
-> SymmetricTensor (Scalar v) (DualVector u, DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct
  (DualVector u, DualVector v) (DualVector u, DualVector v)
-> Tensor
     (Scalar v)
     (DualVector u, DualVector v)
     (DualVector u, DualVector v)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Tensor (Scalar v) (DualVector u) (DualVector u, DualVector v)
forall v. AdditiveGroup v => v
zeroV, (LinearFunction (Scalar v) (DualVector v) (DualVector u)
forall v. AdditiveGroup v => v
zeroVLinearFunction (Scalar v) (DualVector v) (DualVector u)
-> LinearFunction (Scalar v) (DualVector v) (DualVector v)
-> LinearFunction
     (Scalar v) (DualVector v) (DualVector u, DualVector v)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&LinearFunction (Scalar v) (DualVector v) (DualVector v)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)LinearFunction
  (Scalar v) (DualVector v) (DualVector u, DualVector v)
-> Tensor (Scalar v) (DualVector v) (DualVector v)
-> Tensor (Scalar v) (DualVector v) (DualVector u, DualVector v)
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 Maybe Bool
forall a. Maybe a
Nothing
                                 (Int -> Set Int -> Set Int
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')))
                       Tree (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
-> Forest
     (Int, SymmetricTensor (Scalar v) (DualVector u, DualVector v))
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 (Bool -> Maybe Bool
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 Maybe Bool
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 :: [(Int, (u, v) ⊗ w)] -> Forest (Int, DualVector ((u, v) ⊗ w))
tensorDualBasisCandidates = case ScalarSpaceWitness u
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness u of
     ScalarSpaceWitness u
ScalarSpaceWitness -> ((Int, Tensor (Scalar v) (u, v) w)
 -> (Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w)))
-> [(Int, Tensor (Scalar v) (u, v) w)]
-> [(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor (Scalar v) (u, v) w
 -> (Tensor (Scalar v) u w, Tensor (Scalar v) v w))
-> (Int, Tensor (Scalar v) (u, v) w)
-> (Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor (Scalar v) (u, v) w
  -> (Tensor (Scalar v) u w, Tensor (Scalar v) v w))
 -> (Int, Tensor (Scalar v) (u, v) w)
 -> (Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w)))
-> (Tensor (Scalar v) (u, v) w
    -> (Tensor (Scalar v) u w, Tensor (Scalar v) v w))
-> (Int, Tensor (Scalar v) (u, v) w)
-> (Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (tu, tv)) -> (Tensor (Scalar v) u w
tu, Tensor (Scalar v) v w
tv))
                          ([(Int, Tensor (Scalar v) (u, v) w)]
 -> [(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))])
-> ([(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))]
    -> [Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w))])
-> [(Int, Tensor (Scalar v) (u, v) w)]
-> [Tree (Int, LinearMap (Scalar v) (u, v) (DualVector 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
>>> [(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))]
-> [Tree
      (Int,
       (LinearMap (Scalar v) u (DualVector w),
        LinearMap (Scalar v) v (DualVector w)))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                          ([(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))]
 -> [Tree
       (Int,
        (LinearMap (Scalar v) u (DualVector w),
         LinearMap (Scalar v) v (DualVector w)))])
-> ([Tree
       (Int,
        (LinearMap (Scalar v) u (DualVector w),
         LinearMap (Scalar v) v (DualVector w)))]
    -> [Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w))])
-> [(Int, (Tensor (Scalar v) u w, Tensor (Scalar v) v w))]
-> [Tree (Int, LinearMap (Scalar v) (u, v) (DualVector 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
>>> (Tree
   (Int,
    (LinearMap (Scalar v) u (DualVector w),
     LinearMap (Scalar v) v (DualVector w)))
 -> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
-> [Tree
      (Int,
       (LinearMap (Scalar v) u (DualVector w),
        LinearMap (Scalar v) v (DualVector w)))]
-> [Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int,
  (LinearMap (Scalar v) u (DualVector w),
   LinearMap (Scalar v) v (DualVector w)))
 -> (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
-> Tree
     (Int,
      (LinearMap (Scalar v) u (DualVector w),
       LinearMap (Scalar v) v (DualVector w)))
-> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector 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 (((Int,
   (LinearMap (Scalar v) u (DualVector w),
    LinearMap (Scalar v) v (DualVector w)))
  -> (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
 -> Tree
      (Int,
       (LinearMap (Scalar v) u (DualVector w),
        LinearMap (Scalar v) v (DualVector w)))
 -> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
-> (((LinearMap (Scalar v) u (DualVector w),
      LinearMap (Scalar v) v (DualVector w))
     -> LinearMap (Scalar v) (u, v) (DualVector w))
    -> (Int,
        (LinearMap (Scalar v) u (DualVector w),
         LinearMap (Scalar v) v (DualVector w)))
    -> (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
-> ((LinearMap (Scalar v) u (DualVector w),
     LinearMap (Scalar v) v (DualVector w))
    -> LinearMap (Scalar v) (u, v) (DualVector w))
-> Tree
     (Int,
      (LinearMap (Scalar v) u (DualVector w),
       LinearMap (Scalar v) v (DualVector w)))
-> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w))
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) u (DualVector w),
  LinearMap (Scalar v) v (DualVector w))
 -> LinearMap (Scalar v) (u, v) (DualVector w))
-> (Int,
    (LinearMap (Scalar v) u (DualVector w),
     LinearMap (Scalar v) v (DualVector w)))
-> (Int, LinearMap (Scalar v) (u, v) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (((LinearMap (Scalar v) u (DualVector w),
   LinearMap (Scalar v) v (DualVector w))
  -> LinearMap (Scalar v) (u, v) (DualVector w))
 -> Tree
      (Int,
       (LinearMap (Scalar v) u (DualVector w),
        LinearMap (Scalar v) v (DualVector w)))
 -> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w)))
-> ((LinearMap (Scalar v) u (DualVector w),
     LinearMap (Scalar v) v (DualVector w))
    -> LinearMap (Scalar v) (u, v) (DualVector w))
-> Tree
     (Int,
      (LinearMap (Scalar v) u (DualVector w),
       LinearMap (Scalar v) v (DualVector w)))
-> Tree (Int, LinearMap (Scalar v) (u, v) (DualVector w))
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)
                                            -> (DualVector u ⊗ DualVector w, DualVector v ⊗ DualVector w)
-> LinearMap (Scalar v) (u, v) (DualVector w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap ((DualVector u ⊗ DualVector w, DualVector v ⊗ DualVector w)
 -> LinearMap (Scalar v) (u, v) (DualVector w))
-> (DualVector u ⊗ DualVector w, DualVector v ⊗ DualVector w)
-> LinearMap (Scalar v) (u, v) (DualVector w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (TensorProduct (DualVector u) (DualVector w)
-> DualVector u ⊗ DualVector w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector u) (DualVector w)
lu, TensorProduct (DualVector v) (DualVector w)
-> DualVector v ⊗ DualVector w
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 = [(Int, Tensor s u v)] -> Forest (Int, DualVector (Tensor s u v))
forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
  tensorDualBasisCandidates :: [(Int, Tensor s u v ⊗ w)]
-> Forest (Int, DualVector (Tensor s u v ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor s (Tensor s u v) w)
 -> (Int, Tensor s u (Tensor s v w)))
-> [(Int, Tensor s (Tensor s u v) w)]
-> [(Int, Tensor s u (Tensor s v w))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor s (Tensor s u v) w -> Tensor s u (Tensor s v w))
-> (Int, Tensor s (Tensor s u v) w)
-> (Int, Tensor s u (Tensor s v w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor s (Tensor s u v) w -> Tensor s u (Tensor s v w))
 -> (Int, Tensor s (Tensor s u v) w)
 -> (Int, Tensor s u (Tensor s v w)))
-> (Tensor s (Tensor s u v) w -> Tensor s u (Tensor s v w))
-> (Int, Tensor s (Tensor s u v) w)
-> (Int, Tensor s u (Tensor s v w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
-> Tensor s (Tensor s u v) w -> Tensor s u (Tensor s v w)
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 Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
forall s u v w.
Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor)
                    ([(Int, Tensor s (Tensor s u v) w)]
 -> [(Int, Tensor s u (Tensor s v w))])
-> ([(Int, Tensor s u (Tensor s v w))]
    -> [Tree (Int, LinearMap s (Tensor s u v) (DualVector w))])
-> [(Int, Tensor s (Tensor s u v) w)]
-> [Tree (Int, LinearMap s (Tensor s u v) (DualVector 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
>>> [(Int, Tensor s u (Tensor s v w))]
-> Forest
     (Int, LinearMap (Scalar u) u (LinearMap s v (DualVector w)))
forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
                    ([(Int, Tensor s u (Tensor s v w))]
 -> Forest
      (Int, LinearMap (Scalar u) u (LinearMap s v (DualVector w))))
-> (Forest
      (Int, LinearMap (Scalar u) u (LinearMap s v (DualVector w)))
    -> [Tree (Int, LinearMap s (Tensor s u v) (DualVector w))])
-> [(Int, Tensor s u (Tensor s v w))]
-> [Tree (Int, LinearMap s (Tensor s u v) (DualVector 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
>>> (Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (Tensor s u v) (DualVector w)))
-> [Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))]
-> [Tree (Int, LinearMap s (Tensor s u v) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, LinearMap s u (LinearMap s v (DualVector w)))
 -> (Int, LinearMap s (Tensor s u v) (DualVector w)))
-> Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (Tensor s u v) (DualVector 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 (((Int, LinearMap s u (LinearMap s v (DualVector w)))
  -> (Int, LinearMap s (Tensor s u v) (DualVector w)))
 -> Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (Tensor s u v) (DualVector w)))
-> ((LinearMap s u (LinearMap s v (DualVector w))
     -> LinearMap s (Tensor s u v) (DualVector w))
    -> (Int, LinearMap s u (LinearMap s v (DualVector w)))
    -> (Int, LinearMap s (Tensor s u v) (DualVector w)))
-> (LinearMap s u (LinearMap s v (DualVector w))
    -> LinearMap s (Tensor s u v) (DualVector w))
-> Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (Tensor s u v) (DualVector w))
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 s u (LinearMap s v (DualVector w))
 -> LinearMap s (Tensor s u v) (DualVector w))
-> (Int, LinearMap s u (LinearMap s v (DualVector w)))
-> (Int, LinearMap s (Tensor s u v) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((LinearMap s u (LinearMap s v (DualVector w))
  -> LinearMap s (Tensor s u v) (DualVector w))
 -> Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (Tensor s u v) (DualVector w)))
-> (LinearMap s u (LinearMap s v (DualVector w))
    -> LinearMap s (Tensor s u v) (DualVector w))
-> Tree (Int, LinearMap s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (Tensor s u v) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (LinearMap s u (LinearMap s v (DualVector w)))
  (LinearMap s (Tensor s u v) (DualVector w))
-> LinearMap s u (LinearMap s v (DualVector w))
-> LinearMap s (Tensor s u v) (DualVector w)
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 Coercion
  (LinearMap s u (LinearMap s v (DualVector w)))
  (LinearMap s (Tensor s u v) (DualVector w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (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 = [(Int, SymmetricTensor s v)]
-> Forest (Int, DualVector (SymmetricTensor s v))
forall v.
SemiInner v =>
[(Int, SymmetricTensor (Scalar v) v)]
-> Forest (Int, SymmetricTensor (Scalar v) (DualVector v))
symTensorDualBasisCandidates
  tensorDualBasisCandidates :: [(Int, SymmetricTensor s v ⊗ w)]
-> Forest (Int, DualVector (SymmetricTensor s v ⊗ w))
tensorDualBasisCandidates = [(Int, SymmetricTensor s v ⊗ w)]
-> Forest (Int, DualVector (SymmetricTensor s v ⊗ w))
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 :: [(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 DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u of
     DualSpaceWitness u
DualSpaceWitness -> ([(Int, LinearMap s u v)] -> [(Int, Tensor s (DualVector u) v)]
coerce :: [(Int, LinearMap s u v)]
                                 -> [(Int, Tensor s (DualVector u) v)])
                    ([(Int, LinearMap s u v)] -> [(Int, Tensor s (DualVector u) v)])
-> ([(Int, Tensor s (DualVector u) v)]
    -> Forest (Int, Tensor s u (DualVector v)))
-> [(Int, LinearMap s u v)]
-> Forest (Int, Tensor s u (DualVector 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
>>> [(Int, Tensor s (DualVector u) v)]
-> Forest
     (Int,
      LinearMap (Scalar (DualVector u)) (DualVector u) (DualVector v))
forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
                    ([(Int, Tensor s (DualVector u) v)]
 -> Forest
      (Int,
       LinearMap (Scalar (DualVector u)) (DualVector u) (DualVector v)))
-> (Forest
      (Int,
       LinearMap (Scalar (DualVector u)) (DualVector u) (DualVector v))
    -> Forest (Int, Tensor s u (DualVector v)))
-> [(Int, Tensor s (DualVector u) v)]
-> Forest (Int, Tensor s u (DualVector 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
>>> Forest
  (Int,
   LinearMap (Scalar (DualVector u)) (DualVector u) (DualVector v))
-> Forest (Int, Tensor s u (DualVector v))
coerce
  tensorDualBasisCandidates :: [(Int, LinearMap s u v ⊗ w)]
-> Forest (Int, DualVector (LinearMap s u v ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor s (LinearMap s u v) w)
 -> (Int, LinearMap s u (Tensor s v w)))
-> [(Int, Tensor s (LinearMap s u v) w)]
-> [(Int, LinearMap s u (Tensor s v w))]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor s (LinearMap s u v) w -> LinearMap s u (Tensor s v w))
-> (Int, Tensor s (LinearMap s u v) w)
-> (Int, LinearMap s u (Tensor s v w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor s (LinearMap s u v) w -> LinearMap s u (Tensor s v w))
 -> (Int, Tensor s (LinearMap s u v) w)
 -> (Int, LinearMap s u (Tensor s v w)))
-> (Tensor s (LinearMap s u v) w -> LinearMap s u (Tensor s v w))
-> (Int, Tensor s (LinearMap s u v) w)
-> (Int, LinearMap s u (Tensor s v w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
-> Tensor s (LinearMap s u v) w -> LinearMap s u (Tensor s v w)
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 Coercion
  (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
forall s u v w.
Coercion
  (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
hasteLinearMap)
                    ([(Int, Tensor s (LinearMap s u v) w)]
 -> [(Int, LinearMap s u (Tensor s v w))])
-> ([(Int, LinearMap s u (Tensor s v w))]
    -> [Tree (Int, LinearMap s (LinearMap s u v) (DualVector w))])
-> [(Int, Tensor s (LinearMap s u v) w)]
-> [Tree (Int, LinearMap s (LinearMap s u v) (DualVector 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
>>> [(Int, LinearMap s u (Tensor s v w))]
-> [Tree (Int, Tensor s u (LinearMap s v (DualVector w)))]
forall v. SemiInner v => [(Int, v)] -> Forest (Int, DualVector v)
dualBasisCandidates
                    ([(Int, LinearMap s u (Tensor s v w))]
 -> [Tree (Int, Tensor s u (LinearMap s v (DualVector w)))])
-> ([Tree (Int, Tensor s u (LinearMap s v (DualVector w)))]
    -> [Tree (Int, LinearMap s (LinearMap s u v) (DualVector w))])
-> [(Int, LinearMap s u (Tensor s v w))]
-> [Tree (Int, LinearMap s (LinearMap s u v) (DualVector 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
>>> (Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (LinearMap s u v) (DualVector w)))
-> [Tree (Int, Tensor s u (LinearMap s v (DualVector w)))]
-> [Tree (Int, LinearMap s (LinearMap s u v) (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Tensor s u (LinearMap s v (DualVector w)))
 -> (Int, LinearMap s (LinearMap s u v) (DualVector w)))
-> Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (LinearMap s u v) (DualVector 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 (((Int, Tensor s u (LinearMap s v (DualVector w)))
  -> (Int, LinearMap s (LinearMap s u v) (DualVector w)))
 -> Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (LinearMap s u v) (DualVector w)))
-> ((Tensor s u (LinearMap s v (DualVector w))
     -> LinearMap s (LinearMap s u v) (DualVector w))
    -> (Int, Tensor s u (LinearMap s v (DualVector w)))
    -> (Int, LinearMap s (LinearMap s u v) (DualVector w)))
-> (Tensor s u (LinearMap s v (DualVector w))
    -> LinearMap s (LinearMap s u v) (DualVector w))
-> Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (LinearMap s u v) (DualVector w))
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
. (Tensor s u (LinearMap s v (DualVector w))
 -> LinearMap s (LinearMap s u v) (DualVector w))
-> (Int, Tensor s u (LinearMap s v (DualVector w)))
-> (Int, LinearMap s (LinearMap s u v) (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor s u (LinearMap s v (DualVector w))
  -> LinearMap s (LinearMap s u v) (DualVector w))
 -> Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
 -> Tree (Int, LinearMap s (LinearMap s u v) (DualVector w)))
-> (Tensor s u (LinearMap s v (DualVector w))
    -> LinearMap s (LinearMap s u v) (DualVector w))
-> Tree (Int, Tensor s u (LinearMap s v (DualVector w)))
-> Tree (Int, LinearMap s (LinearMap s u v) (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (Tensor s u (LinearMap s v (DualVector w)))
  (LinearMap s (LinearMap s u v) (DualVector w))
-> Tensor s u (LinearMap s v (DualVector w))
-> LinearMap s (LinearMap s u v) (DualVector w)
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 Coercion
  (Tensor s u (LinearMap s v (DualVector w)))
  (LinearMap s (LinearMap s u v) (DualVector w))
forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s) =>
Coercion
  (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^/^ :: v -> v -> Scalar v
^/^v
w = case (v
vv -> v -> Scalar v
forall v. InnerSpace v => v -> v -> Scalar v
<.>v
w) of
   Scalar v
0 -> Scalar v
0
   Scalar v
vw -> Scalar v
vw Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ (v
wv -> v -> Scalar v
forall 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 :: *
  
  entireBasis :: SubBasis v
  
  enumerateSubBasis :: SubBasis v -> [v]
  
  subbasisDimension :: SubBasis v -> Int
  subbasisDimension = [v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([v] -> Int) -> (SubBasis v -> [v]) -> SubBasis v -> Int
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 -> [v]
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 = DualSpaceWitness v -> DualFinitenessWitness v
forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness (LinearSpace v => DualSpaceWitness v
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
(==) = 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 FiniteDimensional u => DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u of
    DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
       -> (TensorProduct (DualVector u) v -> Tensor s (DualVector u) v
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (DualVector u) v
f :: Tensor s (DualVector u) v) Tensor s (DualVector u) v -> Tensor s (DualVector u) v -> Bool
forall a. Eq a => a -> a -> Bool
== TensorProduct (DualVector u) v -> Tensor s (DualVector u) v
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 = (LinearFunction s (LinearFunction s u v) (LinearMap s u v)
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunctionLinearFunction s (LinearFunction s u v) (LinearMap s u v)
-> LinearFunction s u v -> LinearMap s u v
forall s v w. LinearFunction s v w -> v -> w
-+$>LinearFunction s u v
f) LinearMap s u v -> LinearMap s u v -> Bool
forall a. Eq a => a -> a -> Bool
== (LinearFunction s (LinearFunction s u v) (LinearMap s u v)
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunctionLinearFunction s (LinearFunction s u v) (LinearMap s u v)
-> LinearFunction s u v -> LinearMap s u v
forall 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 = SubBasis (ZeroDim s)
forall s. SubBasis (ZeroDim s)
ZeroBasis
  enumerateSubBasis :: SubBasis (ZeroDim s) -> [ZeroDim s]
enumerateSubBasis SubBasis (ZeroDim s)
ZeroBasis = []
  subbasisDimension :: SubBasis (ZeroDim s) -> Int
subbasisDimension SubBasis (ZeroDim s)
ZeroBasis = Int
0
  recomposeSB :: SubBasis (ZeroDim s)
-> [Scalar (ZeroDim s)] -> (ZeroDim s, [Scalar (ZeroDim s)])
recomposeSB SubBasis (ZeroDim s)
ZeroBasis [Scalar (ZeroDim s)]
l = (ZeroDim s
forall s. ZeroDim s
Origin, [Scalar (ZeroDim s)]
l)
  recomposeSBTensor :: SubBasis (ZeroDim s)
-> SubBasis w
-> [Scalar (ZeroDim s)]
-> (ZeroDim s ⊗ w, [Scalar (ZeroDim s)])
recomposeSBTensor SubBasis (ZeroDim s)
ZeroBasis SubBasis w
_ [Scalar (ZeroDim s)]
l = (TensorProduct (ZeroDim s) w -> Tensor s (ZeroDim s) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (ZeroDim s) w
forall s. ZeroDim s
Origin, [Scalar (ZeroDim s)]
l)
  recomposeLinMap :: SubBasis (ZeroDim s) -> [w] -> (ZeroDim s +> w, [w])
recomposeLinMap SubBasis (ZeroDim s)
ZeroBasis [w]
l = (TensorProduct (DualVector (ZeroDim s)) w
-> LinearMap s (ZeroDim s) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (ZeroDim s)) w
forall s. ZeroDim s
Origin, [w]
l)
  decomposeLinMap :: (ZeroDim s +> w) -> (SubBasis (ZeroDim s), DList w)
decomposeLinMap ZeroDim s +> w
_ = (SubBasis (ZeroDim s)
forall s. SubBasis (ZeroDim s)
ZeroBasis, DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
  decomposeLinMapWithin :: SubBasis (ZeroDim s)
-> (ZeroDim s +> w)
-> Either (SubBasis (ZeroDim s), DList w) (DList w)
decomposeLinMapWithin SubBasis (ZeroDim s)
ZeroBasis ZeroDim s +> w
_ = DList w -> Either (SubBasis (ZeroDim s), DList w) (DList w)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  recomposeContraLinMap :: (f (Scalar w) -> w) -> f (DualVector (ZeroDim s)) -> ZeroDim s +> w
recomposeContraLinMap f (Scalar w) -> w
_ f (DualVector (ZeroDim s))
_ = TensorProduct (DualVector (ZeroDim s)) w
-> LinearMap s (ZeroDim s) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (ZeroDim s)) w
forall s. ZeroDim s
Origin
  recomposeContraLinMapTensor :: (f (Scalar w) -> w)
-> f (ZeroDim s +> DualVector u) -> (ZeroDim s ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
_ f (ZeroDim s +> DualVector u)
_ = TensorProduct (DualVector (Tensor s (ZeroDim s) u)) w
-> LinearMap s (Tensor s (ZeroDim s) u) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (Tensor s (ZeroDim s) u)) w
forall s. ZeroDim s
Origin
  uncanonicallyFromDual :: DualVector (ZeroDim s) -+> ZeroDim s
uncanonicallyFromDual = DualVector (ZeroDim s) -+> ZeroDim s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  uncanonicallyToDual :: ZeroDim s -+> DualVector (ZeroDim s)
uncanonicallyToDual = ZeroDim s -+> DualVector (ZeroDim s)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  tensorEquality :: (ZeroDim s ⊗ w) -> (ZeroDim s ⊗ w) -> Bool
tensorEquality (Tensor TensorProduct (ZeroDim s) w
Origin) (Tensor 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 = SubBasis (V0 s)
forall s. SubBasis (V0 s)
V0Basis
  enumerateSubBasis :: SubBasis (V0 s) -> [V0 s]
enumerateSubBasis SubBasis (V0 s)
V0Basis = []
  subbasisDimension :: SubBasis (V0 s) -> Int
subbasisDimension SubBasis (V0 s)
V0Basis = Int
0
  recomposeSB :: SubBasis (V0 s) -> [Scalar (V0 s)] -> (V0 s, [Scalar (V0 s)])
recomposeSB SubBasis (V0 s)
V0Basis [Scalar (V0 s)]
l = (V0 s
forall a. V0 a
V0, [Scalar (V0 s)]
l)
  recomposeSBTensor :: SubBasis (V0 s)
-> SubBasis w -> [Scalar (V0 s)] -> (V0 s ⊗ w, [Scalar (V0 s)])
recomposeSBTensor SubBasis (V0 s)
V0Basis SubBasis w
_ [Scalar (V0 s)]
l = (TensorProduct (V0 s) w -> Tensor s (V0 s) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (V0 s) w
forall a. V0 a
V0, [Scalar (V0 s)]
l)
  recomposeLinMap :: SubBasis (V0 s) -> [w] -> (V0 s +> w, [w])
recomposeLinMap SubBasis (V0 s)
V0Basis [w]
l = (TensorProduct (DualVector (V0 s)) w -> LinearMap s (V0 s) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (V0 s)) w
forall a. V0 a
V0, [w]
l)
  decomposeLinMap :: (V0 s +> w) -> (SubBasis (V0 s), DList w)
decomposeLinMap V0 s +> w
_ = (SubBasis (V0 s)
forall s. SubBasis (V0 s)
V0Basis, DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
  decomposeLinMapWithin :: SubBasis (V0 s)
-> (V0 s +> w) -> Either (SubBasis (V0 s), DList w) (DList w)
decomposeLinMapWithin SubBasis (V0 s)
V0Basis V0 s +> w
_ = DList w -> Either (SubBasis (V0 s), DList w) (DList w)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  recomposeContraLinMap :: (f (Scalar w) -> w) -> f (DualVector (V0 s)) -> V0 s +> w
recomposeContraLinMap f (Scalar w) -> w
_ f (DualVector (V0 s))
_ = TensorProduct (DualVector (V0 s)) w -> LinearMap s (V0 s) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (V0 s)) w
forall a. V0 a
V0
  recomposeContraLinMapTensor :: (f (Scalar w) -> w) -> f (V0 s +> DualVector u) -> (V0 s ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
_ f (V0 s +> DualVector u)
_ = TensorProduct (DualVector (Tensor s (V0 s) u)) w
-> LinearMap s (Tensor s (V0 s) u) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector (Tensor s (V0 s) u)) w
forall a. V0 a
V0
  uncanonicallyFromDual :: DualVector (V0 s) -+> V0 s
uncanonicallyFromDual = DualVector (V0 s) -+> V0 s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  uncanonicallyToDual :: V0 s -+> DualVector (V0 s)
uncanonicallyToDual = V0 s -+> DualVector (V0 s)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  tensorEquality :: (V0 s ⊗ w) -> (V0 s ⊗ w) -> Bool
tensorEquality (Tensor TensorProduct (V0 s) w
V0) (Tensor TensorProduct (V0 s) w
V0) = Bool
True
  
instance FiniteDimensional ℝ where
  data SubBasis ℝ = RealsBasis
  entireBasis :: SubBasis ℝ
entireBasis = SubBasis ℝ
RealsBasis
  enumerateSubBasis :: SubBasis ℝ -> [ℝ]
enumerateSubBasis SubBasis ℝ
RealsBasis = [ℝ
1]
  subbasisDimension :: SubBasis ℝ -> Int
subbasisDimension SubBasis ℝ
RealsBasis = Int
1
  recomposeSB :: SubBasis ℝ -> [Scalar ℝ] -> (ℝ, [Scalar ℝ])
recomposeSB SubBasis ℝ
RealsBasis [] = (ℝ
0, [])
  recomposeSB SubBasis ℝ
RealsBasis (Scalar ℝ
μ:[Scalar ℝ]
cs) = (ℝ
Scalar ℝ
μ, [Scalar ℝ]
cs)
  recomposeSBTensor :: SubBasis ℝ -> SubBasis w -> [Scalar ℝ] -> (ℝ ⊗ w, [Scalar ℝ])
recomposeSBTensor SubBasis ℝ
RealsBasis SubBasis w
bw = (w -> Tensor ℝ ℝ w) -> (w, [ℝ]) -> (Tensor ℝ ℝ w, [ℝ])
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 -> Tensor ℝ ℝ w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor ((w, [ℝ]) -> (Tensor ℝ ℝ w, [ℝ]))
-> ([ℝ] -> (w, [ℝ])) -> [ℝ] -> (Tensor ℝ ℝ w, [ℝ])
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 w -> [Scalar w] -> (w, [Scalar w])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
bw
  recomposeLinMap :: SubBasis ℝ -> [w] -> (ℝ +> w, [w])
recomposeLinMap SubBasis ℝ
RealsBasis (w
w:[w]
ws) = (TensorProduct (DualVector ℝ) w -> LinearMap ℝ ℝ w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap w
TensorProduct (DualVector ℝ) w
w, [w]
ws)
  decomposeLinMap :: (ℝ +> w) -> (SubBasis ℝ, DList w)
decomposeLinMap (LinearMap TensorProduct (DualVector ℝ) w
v) = (SubBasis ℝ
RealsBasis, (w
TensorProduct (DualVector ℝ) w
vw -> DList w
forall a. a -> [a] -> [a]
:))
  decomposeLinMapWithin :: SubBasis ℝ -> (ℝ +> w) -> Either (SubBasis ℝ, DList w) (DList w)
decomposeLinMapWithin SubBasis ℝ
RealsBasis (LinearMap TensorProduct (DualVector ℝ) w
v) = DList w -> Either (SubBasis ℝ, DList w) (DList w)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (w
TensorProduct (DualVector ℝ) w
vw -> DList w
forall a. a -> [a] -> [a]
:)
  recomposeContraLinMap :: (f (Scalar w) -> w) -> f (DualVector ℝ) -> ℝ +> w
recomposeContraLinMap f (Scalar w) -> w
fw = w -> LinearMap ℝ ℝ w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (w -> LinearMap ℝ ℝ w) -> (f ℝ -> w) -> f ℝ -> LinearMap ℝ ℝ w
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 ℝ -> w
f (Scalar w) -> w
fw
  recomposeContraLinMapTensor :: (f (Scalar w) -> w) -> f (ℝ +> DualVector u) -> (ℝ ⊗ u) +> w
recomposeContraLinMapTensor f (Scalar w) -> w
fw = Coercion
  (LinearMap ℝ ℝ (LinearMap ℝ u w)) (LinearMap ℝ (Tensor ℝ ℝ u) w)
-> LinearMap ℝ ℝ (LinearMap ℝ u w) -> LinearMap ℝ (Tensor ℝ ℝ u) w
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 Coercion
  (LinearMap ℝ ℝ (LinearMap ℝ u w)) (LinearMap ℝ (Tensor ℝ ℝ u) w)
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap (LinearMap ℝ ℝ (LinearMap ℝ u w) -> LinearMap ℝ (Tensor ℝ ℝ u) w)
-> (f (LinearMap ℝ ℝ (DualVector u))
    -> LinearMap ℝ ℝ (LinearMap ℝ u w))
-> f (LinearMap ℝ ℝ (DualVector u))
-> LinearMap ℝ (Tensor ℝ ℝ u) w
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 u) u w -> LinearMap ℝ ℝ (LinearMap ℝ u w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap
              (LinearMap (Scalar u) u w -> LinearMap ℝ ℝ (LinearMap ℝ u w))
-> (f (LinearMap ℝ ℝ (DualVector u)) -> LinearMap (Scalar u) u w)
-> f (LinearMap ℝ ℝ (DualVector u))
-> LinearMap ℝ ℝ (LinearMap ℝ u w)
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) -> f (DualVector u) -> LinearMap (Scalar u) u 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 (f (DualVector u) -> LinearMap (Scalar u) u w)
-> (f (LinearMap ℝ ℝ (DualVector u)) -> f (DualVector u))
-> f (LinearMap ℝ ℝ (DualVector u))
-> LinearMap (Scalar u) u w
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 ℝ ℝ (DualVector u) -> DualVector u)
-> f (LinearMap ℝ ℝ (DualVector u)) -> f (DualVector u)
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 ℝ ℝ (DualVector u) -> DualVector u
forall s v w. LinearMap s v w -> TensorProduct (DualVector v) w
getLinearMap
  uncanonicallyFromDual :: DualVector ℝ -+> ℝ
uncanonicallyFromDual = DualVector ℝ -+> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  uncanonicallyToDual :: ℝ -+> DualVector ℝ
uncanonicallyToDual = ℝ -+> DualVector ℝ
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  tensorEquality :: (ℝ ⊗ w) -> (ℝ ⊗ w) -> Bool
tensorEquality (Tensor TensorProduct ℝ w
v) (Tensor TensorProduct ℝ w
w) = w
TensorProduct ℝ w
vw -> w -> Bool
forall a. Eq a => a -> a -> Bool
==w
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 :: SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
recomposeMultiple SubBasis w
bw Int
n [Scalar w]
dc
 | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
1        = ([], [Scalar w]
dc)
 | Bool
otherwise  = case SubBasis w -> [Scalar w] -> (w, [Scalar w])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
bw [Scalar w]
dc of
           (w
w, [Scalar w]
dc') -> ([w] -> [w]) -> ([w], [Scalar w]) -> ([w], [Scalar w])
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
ww -> [w] -> [w]
forall a. a -> [a] -> [a]
:) (([w], [Scalar w]) -> ([w], [Scalar w]))
-> ([w], [Scalar w]) -> ([w], [Scalar w])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
forall w.
FiniteDimensional w =>
SubBasis w -> Int -> [Scalar w] -> ([w], [Scalar w])
recomposeMultiple SubBasis w
bw (Int
nInt -> Int -> Int
forall 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, Scalar (DualVector u) ~ Scalar (DualVector v) )
            => FiniteDimensional (u,v) where
  data SubBasis (u,v) = TupleBasis !(SubBasis u) !(SubBasis v)
  entireBasis :: SubBasis (u, v)
entireBasis = SubBasis u -> SubBasis v -> SubBasis (u, v)
forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis SubBasis v
forall v. FiniteDimensional v => SubBasis v
entireBasis
  enumerateSubBasis :: SubBasis (u, v) -> [(u, v)]
enumerateSubBasis (TupleBasis bu bv)
       = ((,v
forall v. AdditiveGroup v => v
zeroV)(u -> (u, v)) -> [u] -> [(u, v)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>SubBasis u -> [u]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis u
bu) [(u, v)] -> [(u, v)] -> [(u, v)]
forall a. [a] -> [a] -> [a]
++ ((u
forall v. AdditiveGroup v => v
zeroV,)(v -> (u, v)) -> [v] -> [(u, v)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>SubBasis v -> [v]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
bv)
  subbasisDimension :: SubBasis (u, v) -> Int
subbasisDimension (TupleBasis bu bv) = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
  decomposeLinMap :: ((u, v) +> w) -> (SubBasis (u, v), DList w)
decomposeLinMap = DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> ((u, v) +> w)
-> (SubBasis (u, v), DList w)
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
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness w
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 :: 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 (fu, fv))
          = case ((u +> w) -> (SubBasis u, DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (Coercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapCoercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
-> Tensor (Scalar v) (DualVector u) w -> LinearMap (Scalar v) u w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector u) w
fu), (v +> w) -> (SubBasis v, DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (Coercion (Tensor (Scalar v) (DualVector v) w) (v +> w)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapCoercion (Tensor (Scalar v) (DualVector v) w) (v +> w)
-> Tensor (Scalar v) (DualVector v) w -> v +> w
forall (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)) -> (SubBasis u -> SubBasis v -> SubBasis (u, v)
forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu SubBasis v
bv, DList w
du DList w -> DList w -> DList w
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 :: SubBasis (u, v)
-> ((u, v) +> w) -> Either (SubBasis (u, v), DList w) (DList w)
decomposeLinMapWithin = DualSpaceWitness u
-> DualSpaceWitness v
-> DualSpaceWitness w
-> SubBasis (u, v)
-> ((u, v) +> w)
-> Either (SubBasis (u, v), DList w) (DList w)
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
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness w
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 :: 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 bu bv) (LinearMap (fu, fv))
          = case ( SubBasis u -> (u +> w) -> Either (SubBasis u, DList w) (DList w)
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 (Coercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapCoercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
-> Tensor (Scalar v) (DualVector u) w -> LinearMap (Scalar v) u w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$Tensor (Scalar v) (DualVector u) w
fu)
                 , SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
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 (Coercion (Tensor (Scalar v) (DualVector v) w) (v +> w)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMapCoercion (Tensor (Scalar v) (DualVector v) w) (v +> w)
-> Tensor (Scalar v) (DualVector v) w -> v +> w
forall (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', DList w
du), Left (SubBasis v
bv', DList w
dv)) -> (SubBasis (u, v), DList w)
-> Either (SubBasis (u, v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis u -> SubBasis v -> SubBasis (u, v)
forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu' SubBasis v
bv', DList w
du DList w -> DList w -> DList w
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)
            (Left (SubBasis u
bu', DList w
du), Right DList w
dv) -> (SubBasis (u, v), DList w)
-> Either (SubBasis (u, v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis u -> SubBasis v -> SubBasis (u, v)
forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu' SubBasis v
bv, DList w
du DList w -> DList w -> DList w
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)
            (Right DList w
du, Left (SubBasis v
bv', DList w
dv)) -> (SubBasis (u, v), DList w)
-> Either (SubBasis (u, v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis u -> SubBasis v -> SubBasis (u, v)
forall u v. SubBasis u -> SubBasis v -> SubBasis (u, v)
TupleBasis SubBasis u
bu SubBasis v
bv', DList w
du DList w -> DList w -> DList w
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)
            (Right DList w
du, Right DList w
dv) -> DList w -> Either (SubBasis (u, v), DList w) (DList w)
forall a b. b -> Either a b
Right (DList w -> Either (SubBasis (u, v), DList w) (DList w))
-> DList w -> Either (SubBasis (u, v), DList w) (DList w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DList w
du DList w -> DList w -> DList w
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
  recomposeSB :: SubBasis (u, v) -> [Scalar (u, v)] -> ((u, v), [Scalar (u, v)])
recomposeSB (TupleBasis bu bv) [Scalar (u, v)]
coefs = case SubBasis u -> [Scalar u] -> (u, [Scalar u])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
bu [Scalar u]
[Scalar (u, v)]
coefs of
                        (u
u, [Scalar u]
coefs') -> case SubBasis v -> [Scalar v] -> (v, [Scalar v])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis v
bv [Scalar u]
[Scalar v]
coefs' of
                         (v
v, [Scalar v]
coefs'') -> ((u
u,v
v), [Scalar v]
[Scalar (u, v)]
coefs'')
  recomposeSBTensor :: SubBasis (u, v)
-> SubBasis w -> [Scalar (u, v)] -> ((u, v) ⊗ w, [Scalar (u, v)])
recomposeSBTensor (TupleBasis bu bv) SubBasis w
bw [Scalar (u, v)]
cs = case SubBasis u -> SubBasis w -> [Scalar u] -> (u ⊗ w, [Scalar u])
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]
[Scalar (u, v)]
cs of
            (u ⊗ w
tuw, [Scalar u]
cs') -> case SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
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]
[Scalar v]
cs' of
               (v ⊗ w
tvw, [Scalar v]
cs'') -> (TensorProduct (u, v) w -> Tensor (Scalar v) (u, v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (u ⊗ w
Tensor (Scalar v) u w
tuw, v ⊗ w
tvw), [Scalar v]
[Scalar (u, v)]
cs'')
  recomposeLinMap :: SubBasis (u, v) -> [w] -> ((u, v) +> w, [w])
recomposeLinMap (TupleBasis bu bv) [w]
ws = case SubBasis u -> [w] -> (u +> w, [w])
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') -> (LinearMap (Scalar v) v w -> LinearMap (Scalar v) (u, v) w)
-> (LinearMap (Scalar v) v w, [w])
-> (LinearMap (Scalar v) (u, v) w, [w])
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
lmu(u +> w) -> LinearMap (Scalar v) v w -> (u, v) +> w
forall u w v. (u +> w) -> (v +> w) -> (u, v) +> w
⊕) ((LinearMap (Scalar v) v w, [w])
 -> (LinearMap (Scalar v) (u, v) w, [w]))
-> (LinearMap (Scalar v) v w, [w])
-> (LinearMap (Scalar v) (u, v) w, [w])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ SubBasis v -> [w] -> (LinearMap (Scalar v) v w, [w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv [w]
ws'
  recomposeContraLinMap :: (f (Scalar w) -> w) -> f (DualVector (u, v)) -> (u, v) +> w
recomposeContraLinMap f (Scalar w) -> w
fw f (DualVector (u, v))
dds
         = (f (Scalar w) -> w) -> f (DualVector u) -> u +> 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 ((DualVector u, DualVector v) -> DualVector u
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((DualVector u, DualVector v) -> DualVector u)
-> f (DualVector u, DualVector v) -> f (DualVector u)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>f (DualVector u, DualVector v)
f (DualVector (u, v))
dds)
          (u +> w) -> (v +> w) -> (u, v) +> w
forall u w v. (u +> w) -> (v +> w) -> (u, v) +> w
⊕ (f (Scalar w) -> w) -> f (DualVector v) -> 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 ((DualVector u, DualVector v) -> DualVector v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((DualVector u, DualVector v) -> DualVector v)
-> f (DualVector u, DualVector v) -> f (DualVector v)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>f (DualVector u, DualVector v)
f (DualVector (u, v))
dds)
  recomposeContraLinMapTensor :: (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 ( ScalarSpaceWitness u
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness u
                                            , DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
                                            , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
    (ScalarSpaceWitness u
ScalarSpaceWitness,DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness) -> Coercion
  (LinearMap (Scalar v) (u, v) (LinearMap (Scalar v) u w))
  (LinearMap (Scalar v) (Tensor (Scalar v) (u, v) u) w)
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap
         Coercion
  (LinearMap (Scalar v) (u, v) (LinearMap (Scalar v) u w))
  (LinearMap (Scalar v) (Tensor (Scalar v) (u, v) u) w)
-> LinearMap (Scalar v) (u, v) (LinearMap (Scalar v) u w)
-> LinearMap (Scalar v) (Tensor (Scalar v) (u, v) u) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct (DualVector (u, v)) (LinearMap (Scalar v) u w)
-> LinearMap (Scalar v) (u, v) (LinearMap (Scalar v) u w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap ( Coercion
  (LinearMap (Scalar v) u (LinearMap (Scalar v) u w))
  (Tensor (Scalar v) (DualVector u) (LinearMap (Scalar v) u w))
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap Coercion
  (LinearMap (Scalar v) u (LinearMap (Scalar v) u w))
  (Tensor (Scalar v) (DualVector u) (LinearMap (Scalar v) u w))
-> Coercion
     (LinearMap (Scalar v) (Tensor (Scalar v) u u) w)
     (LinearMap (Scalar v) u (LinearMap (Scalar v) u w))
-> Coercion
     (LinearMap (Scalar v) (Tensor (Scalar v) u u) w)
     (Tensor (Scalar v) (DualVector u) (LinearMap (Scalar v) u w))
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
. Coercion
  (LinearMap (Scalar v) (Tensor (Scalar v) u u) w)
  (LinearMap (Scalar v) u (LinearMap (Scalar v) u w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
                         Coercion
  (LinearMap (Scalar v) (Tensor (Scalar v) u u) w)
  (Tensor (Scalar v) (DualVector u) (LinearMap (Scalar v) u w))
-> LinearMap (Scalar v) (Tensor (Scalar v) u u) w
-> Tensor (Scalar v) (DualVector u) (LinearMap (Scalar v) u w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w) -> f (u +> DualVector u) -> (u ⊗ u) +> w
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
                                 ((LinearMap (Scalar v) (u, v) (DualVector u)
 -> LinearMap (Scalar v) u (DualVector u))
-> f (LinearMap (Scalar v) (u, v) (DualVector u))
-> f (LinearMap (Scalar v) u (DualVector u))
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 tu,_))->TensorProduct (DualVector u) (DualVector u)
-> LinearMap (Scalar v) u (DualVector u)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector u) (DualVector u)
tu) f (LinearMap (Scalar v) (u, v) (DualVector u))
f ((u, v) +> DualVector u)
dds)
                     , Coercion
  (LinearMap (Scalar v) v (LinearMap (Scalar v) u w))
  (Tensor (Scalar v) (DualVector v) (LinearMap (Scalar v) u w))
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap Coercion
  (LinearMap (Scalar v) v (LinearMap (Scalar v) u w))
  (Tensor (Scalar v) (DualVector v) (LinearMap (Scalar v) u w))
-> Coercion
     (LinearMap (Scalar v) (Tensor (Scalar v) v u) w)
     (LinearMap (Scalar v) v (LinearMap (Scalar v) u w))
-> Coercion
     (LinearMap (Scalar v) (Tensor (Scalar v) v u) w)
     (Tensor (Scalar v) (DualVector v) (LinearMap (Scalar v) u w))
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
. Coercion
  (LinearMap (Scalar v) (Tensor (Scalar v) v u) w)
  (LinearMap (Scalar v) v (LinearMap (Scalar v) u w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
                         Coercion
  (LinearMap (Scalar v) (Tensor (Scalar v) v u) w)
  (Tensor (Scalar v) (DualVector v) (LinearMap (Scalar v) u w))
-> LinearMap (Scalar v) (Tensor (Scalar v) v u) w
-> Tensor (Scalar v) (DualVector v) (LinearMap (Scalar v) u w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w)
-> f (v +> DualVector u) -> Tensor (Scalar v) v u +> w
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
                                 ((LinearMap (Scalar v) (u, v) (DualVector u) -> v +> DualVector u)
-> f (LinearMap (Scalar v) (u, v) (DualVector u))
-> f (v +> DualVector u)
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 tv))->TensorProduct (DualVector v) (DualVector u) -> v +> DualVector u
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap TensorProduct (DualVector v) (DualVector u)
tv) f (LinearMap (Scalar v) (u, v) (DualVector u))
f ((u, v) +> DualVector u)
dds) )
  uncanonicallyFromDual :: DualVector (u, v) -+> (u, v)
uncanonicallyFromDual = case ( DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
                               , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
        (DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
            -> LinearFunction (Scalar v) (DualVector u) u
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual LinearFunction (Scalar v) (DualVector u) u
-> LinearFunction (Scalar v) (DualVector v) v
-> LinearFunction (Scalar v) (DualVector u, DualVector v) (u, v)
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')
*** LinearFunction (Scalar v) (DualVector v) v
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual
  uncanonicallyToDual :: (u, v) -+> DualVector (u, v)
uncanonicallyToDual = case ( DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
                             , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
        (DualSpaceWitness u
DualSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
            -> LinearFunction (Scalar v) u (DualVector u)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction (Scalar v) u (DualVector u)
-> LinearFunction (Scalar v) v (DualVector v)
-> LinearFunction (Scalar v) (u, v) (DualVector u, DualVector v)
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')
*** LinearFunction (Scalar v) v (DualVector v)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
  tensorEquality :: ((u, v) ⊗ w) -> ((u, v) ⊗ w) -> Bool
tensorEquality (Tensor (s₀,s₁)) (Tensor (t₀,t₁)) 
      = (u ⊗ w) -> (u ⊗ w) -> Bool
forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality u ⊗ w
Tensor (Scalar v) u w
s₀ u ⊗ w
Tensor (Scalar v) u w
t₀ Bool -> Bool -> Bool
&& (v ⊗ w) -> (v ⊗ w) -> Bool
forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality v ⊗ w
s₁ v ⊗ w
t₁
  dualFinitenessWitness :: DualFinitenessWitness (u, v)
dualFinitenessWitness = case ( FiniteDimensional u => DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
                               , FiniteDimensional v => DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
      (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
       , DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
          -> DualSpaceWitness (u, v) -> DualFinitenessWitness (u, v)
forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness DualSpaceWitness (u, v)
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 = SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis SubBasis v
forall v. FiniteDimensional v => SubBasis v
entireBasis
  enumerateSubBasis :: SubBasis (Tensor s u v) -> [Tensor s u v]
enumerateSubBasis (TensorBasis bu bv)
       = [ u
uu -> v -> u ⊗ v
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
 Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗v
v | u
u <- SubBasis u -> [u]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis u
bu, v
v <- SubBasis v -> [v]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
bv ]
  subbasisDimension :: SubBasis (Tensor s u v) -> Int
subbasisDimension (TensorBasis bu bv) = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu Int -> Int -> Int
forall a. Num a => a -> a -> a
* SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
  decomposeLinMap :: (Tensor s u v +> w) -> (SubBasis (Tensor s u v), DList w)
decomposeLinMap = DualSpaceWitness w -> ((u ⊗ v) +> w) -> (SubBasis (u ⊗ v), DList w)
forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w -> ((u ⊗ v) +> w) -> (SubBasis (u ⊗ v), DList w)
dlm DualSpaceWitness w
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 :: DualSpaceWitness w -> ((u ⊗ v) +> w) -> (SubBasis (u ⊗ v), DList w)
dlm DualSpaceWitness w
DualSpaceWitness (u ⊗ v) +> w
muvw = case LinearMap s u (LinearMap s v w)
-> (SubBasis u, [LinearMap s v w] -> [LinearMap s v w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (LinearMap s u (LinearMap s v w)
 -> (SubBasis u, [LinearMap s v w] -> [LinearMap s v w]))
-> LinearMap s u (LinearMap s v w)
-> (SubBasis u, [LinearMap s v w] -> [LinearMap s v w])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
-> LinearMap s (Tensor s u v) w -> LinearMap s u (LinearMap s v w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s (Tensor s u v) w
(u ⊗ v) +> w
muvw of
           (SubBasis u
bu, [LinearMap s v w] -> [LinearMap s v w]
mvwsg) -> (SubBasis v -> SubBasis (Tensor s u v))
-> (SubBasis v, DList w) -> (SubBasis (Tensor s u v), DList w)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
bu) ((SubBasis v, DList w) -> (SubBasis (Tensor s u v), DList w))
-> ([LinearMap s v w] -> (SubBasis v, DList w))
-> [LinearMap s v w]
-> (SubBasis (Tensor s u v), DList w)
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 s v w] -> (SubBasis v, DList w)
[LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go ([LinearMap s v w] -> (SubBasis (Tensor s u v), DList w))
-> [LinearMap s v w] -> (SubBasis (Tensor s u v), DList w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [LinearMap s v w] -> [LinearMap s 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))
_) = ([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)))
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 :: SubBasis (Tensor s u v)
-> (Tensor s u v +> w)
-> Either (SubBasis (Tensor s u v), DList w) (DList w)
decomposeLinMapWithin = DualSpaceWitness w
-> SubBasis (u ⊗ v)
-> ((u ⊗ v) +> w)
-> Either (SubBasis (u ⊗ v), DList w) (DList w)
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
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 :: DualSpaceWitness w
-> SubBasis (u ⊗ v)
-> ((u ⊗ v) +> w)
-> Either (SubBasis (u ⊗ v), DList w) (DList w)
dlm DualSpaceWitness w
DualSpaceWitness (TensorBasis bu bv) (u ⊗ v) +> w
muvw
               = case SubBasis u
-> (u +> LinearMap s v w)
-> Either
     (SubBasis u, [LinearMap s v w] -> [LinearMap s v w])
     ([LinearMap s v w] -> [LinearMap s v w])
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 (LinearMap s u (LinearMap s v w)
 -> Either
      (SubBasis u, [LinearMap s v w] -> [LinearMap s v w])
      ([LinearMap s v w] -> [LinearMap s v w]))
-> LinearMap s u (LinearMap s v w)
-> Either
     (SubBasis u, [LinearMap s v w] -> [LinearMap s v w])
     ([LinearMap s v w] -> [LinearMap s v w])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
-> LinearMap s (Tensor s u v) w -> LinearMap s u (LinearMap s v w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s (Tensor s u v) w
(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 DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id ([LinearMap s v w] -> [LinearMap s v w]
mvwsg []) DList (LinearMap (Scalar v) v w)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                                in (SubBasis (Tensor s u v), DList w)
-> Either (SubBasis (Tensor s u v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
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 DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id ([LinearMap s v w] -> [LinearMap s v w]
mvwsg []) DList (LinearMap (Scalar v) v w)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                          in if Bool
changed
                              then (SubBasis (Tensor s u v), DList w)
-> Either (SubBasis (Tensor s u v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis u
bu SubBasis v
bv', DList w
ws)
                              else DList w -> Either (SubBasis (Tensor s u v), DList w) (DList w)
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) = ([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)))
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 bu bv) = SubBasis u -> SubBasis v -> [Scalar u] -> (u ⊗ v, [Scalar u])
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 :: SubBasis (Tensor s u v)
-> SubBasis w
-> [Scalar (Tensor s u v)]
-> (Tensor s u v ⊗ w, [Scalar (Tensor s u v)])
recomposeSBTensor = DualSpaceWitness w
-> SubBasis (u ⊗ v) -> SubBasis w -> [s] -> ((u ⊗ v) ⊗ w, [s])
forall w.
(FiniteDimensional w, Scalar w ~ s) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> SubBasis w -> [s] -> ((u ⊗ v) ⊗ w, [s])
rst DualSpaceWitness w
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 :: DualSpaceWitness w
-> SubBasis (u ⊗ v) -> SubBasis w -> [s] -> ((u ⊗ v) ⊗ w, [s])
rst DualSpaceWitness w
DualSpaceWitness (TensorBasis bu bv) SubBasis w
bw
          = (Tensor s u (Tensor s v w) -> Tensor s (Tensor s u v) w)
-> (Tensor s u (Tensor s v w), [s])
-> (Tensor s (Tensor s u v) w, [s])
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (Coercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
-> Tensor s u (Tensor s v w) -> Tensor s (Tensor s u v) w
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 Coercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
forall s u v w.
Coercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
lassocTensor) ((Tensor s u (Tensor s v w), [s])
 -> (Tensor s (Tensor s u v) w, [s]))
-> ([s] -> (Tensor s u (Tensor s v w), [s]))
-> [s]
-> (Tensor s (Tensor s u v) w, [s])
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 u
-> SubBasis (Tensor s v w)
-> [Scalar u]
-> (u ⊗ Tensor s v w, [Scalar u])
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 -> SubBasis w -> SubBasis (Tensor s v w)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
bv SubBasis w
bw)
  recomposeLinMap :: SubBasis (Tensor s u v) -> [w] -> (Tensor s u v +> w, [w])
recomposeLinMap = DualSpaceWitness w
-> SubBasis (u ⊗ v) -> [w] -> ((u ⊗ v) +> w, [w])
forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> SubBasis (u ⊗ v) -> [w] -> ((u ⊗ v) +> w, [w])
rlm DualSpaceWitness w
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 :: DualSpaceWitness w
-> SubBasis (u ⊗ v) -> [w] -> ((u ⊗ v) +> w, [w])
rlm DualSpaceWitness w
DualSpaceWitness (TensorBasis bu bv) [w]
ws
             = ( Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
-> LinearMap s u (LinearMap s v w) -> LinearMap s (Tensor s u v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s u (LinearMap s v w), [LinearMap s v w])
-> LinearMap s u (LinearMap s v w)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((LinearMap s u (LinearMap s v w), [LinearMap s v w])
 -> LinearMap s u (LinearMap s v w))
-> ([LinearMap s v w]
    -> (LinearMap s u (LinearMap s v w), [LinearMap s v w]))
-> [LinearMap s v w]
-> LinearMap s u (LinearMap s v w)
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 u
-> [LinearMap s v w] -> (u +> LinearMap s v w, [LinearMap s v w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis u
bu
                           ([LinearMap s v w] -> LinearMap s u (LinearMap s v w))
-> [LinearMap s v w] -> LinearMap s u (LinearMap s v w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([w] -> Maybe (LinearMap s v w, [w])) -> [w] -> [LinearMap s v w]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((LinearMap s v w, [w]) -> Maybe (LinearMap s v w, [w])
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ((LinearMap s v w, [w]) -> Maybe (LinearMap s v w, [w]))
-> ([w] -> (LinearMap s v w, [w]))
-> [w]
-> Maybe (LinearMap s v w, [w])
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 -> [w] -> (v +> w, [w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv) [w]
ws
               , Int -> [w] -> [w]
forall a. Int -> [a] -> [a]
drop (SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis u
bu Int -> Int -> Int
forall a. Num a => a -> a -> a
* SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv) [w]
ws )
  recomposeContraLinMap :: (f (Scalar w) -> w)
-> f (DualVector (Tensor s u v)) -> Tensor s u v +> w
recomposeContraLinMap = case DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u of
     DualSpaceWitness u
DualSpaceWitness -> (f (Scalar w) -> w)
-> f (DualVector (Tensor s u v)) -> Tensor s u v +> w
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 :: (f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u) -> (Tensor s u v ⊗ u) +> w
recomposeContraLinMapTensor = DualSpaceWitness u
-> DualSpaceWitness u
-> (f (Scalar w) -> w)
-> f (Tensor s u v +> DualVector u)
-> (Tensor s u v ⊗ u) +> w
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
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness u
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 :: 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
              = Coercion
  (LinearMap s (Tensor s u v) (LinearMap s u' w))
  (LinearMap s (Tensor s (Tensor s u v) u') w)
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap Coercion
  (LinearMap s (Tensor s u v) (LinearMap s u' w))
  (LinearMap s (Tensor s (Tensor s u v) u') w)
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s (Tensor s u v) (LinearMap s u' w))
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s (Tensor s (Tensor s u v) u') w)
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
. Coercion
  (LinearMap s u (LinearMap s v (LinearMap s u' w)))
  (LinearMap s (Tensor s u v) (LinearMap s u' w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap
                             Coercion
  (LinearMap s u (LinearMap s v (LinearMap s u' w)))
  (LinearMap s (Tensor s u v) (LinearMap s u' w))
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s u (LinearMap s v (LinearMap s u' w)))
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s (Tensor s u v) (LinearMap s u' w))
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
. Coercion
  (LinearMap s (Tensor s v u') w) (LinearMap s v (LinearMap s u' w))
-> Coercion
     (LinearMap s u (LinearMap s (Tensor s v u') w))
     (LinearMap s u (LinearMap s v (LinearMap s u' 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 (Coercion
  (LinearMap s (Tensor s v u') w) (LinearMap s v (LinearMap s u' w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap) Coercion
  (LinearMap s u (LinearMap s (Tensor s v u') w))
  (LinearMap s u (LinearMap s v (LinearMap s u' w)))
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s u (LinearMap s (Tensor s v u') w))
-> Coercion
     (LinearMap s (Tensor s u (Tensor s v u')) w)
     (LinearMap s u (LinearMap s v (LinearMap s u' w)))
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
. Coercion
  (LinearMap s (Tensor s u (Tensor s v u')) w)
  (LinearMap s u (LinearMap s (Tensor s v u') w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap
               Coercion
  (LinearMap s (Tensor s u (Tensor s v u')) w)
  (LinearMap s (Tensor s (Tensor s u v) u') w)
-> LinearMap s (Tensor s u (Tensor s v u')) w
-> LinearMap s (Tensor s (Tensor s u v) u') w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w)
-> f (u +> DualVector (Tensor s v u')) -> (u ⊗ Tensor s v u') +> w
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 (f (LinearMap (Scalar u) u (LinearMap s v (DualVector u')))
 -> LinearMap s (Tensor s u (Tensor s v u')) w)
-> f (LinearMap (Scalar u) u (LinearMap s v (DualVector u')))
-> LinearMap s (Tensor s u (Tensor s v u')) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (Tensor s u v) (DualVector u')
 -> LinearMap s u (LinearMap s v (DualVector u')))
-> f (LinearMap s (Tensor s u v) (DualVector u'))
-> f (LinearMap (Scalar u) u (LinearMap s v (DualVector u')))
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 (Coercion
  (LinearMap s (Tensor s u v) (DualVector u'))
  (LinearMap s u (LinearMap s v (DualVector u')))
-> LinearMap s (Tensor s u v) (DualVector u')
-> LinearMap s u (LinearMap s v (DualVector u'))
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 Coercion
  (LinearMap s (Tensor s u v) (DualVector u'))
  (LinearMap s u (LinearMap s v (DualVector u')))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap) f (LinearMap s (Tensor s u v) (DualVector u'))
f (Tensor s u v +> DualVector u')
dds
  uncanonicallyToDual :: Tensor s u v -+> DualVector (Tensor s u v)
uncanonicallyToDual = case ( DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
                             , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> LinearFunction s v (DualVector v)
-> LinearFunction
     (Scalar (DualVector v)) (Tensor s u v) (Tensor s u (DualVector v))
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 (DualVector v)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual 
            LinearFunction
  (Scalar (DualVector v)) (Tensor s u v) (Tensor s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s u (DualVector v))
     (LinearMap s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s u v)
     (LinearMap s u (DualVector 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
>>> LinearFunction
  (Scalar (DualVector v))
  (Tensor s u (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor LinearFunction
  (Scalar (DualVector v))
  (Tensor s u (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
     (LinearMap s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s u (DualVector v))
     (LinearMap s u (DualVector 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
>>> LinearFunction s u (DualVector u)
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
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 u (DualVector u)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
            LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
     (LinearMap s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
     (LinearMap s u (DualVector 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
>>> LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
     (LinearMap s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
     (LinearMap s u (DualVector 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
>>> Coercion
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
  (LinearMap s u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
     (LinearMap s u (DualVector v))
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 Coercion
  (Tensor (Scalar (DualVector u)) (DualVector u) (DualVector v))
  (LinearMap s u (DualVector v))
forall s v w.
Coercion (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor
  uncanonicallyFromDual :: DualVector (Tensor s u v) -+> Tensor s u v
uncanonicallyFromDual = case ( DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u
                               , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> Coercion
  (LinearMap s u (DualVector v))
  (Tensor s (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar v)
     (LinearMap s u (DualVector v))
     (Tensor s (DualVector u) (DualVector v))
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 Coercion
  (LinearMap s u (DualVector v))
  (Tensor s (DualVector u) (DualVector v))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor
            LinearFunction
  (Scalar v)
  (LinearMap s u (DualVector v))
  (Tensor s (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar v) (Tensor s (DualVector u) (DualVector v)) (Tensor s u v)
-> LinearFunction
     (Scalar v) (LinearMap s u (DualVector v)) (Tensor s 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
>>> LinearFunction (Scalar v) (DualVector v) v
-> LinearFunction
     (Scalar v)
     (Tensor s (DualVector u) (DualVector v))
     (Tensor s (DualVector u) v)
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 (Scalar v) (DualVector v) v
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual 
            LinearFunction
  (Scalar v)
  (Tensor s (DualVector u) (DualVector v))
  (Tensor s (DualVector u) v)
-> LinearFunction
     (Scalar v) (Tensor s (DualVector u) v) (Tensor s u v)
-> LinearFunction
     (Scalar v) (Tensor s (DualVector u) (DualVector v)) (Tensor s 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
>>> LinearFunction
  (Scalar v)
  (Tensor s (DualVector u) v)
  (Tensor (Scalar v) v (DualVector u))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor LinearFunction
  (Scalar v)
  (Tensor s (DualVector u) v)
  (Tensor (Scalar v) v (DualVector u))
-> LinearFunction
     (Scalar v) (Tensor (Scalar v) v (DualVector u)) (Tensor s u v)
-> LinearFunction
     (Scalar v) (Tensor s (DualVector u) v) (Tensor s 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
>>> LinearFunction (Scalar u) (DualVector u) u
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) v (DualVector u))
     (Tensor (Scalar v) v u)
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 (Scalar u) (DualVector u) u
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual
            LinearFunction
  (Scalar v)
  (Tensor (Scalar v) v (DualVector u))
  (Tensor (Scalar v) v u)
-> LinearFunction (Scalar v) (Tensor (Scalar v) v u) (Tensor s u v)
-> LinearFunction
     (Scalar v) (Tensor (Scalar v) v (DualVector u)) (Tensor s 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
>>> LinearFunction (Scalar v) (Tensor (Scalar v) v u) (Tensor s u v)
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
  tensorEquality :: (Tensor s u v ⊗ w) -> (Tensor s u v ⊗ w) -> Bool
tensorEquality = (Tensor s u v ⊗ w) -> (Tensor s u v ⊗ w) -> Bool
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 ( FiniteDimensional u => DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
                               , FiniteDimensional v => DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
      (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
       , DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
          -> DualSpaceWitness (Tensor s u v)
-> DualFinitenessWitness (Tensor s u v)
forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness DualSpaceWitness (Tensor s u v)
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 :: 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)
    = (u ⊗ Tensor s v w) -> (u ⊗ Tensor s v w) -> Bool
forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality (TensorProduct u (Tensor s v w) -> Tensor s u (Tensor s v w)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct u (Tensor s v w)
TensorProduct (Tensor s u v) w
s :: Tensor s u (v⊗w)) (TensorProduct u (Tensor s v w) -> Tensor s u (Tensor s v w)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct u (Tensor s v w)
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 :: ([v +> w] -> (SubBasis v, DList w),
 SubBasis v
 -> DList w
 -> [v +> w]
 -> DList (v +> w)
 -> (Bool, (SubBasis v, DList w)))
tensorLinmapDecompositionhelpers = ([v +> w] -> (SubBasis v, DList w)
forall v w.
(FiniteDimensional v, Num' (Scalar w), LinearSpace w,
 LinearSpace (DualVector w), Scalar w ~ Scalar v) =>
[LinearMap (Scalar v) v w] -> (SubBasis v, DList w)
go, SubBasis v
-> DList w
-> [v +> w]
-> DList (v +> w)
-> (Bool, (SubBasis v, DList w))
forall v w.
(FiniteDimensional v, Num' (Scalar w), LinearSpace w,
 LinearSpace (DualVector w), Scalar w ~ Scalar v) =>
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 [] = LinearMap (Scalar v) v w -> (SubBasis v, DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap LinearMap (Scalar v) v w
forall v. AdditiveGroup v => v
zeroV
         go (LinearMap (Scalar v) v w
mvw:[LinearMap (Scalar v) v w]
mvws) = case LinearMap (Scalar v) v w -> (SubBasis v, DList w)
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) -> (Bool, (SubBasis v, DList w)) -> (SubBasis v, DList w)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (SubBasis v
-> DList w
-> [LinearMap (Scalar v) v w]
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> (Bool, (SubBasis v, DList w))
forall v w.
(FiniteDimensional v, Num' (Scalar w), LinearSpace w,
 LinearSpace (DualVector w), Scalar w ~ Scalar v) =>
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
mvwLinearMap (Scalar v) v w
-> [LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
forall 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 SubBasis v
-> LinearMap (Scalar v) v w
-> Either (SubBasis v, [w] -> [w]) ([w] -> [w])
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 ([w] -> [w]) -> ([w] -> [w]) -> [w] -> [w]
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 ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> [LinearMap (Scalar v) v w]
-> [LinearMap (Scalar v) v w]
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
mvwLinearMap (Scalar v) v w
-> [LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
forall a. a -> [a] -> [a]
:))
              Left (SubBasis v
bv', [w] -> [w]
cfs) -> (Bool -> Bool)
-> (Bool, (SubBasis v, [w] -> [w]))
-> (Bool, (SubBasis v, [w] -> [w]))
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (Bool -> Bool -> Bool
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' (SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
forall v w.
(FiniteDimensional v, Num' (Scalar w), LinearSpace w,
 LinearSpace (DualVector w), Scalar w ~ Scalar v) =>
SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
regoWith SubBasis v
bv' ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
prevs[]) ([w] -> [w]) -> ([w] -> [w]) -> [w] -> [w]
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 ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> ([LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w])
-> [LinearMap (Scalar v) v w]
-> [LinearMap (Scalar v) v w]
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
mvwLinearMap (Scalar v) v w
-> [LinearMap (Scalar v) v w] -> [LinearMap (Scalar v) v w]
forall a. a -> [a] -> [a]
:)) )
         regoWith :: SubBasis v -> [LinearMap (Scalar v) v w] -> [w] -> [w]
regoWith SubBasis v
_ [] = [w] -> [w]
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 SubBasis v
-> LinearMap (Scalar v) v w
-> Either (SubBasis v, [w] -> [w]) ([w] -> [w])
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 ([w] -> [w]) -> ([w] -> [w]) -> [w] -> [w]
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])
_ -> [Char] -> [w] -> [w]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [w] -> [w]) -> [Char] -> [w] -> [w]
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
tTensor s v v -> Tensor s v v -> Bool
forall 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 = SubBasis v -> SubBasis (SymmetricTensor s v)
forall s v. SubBasis v -> SubBasis (SymmetricTensor s v)
SymTensBasis SubBasis v
forall v. FiniteDimensional v => SubBasis v
entireBasis
  enumerateSubBasis :: SubBasis (SymmetricTensor s v) -> [SymmetricTensor s v]
enumerateSubBasis (SymTensBasis b) = do
        v
v:[v]
vs <- [v] -> [[v]]
forall a. [a] -> [[a]]
tails ([v] -> [[v]]) -> [v] -> [[v]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ SubBasis v -> [v]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis v
b
        v -> SymmetricTensor s v
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
v
          SymmetricTensor s v
-> [SymmetricTensor s v] -> [SymmetricTensor s v]
forall a. a -> [a] -> [a]
: [ (v -> SymmetricTensor s v
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV (v
vv -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^v
w) SymmetricTensor s v -> SymmetricTensor s v -> SymmetricTensor s v
forall v. AdditiveGroup v => v -> v -> v
^-^ v -> SymmetricTensor s v
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
v SymmetricTensor s v -> SymmetricTensor s v -> SymmetricTensor s v
forall v. AdditiveGroup v => v -> v -> v
^-^ v -> SymmetricTensor s v
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV v
w) SymmetricTensor s v -> s -> SymmetricTensor s v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* s
sqrt¹₂ | v
w <- [v]
vs ]
   where sqrt¹₂ :: s
sqrt¹₂ = s -> s
forall a. Floating a => a -> a
sqrt s
0.5
  subbasisDimension :: SubBasis (SymmetricTensor s v) -> Int
subbasisDimension (SymTensBasis b) = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))Int -> Int -> Int
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 = SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b
  decomposeLinMap :: (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 DualFinitenessWitness v
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 f)
                    = (SubBasis v -> SubBasis (SymmetricTensor s v)
forall s v. SubBasis v -> SubBasis (SymmetricTensor s v)
SymTensBasis SubBasis v
SubBasis (DualVector (DualVector v))
bf, Int -> [[w]] -> DList w
rmRedundant Int
0 ([[w]] -> DList w) -> ([w] -> [[w]]) -> [w] -> DList w
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 ([w] -> DList w) -> [w] -> DList w
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
_ [] = DList w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                rmRedundant Int
k ([w]
row:[[w]]
rest)
                    = (DList w
sclOffdiag (Int -> DList w
forall a. Int -> [a] -> [a]
drop Int
k [w]
row)[w] -> DList w
forall a. [a] -> [a] -> [a]
++) DList w -> DList w -> DList w
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
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[w]]
rest
                symmetrise :: [w] -> [[w]]
symmetrise [w]
l = ([w] -> DList w) -> [[w]] -> [[w]] -> [[w]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((w -> w -> w) -> [w] -> DList w
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
(^+^)) [[w]]
lm ([[w]] -> [[w]]) -> [[w]] -> [[w]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [[w]] -> [[w]]
forall a. [[a]] -> [[a]]
transpose [[w]]
lm
                 where lm :: [[w]]
lm = [w] -> [[w]]
matr [w]
l
                matr :: [w] -> [[w]]
matr [] = []
                matr [w]
l = case Int -> [w] -> ([w], [w])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [w]
l of
                    ([w]
row,[w]
rest) -> [w]
row [w] -> [[w]] -> [[w]]
forall a. a -> [a] -> [a]
: [w] -> [[w]]
matr [w]
rest
                n :: Int
n = case SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
SubBasis (DualVector (DualVector v))
bf of
                      Int
nbf | Int
nbf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bf'  -> Int
nbf
                (LinMapBasis bf bf', DList w
dlw)
                    = LinearMap s (LinearMap s (DualVector v) v) w
-> (SubBasis (LinearMap s (DualVector v) v), DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (LinearMap s (LinearMap s (DualVector v) v) w
 -> (SubBasis (LinearMap s (DualVector v) v), DList w))
-> LinearMap s (LinearMap s (DualVector v) v) w
-> (SubBasis (LinearMap s (DualVector v) v), DList w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (LinearMap s (LinearMap s (DualVector v) v) w)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (LinearMap s (LinearMap s (DualVector v) v) w)
-> Coercion
     (Tensor s (DualVector v) (Tensor s (DualVector v) w))
     (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
-> Coercion
     (Tensor s (DualVector v) (Tensor s (DualVector v) w))
     (LinearMap s (LinearMap s (DualVector v) v) w)
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
. Coercion
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
forall s u v w.
Coercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
lassocTensor Coercion
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
  (LinearMap s (LinearMap s (DualVector v) v) w)
-> Tensor s (DualVector v) (Tensor s (DualVector v) w)
-> LinearMap s (LinearMap s (DualVector v) v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor s (DualVector v) (Tensor s (DualVector v) w)
TensorProduct (DualVector (SymmetricTensor s v)) w
f
                sclOffdiag :: DList w
sclOffdiag (w
d:[w]
o) = Scalar w
0.5Scalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
d w -> DList w
forall a. a -> [a] -> [a]
: ((w -> s -> w
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*s
sqrt¹₂)(w -> w) -> DList w
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¹₂ = s -> s
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 DualSpaceWitness v
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 b) [s]
ws
           = case SubBasis (Tensor s v v)
-> [Scalar (Tensor s v v)]
-> (Tensor s v v, [Scalar (Tensor s v v)])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB (SubBasis v -> SubBasis v -> SubBasis (Tensor s v v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
b SubBasis v
b)
                    ([s] -> (Tensor s v v, [s])) -> [s] -> (Tensor s v v, [s])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> [[s] -> [s]] -> [s] -> [s]
forall a. Floating a => Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (([s] -> [s]) -> [[s] -> [s]]
forall a. a -> [a]
repeat [s] -> [s]
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) [s]
ws of
              (Tensor s v v
t, [s]
remws) -> (Tensor s v v -> SymmetricTensor s v
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) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ws
                                    oscld :: [a]
oscld = (a -> a
forall a. Floating a => a -> a
sqrt a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*)(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₀ [] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
oscld
                                     [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> [[a] -> [a]] -> [[a] -> [a]] -> [[a] -> [a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a]) -> ([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
(.) [[a] -> [a]]
sds ([[a] -> [a]] -> [[a] -> [a]]) -> [[a] -> [a]] -> [[a] -> [a]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)(a -> [a] -> [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]
oscld) [a]
rest
  recomposeLinMap :: 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 DualFinitenessWitness v
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 b) [w]
ws
           = case SubBasis (LinearMap s (DualVector v) v)
-> [w] -> (LinearMap s (DualVector v) v +> w, [w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap (SubBasis (DualVector (DualVector v))
-> SubBasis v -> SubBasis (LinearMap s (DualVector v) v)
forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis v
SubBasis (DualVector (DualVector v))
b SubBasis v
b)
                    ([w] -> (LinearMap s (LinearMap s (DualVector v) v) w, [w]))
-> [w] -> (LinearMap s (LinearMap s (DualVector v) v) w, [w])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> [[w] -> [w]] -> [w] -> [w]
forall a.
(VectorSpace a, Floating (Scalar a)) =>
Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (([w] -> [w]) -> [[w] -> [w]]
forall a. a -> [a]
repeat [w] -> [w]
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) [w]
ws of
              (LinearMap s (LinearMap s (DualVector v) v) w
f, [w]
remws) -> (Tensor s (DualVector v) (Tensor s (DualVector v) w)
-> LinearMap s (SymmetricTensor s v) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Tensor s (DualVector v) (Tensor s (DualVector v) w)
 -> LinearMap s (SymmetricTensor s v) w)
-> Tensor s (DualVector v) (Tensor s (DualVector v) w)
-> LinearMap s (SymmetricTensor s v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
forall s u v w.
Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> Coercion
     (LinearMap s (LinearMap s (DualVector v) v) w)
     (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
-> Coercion
     (LinearMap s (LinearMap s (DualVector v) v) w)
     (Tensor s (DualVector v) (Tensor s (DualVector v) w))
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
. Coercion
  (LinearMap s (LinearMap s (DualVector v) v) w)
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor Coercion
  (LinearMap s (LinearMap s (DualVector v) v) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> LinearMap s (LinearMap s (DualVector v) v) w
-> Tensor s (DualVector v) (Tensor s (DualVector v) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s (LinearMap s (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) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ws
                                    oscld :: [a]
oscld = (Scalar a -> Scalar a
forall a. Floating a => a -> a
sqrt Scalar a
0.5Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
*^)(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₀ [] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
oscld
                                     [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [[a] -> [a]] -> [a] -> [a]
mkSym (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> [[a] -> [a]] -> [[a] -> [a]] -> [[a] -> [a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> [a]) -> ([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
(.) [[a] -> [a]]
sds ([[a] -> [a]] -> [[a] -> [a]]) -> [[a] -> [a]] -> [[a] -> [a]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)(a -> [a] -> [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]
oscld) [a]
rest
  recomposeSBTensor :: SubBasis (SymmetricTensor s v)
-> SubBasis w
-> [Scalar (SymmetricTensor s v)]
-> (SymmetricTensor s v ⊗ w, [Scalar (SymmetricTensor s v)])
recomposeSBTensor = SubBasis (SymmetricTensor s v)
-> SubBasis w
-> [Scalar (SymmetricTensor s v)]
-> (SymmetricTensor s v ⊗ w, [Scalar (SymmetricTensor s v)])
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 :: SubBasis (SymmetricTensor s v)
-> SubBasis w -> [s] -> (Tensor s (SymmetricTensor s v) w, [s])
rcst (SymTensBasis b) SubBasis w
bw [s]
μs
           = case SubBasis (Tensor s v v)
-> SubBasis w
-> [Scalar (Tensor s v v)]
-> (Tensor s v v ⊗ w, [Scalar (Tensor s v v)])
forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor (SubBasis v -> SubBasis v -> SubBasis (Tensor s v v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis v
b SubBasis v
b) SubBasis w
bw
                    ([s] -> (Tensor s (Tensor s v v) w, [s]))
-> [s] -> (Tensor s (Tensor s v v) w, [s])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int -> [[[s]] -> [[s]]] -> [s] -> [s]
forall a (t :: * -> *).
(Floating a, Foldable t) =>
Int -> Int -> [[[a]] -> t [a]] -> [a] -> [a]
mkSym (SubBasis w -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis w
bw) (SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
b) (([[s]] -> [[s]]) -> [[[s]] -> [[s]]]
forall a. a -> [a]
repeat [[s]] -> [[s]]
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) -> ( Tensor s v (Tensor s v w) -> Tensor s (SymmetricTensor s v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Tensor s v (Tensor s v w) -> Tensor s (SymmetricTensor s v) w)
-> Tensor s v (Tensor s v w) -> Tensor s (SymmetricTensor s v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct v (Tensor s v w) -> Tensor s v (Tensor s v w)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct v (Tensor s v w)
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) = Int -> Int -> [a] -> ([[a]], [a])
forall a. Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
nw Int
n [a]
ws
                                       oscld :: [[a]]
oscld = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a
forall a. Floating a => a -> a
sqrt a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*)([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 t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> t [a]
sd₀ []) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
d [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
oscld
                                       [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [[[a]] -> t [a]] -> [a] -> [a]
mkSym Int
nw (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((([[a]] -> t [a]) -> ([[a]] -> [[a]]) -> [[a]] -> t [a])
-> [[[a]] -> t [a]] -> [[[a]] -> [[a]]] -> [[[a]] -> t [a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([[a]] -> t [a]) -> ([[a]] -> [[a]]) -> [[a]] -> t [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
(.) [[[a]] -> t [a]]
sds ([[[a]] -> [[a]]] -> [[[a]] -> t [a]])
-> [[[a]] -> [[a]]] -> [[[a]] -> t [a]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (:)([a] -> [[a]] -> [[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]]
oscld) [a]
rest
  recomposeContraLinMap :: (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
           = Tensor s (DualVector v) (Tensor s (DualVector v) w)
-> LinearMap s (SymmetricTensor s v) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Tensor s (DualVector v) (Tensor s (DualVector v) w)
 -> LinearMap s (SymmetricTensor s v) w)
-> (f (Tensor s (DualVector v) (DualVector v))
    -> Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (SymmetricTensor s v) w
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
. Coercion
  (LinearMap s (LinearMap s (DualVector v) v) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> LinearMap s (LinearMap s (DualVector v) v) w
-> Tensor s (DualVector v) (Tensor s (DualVector v) w)
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 (Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
forall s u v w.
Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> Coercion
     (LinearMap s (LinearMap s (DualVector v) v) w)
     (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
-> Coercion
     (LinearMap s (LinearMap s (DualVector v) v) w)
     (Tensor s (DualVector v) (Tensor s (DualVector v) w))
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
. Coercion
  (LinearMap s (LinearMap s (DualVector v) v) w)
  (Tensor s (Tensor s (DualVector v) (DualVector v)) w)
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor) (LinearMap s (LinearMap s (DualVector v) v) w
 -> Tensor s (DualVector v) (Tensor s (DualVector v) w))
-> (f (Tensor s (DualVector v) (DualVector v))
    -> LinearMap s (LinearMap s (DualVector v) v) w)
-> f (Tensor s (DualVector v) (DualVector v))
-> Tensor s (DualVector v) (Tensor s (DualVector v) w)
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
. DualFinitenessWitness v
-> (f s -> w)
-> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (LinearMap s (DualVector v) v) w
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 v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness f s -> w
f (Scalar w) -> w
f
                                    (f (Tensor s (DualVector v) (DualVector v))
 -> LinearMap s (SymmetricTensor s v) w)
-> f (Tensor s (DualVector v) (DualVector v))
-> LinearMap s (SymmetricTensor s v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (SymmetricTensor s (DualVector v)
 -> Tensor s (DualVector v) (DualVector v))
-> f (SymmetricTensor s (DualVector v))
-> f (Tensor s (DualVector v) (DualVector v))
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 SymmetricTensor s (DualVector v)
-> Tensor s (DualVector v) (DualVector v)
forall s v. SymmetricTensor s v -> Tensor s v v
getSymmetricTensor f (DualVector (SymmetricTensor s v))
f (SymmetricTensor s (DualVector 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 :: 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
            = (f (Scalar w) -> w)
-> f (DualVector (LinearMap s (DualVector v) v))
-> LinearMap s (DualVector v) 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 s -> w
f (Scalar w) -> w
f
  recomposeContraLinMapTensor :: (f (Scalar w) -> w)
-> f (SymmetricTensor s v +> DualVector u)
-> (SymmetricTensor s v ⊗ u) +> w
recomposeContraLinMapTensor = (f (Scalar w) -> w)
-> f (SymmetricTensor s v +> DualVector u)
-> (SymmetricTensor s v ⊗ u) +> w
forall (f :: * -> *) u w.
(Functor f, LinearSpace w, s ~ Scalar w, FiniteDimensional u,
 s ~ Scalar u) =>
(f s -> w)
-> f (SymmetricTensor s v +> DualVector u)
-> (SymmetricTensor s v ⊗ u) +> w
rcCLMT'
   where rcCLMT' :: ∀ f u w . (Hask.Functor f, LinearSpace w, s~Scalar w
                                            , FiniteDimensional u, s~Scalar u)
                    => (f s->w) -> f (SymmetricTensor s v +> DualVector u)
                                  -> (SymmetricTensor s v ⊗ u) +> w
         rcCLMT' :: (f s -> w)
-> f (SymmetricTensor s v +> DualVector u)
-> (SymmetricTensor s v ⊗ u) +> w
rcCLMT' f s -> w
f f (SymmetricTensor s v +> DualVector u)
tenss
           = Tensor
  s
  (DualVector v)
  (Tensor s (DualVector v) (Tensor s (DualVector u) w))
-> LinearMap s (Tensor s (SymmetricTensor s v) u) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Tensor
   s
   (DualVector v)
   (Tensor s (DualVector v) (Tensor s (DualVector u) w))
 -> LinearMap s (Tensor s (SymmetricTensor s v) u) w)
-> (f (Tensor
         s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
    -> Tensor
         s
         (DualVector v)
         (Tensor s (DualVector v) (Tensor s (DualVector u) w)))
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> LinearMap s (Tensor s (SymmetricTensor s v) u) w
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
. Coercion
  (LinearMap
     s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
  (Tensor
     s
     (DualVector v)
     (Tensor s (DualVector v) (Tensor s (DualVector u) w)))
-> LinearMap
     s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w
-> Tensor
     s
     (DualVector v)
     (Tensor s (DualVector v) (Tensor s (DualVector u) w))
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 (Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector u)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector u) w))
-> Coercion
     (Tensor
        s
        (DualVector v)
        (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
     (Tensor
        s
        (DualVector v)
        (Tensor s (DualVector v) (Tensor s (DualVector u) 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 Coercion
  (Tensor s (Tensor s (DualVector v) (DualVector u)) w)
  (Tensor s (DualVector v) (Tensor s (DualVector u) w))
forall s u v w.
Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor Coercion
  (Tensor
     s
     (DualVector v)
     (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
  (Tensor
     s
     (DualVector v)
     (Tensor s (DualVector v) (Tensor s (DualVector u) w)))
-> Coercion
     (LinearMap
        s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
     (Tensor
        s
        (DualVector v)
        (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
-> Coercion
     (LinearMap
        s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
     (Tensor
        s
        (DualVector v)
        (Tensor s (DualVector v) (Tensor s (DualVector u) w)))
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
. Coercion
  (Tensor
     s
     (Tensor s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
     w)
  (Tensor
     s
     (DualVector v)
     (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
forall s u v w.
Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
rassocTensor Coercion
  (Tensor
     s
     (Tensor s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
     w)
  (Tensor
     s
     (DualVector v)
     (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
-> Coercion
     (LinearMap
        s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
     (Tensor
        s
        (Tensor s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
        w)
-> Coercion
     (LinearMap
        s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
     (Tensor
        s
        (DualVector v)
        (Tensor s (Tensor s (DualVector v) (DualVector u)) w))
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
. Coercion
  (LinearMap
     s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
  (Tensor
     s
     (Tensor s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
     w)
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor)
                 (LinearMap
   s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w
 -> Tensor
      s
      (DualVector v)
      (Tensor s (DualVector v) (Tensor s (DualVector u) w)))
-> (f (Tensor
         s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
    -> LinearMap
         s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w)
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> Tensor
     s
     (DualVector v)
     (Tensor s (DualVector v) (Tensor s (DualVector u) w))
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
. (DualFinitenessWitness v, DualFinitenessWitness u)
-> (f s -> w)
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> LinearMap
     s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w
rcCLMT (DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness, DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness) f s -> w
f
                      (f (Tensor
      s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
 -> LinearMap s (Tensor s (SymmetricTensor s v) u) w)
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> LinearMap s (Tensor s (SymmetricTensor s v) u) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (SymmetricTensor s v) (DualVector u)
 -> Tensor
      s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> f (LinearMap s (SymmetricTensor s v) (DualVector u))
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
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 s (SymmetricTensor s v) (DualVector u)
-> Tensor s (DualVector v) (Tensor s (DualVector v) (DualVector u))
forall s v w. LinearMap s v w -> TensorProduct (DualVector v) w
getLinearMap f (LinearMap s (SymmetricTensor s v) (DualVector u))
f (SymmetricTensor s v +> DualVector u)
tenss
          where rcCLMT :: (DualFinitenessWitness v, DualFinitenessWitness u)
                 -> (f s->w) -> f (Tensor s (DualVector v)
                                            (Tensor s (DualVector v) (DualVector u)))
                  -- -> LinearMap s (Tensor s (SymmetricTensor s v) u) w
                  --  ∼ TensorProduct (LinearMap s (SymmetricTensor s v) (DualVector u)) w
                  --  ⩵ TensorProduct (SymmetricTensor s (DualVector v)) (DualVector u ⊗ w)
                  --  ⩵ Tensor s (DualVector v) (DualVector v ⊗ (DualVector u ⊗ w))
                     -> LinearMap s (LinearMap s (DualVector v)
                                                 (LinearMap s (DualVector v) u)) w
                  --  ∼ Tensor s (Tensor s (DualVector v)
                  --                       (DualVector v ⊗ DualVector u)) w
                  --  ∼ Tensor s (DualVector v)
                  --             (Tensor s (DualVector v ⊗ DualVector u) w)
                rcCLMT :: (DualFinitenessWitness v, DualFinitenessWitness u)
-> (f s -> w)
-> f (Tensor
        s (DualVector v) (Tensor s (DualVector v) (DualVector u)))
-> LinearMap
     s (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)) w
rcCLMT ( DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness
                       , DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness ) f s -> w
f
                             = (f (Scalar w) -> w)
-> f (DualVector
        (LinearMap s (DualVector v) (LinearMap s (DualVector v) u)))
-> LinearMap s (DualVector v) (LinearMap s (DualVector v) u) +> 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 s -> w
f (Scalar w) -> w
f
  uncanonicallyFromDual :: DualVector (SymmetricTensor s v) -+> SymmetricTensor s v
uncanonicallyFromDual = case DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness v of
     DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness -> (SymmetricTensor s (DualVector v) -> SymmetricTensor s v)
-> LinearFunction
     s (SymmetricTensor s (DualVector v)) (SymmetricTensor s v)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction
          ((SymmetricTensor s (DualVector v) -> SymmetricTensor s v)
 -> LinearFunction
      s (SymmetricTensor s (DualVector v)) (SymmetricTensor s v))
-> (SymmetricTensor s (DualVector v) -> SymmetricTensor s v)
-> LinearFunction
     s (SymmetricTensor s (DualVector v)) (SymmetricTensor s v)
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) -> Tensor s v v -> SymmetricTensor s v
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor s v v -> SymmetricTensor s v)
-> Tensor s v v -> SymmetricTensor s v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion (LinearMap s (DualVector v) v) (Tensor s v v)
-> LinearFunction s (LinearMap s (DualVector v) v) (Tensor s v v)
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 Coercion (LinearMap s (DualVector v) v) (Tensor s v v)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap LinearFunction s (LinearMap s (DualVector v) v) (Tensor s v v)
-> LinearFunction
     s
     (Tensor s (DualVector v) (DualVector v))
     (LinearMap s (DualVector v) v)
-> LinearFunction
     s (Tensor s (DualVector v) (DualVector v)) (Tensor s v v)
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
. LinearFunction
  s
  (Tensor s (DualVector v) (DualVector v))
  (LinearMap s (DualVector v) v)
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual LinearFunction
  s (Tensor s (DualVector v) (DualVector v)) (Tensor s v v)
-> Tensor s (DualVector v) (DualVector v) -> Tensor s v v
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 DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness v of
     DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness -> (SymmetricTensor s v -> SymmetricTensor s (DualVector v))
-> LinearFunction
     s (SymmetricTensor s v) (SymmetricTensor s (DualVector v))
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction
          ((SymmetricTensor s v -> SymmetricTensor s (DualVector v))
 -> LinearFunction
      s (SymmetricTensor s v) (SymmetricTensor s (DualVector v)))
-> (SymmetricTensor s v -> SymmetricTensor s (DualVector v))
-> LinearFunction
     s (SymmetricTensor s v) (SymmetricTensor s (DualVector v))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(SymTensor Tensor s v v
t) -> Tensor s (DualVector v) (DualVector v)
-> SymmetricTensor s (DualVector v)
forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor (Tensor s (DualVector v) (DualVector v)
 -> SymmetricTensor s (DualVector v))
-> Tensor s (DualVector v) (DualVector v)
-> SymmetricTensor s (DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction
  s
  (LinearMap s (DualVector v) v)
  (Tensor s (DualVector v) (DualVector v))
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  s
  (LinearMap s (DualVector v) v)
  (Tensor s (DualVector v) (DualVector v))
-> LinearFunction s (Tensor s v v) (LinearMap s (DualVector v) v)
-> LinearFunction
     s (Tensor s v v) (Tensor s (DualVector v) (DualVector v))
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
. Coercion (Tensor s v v) (LinearMap s (DualVector v) v)
-> LinearFunction s (Tensor s v v) (LinearMap s (DualVector v) v)
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 Coercion (Tensor s v v) (LinearMap s (DualVector v) v)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap LinearFunction
  s (Tensor s v v) (Tensor s (DualVector v) (DualVector v))
-> Tensor s v v -> Tensor s (DualVector v) (DualVector v)
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 FiniteDimensional v => DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v of
      DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness
          -> DualSpaceWitness (SymmetricTensor s v)
-> DualFinitenessWitness (SymmetricTensor s v)
forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness DualSpaceWitness (SymmetricTensor s v)
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 ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                     , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
           -> case SubBasis (Tensor s (DualVector u) v)
forall v. FiniteDimensional v => SubBasis v
entireBasis of TensorBasis bu bv -> SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
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 ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                 , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v )  of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis bu bv)
                   -> Coercion [Tensor s (DualVector u) v] [LinearMap s u v]
-> [Tensor s (DualVector u) v] -> [LinearMap s u v]
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 (Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
-> Coercion [Tensor s (DualVector u) v] [LinearMap s u v]
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 Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap) ([Tensor s (DualVector u) v] -> [LinearMap s u v])
-> (SubBasis (Tensor s (DualVector u) v)
    -> [Tensor s (DualVector u) v])
-> SubBasis (Tensor s (DualVector u) v)
-> [LinearMap s u v]
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 (Tensor s (DualVector u) v) -> [Tensor s (DualVector u) v]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis (SubBasis (Tensor s (DualVector u) v) -> [LinearMap s u v])
-> SubBasis (Tensor s (DualVector u) v) -> [LinearMap s u v]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ SubBasis (DualVector u)
-> SubBasis v -> SubBasis (Tensor s (DualVector u) v)
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 bu bv) 
          = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u ) of
     (DualFinitenessWitness DualSpaceWitness u
_) -> SubBasis (DualVector u) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector u)
bu Int -> Int -> Int
forall a. Num a => a -> a -> a
* SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv
  decomposeLinMap :: (LinearMap s u v +> w) -> (SubBasis (LinearMap s u v), DList w)
decomposeLinMap = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                         , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
              -> (SubBasis (Tensor s (DualVector u) v)
 -> SubBasis (LinearMap s u v))
-> (SubBasis (Tensor s (DualVector u) v), DList w)
-> (SubBasis (LinearMap s u v), DList w)
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 bu bv)->SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
forall s u v.
SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
LinMapBasis SubBasis (DualVector u)
bu SubBasis v
bv)
                    ((SubBasis (Tensor s (DualVector u) v), DList w)
 -> (SubBasis (LinearMap s u v), DList w))
-> (LinearMap s (LinearMap s u v) w
    -> (SubBasis (Tensor s (DualVector u) v), DList w))
-> LinearMap s (LinearMap s u v) w
-> (SubBasis (LinearMap s u v), DList w)
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 s (Tensor s (DualVector u) v) w
-> (SubBasis (Tensor s (DualVector u) v), DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (LinearMap s (Tensor s (DualVector u) v) w
 -> (SubBasis (Tensor s (DualVector u) v), DList w))
-> (LinearMap s (LinearMap s u v) w
    -> LinearMap s (Tensor s (DualVector u) v) w)
-> LinearMap s (LinearMap s u v) w
-> (SubBasis (Tensor s (DualVector u) v), DList w)
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 s (LinearMap s u v) w
-> LinearMap s (Tensor s (DualVector u) v) w
coerce
  decomposeLinMapWithin :: SubBasis (LinearMap s u v)
-> (LinearMap s u v +> w)
-> Either (SubBasis (LinearMap s u v), DList w) (DList w)
decomposeLinMapWithin = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                               , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
        -> \(LinMapBasis bu bv) LinearMap s u v +> w
m
         -> case SubBasis (Tensor s (DualVector u) v)
-> (Tensor s (DualVector u) v +> w)
-> Either (SubBasis (Tensor s (DualVector u) v), DList w) (DList w)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin (SubBasis (DualVector u)
-> SubBasis v -> SubBasis (Tensor s (DualVector u) v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) (LinearMap s (LinearMap s u v) w
-> LinearMap s (Tensor s (DualVector u) v) w
coerce LinearMap s (LinearMap s u v) w
LinearMap s u v +> w
m) of
              Right DList w
ws -> DList w -> Either (SubBasis (LinearMap s u v), DList w) (DList w)
forall a b. b -> Either a b
Right DList w
ws
              Left (TensorBasis bu' bv', DList w
ws) -> (SubBasis (LinearMap s u v), DList w)
-> Either (SubBasis (LinearMap s u v), DList w) (DList w)
forall a b. a -> Either a b
Left (SubBasis (DualVector u) -> SubBasis v -> SubBasis (LinearMap s u v)
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 ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                     , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis bu bv)
        -> SubBasis (Tensor s (DualVector u) v)
-> [Scalar (Tensor s (DualVector u) v)]
-> (Tensor s (DualVector u) v,
    [Scalar (Tensor s (DualVector u) v)])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB (SubBasis (DualVector u)
-> SubBasis v -> SubBasis (Tensor s (DualVector u) v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) ([s] -> (Tensor s (DualVector u) v, [s]))
-> ((Tensor s (DualVector u) v, [s]) -> (LinearMap s u v, [s]))
-> [s]
-> (LinearMap s u v, [s])
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
>>> (Tensor s (DualVector u) v -> LinearMap s u v)
-> (Tensor s (DualVector u) v, [s]) -> (LinearMap s u v, [s])
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first (Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
-> Tensor s (DualVector u) v -> LinearMap s u v
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 Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
forall s v w.
Coercion (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor)
  recomposeSBTensor :: SubBasis (LinearMap s u v)
-> SubBasis w
-> [Scalar (LinearMap s u v)]
-> (LinearMap s u v ⊗ w, [Scalar (LinearMap s u v)])
recomposeSBTensor = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                           , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness) -> \(LinMapBasis bu bv) SubBasis w
bw
        -> SubBasis (Tensor s (DualVector u) v)
-> SubBasis w
-> [Scalar (Tensor s (DualVector u) v)]
-> (Tensor s (DualVector u) v ⊗ w,
    [Scalar (Tensor s (DualVector u) v)])
forall v w.
(FiniteDimensional v, FiniteDimensional w, Scalar w ~ Scalar v) =>
SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
recomposeSBTensor (SubBasis (DualVector u)
-> SubBasis v -> SubBasis (Tensor s (DualVector u) v)
forall s u v. SubBasis u -> SubBasis v -> SubBasis (Tensor s u v)
TensorBasis SubBasis (DualVector u)
bu SubBasis v
bv) SubBasis w
bw ([s] -> (Tensor s (Tensor s (DualVector u) v) w, [s]))
-> ((Tensor s (Tensor s (DualVector u) v) w, [s])
    -> (Tensor s (LinearMap s u v) w, [s]))
-> [s]
-> (Tensor s (LinearMap s u v) w, [s])
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
>>> (Tensor s (Tensor s (DualVector u) v) w
 -> Tensor s (LinearMap s u v) w)
-> (Tensor s (Tensor s (DualVector u) v) w, [s])
-> (Tensor s (LinearMap s u v) w, [s])
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Tensor s (Tensor s (DualVector u) v) w
-> Tensor s (LinearMap s u v) w
coerce
  recomposeLinMap :: SubBasis (LinearMap s u v) -> [w] -> (LinearMap s u v +> w, [w])
recomposeLinMap = DualFinitenessWitness u
-> DualSpaceWitness w
-> SubBasis (u +> v)
-> [w]
-> ((u +> v) +> w, [w])
forall w.
(LSpace w, Scalar w ~ Scalar v) =>
DualFinitenessWitness u
-> DualSpaceWitness w
-> SubBasis (u +> v)
-> [w]
-> ((u +> v) +> w, [w])
rlm DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness DualSpaceWitness w
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 :: DualFinitenessWitness u
-> DualSpaceWitness w
-> SubBasis (u +> v)
-> [w]
-> ((u +> v) +> w, [w])
rlm (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness) DualSpaceWitness w
DualSpaceWitness (LinMapBasis bu bv) [w]
ws
             = ( Coercion
  (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s) =>
Coercion
  (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
coUncurryLinearMap Coercion
  (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
-> Coercion
     (LinearMap s (DualVector u) (LinearMap s v w))
     (Tensor s u (LinearMap s v w))
-> Coercion
     (LinearMap s (DualVector u) (LinearMap s v w))
     (LinearMap s (LinearMap s u v) w)
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
. Coercion
  (LinearMap s (DualVector u) (LinearMap s v w))
  (Tensor s u (LinearMap s v w))
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap Coercion
  (LinearMap s (DualVector u) (LinearMap s v w))
  (LinearMap s (LinearMap s u v) w)
-> LinearMap s (DualVector u) (LinearMap s v w)
-> LinearMap s (LinearMap s u v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (DualVector u) (LinearMap s v w), [LinearMap s v w])
-> LinearMap s (DualVector u) (LinearMap s v w)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((LinearMap s (DualVector u) (LinearMap s v w), [LinearMap s v w])
 -> LinearMap s (DualVector u) (LinearMap s v w))
-> ([LinearMap s v w]
    -> (LinearMap s (DualVector u) (LinearMap s v w),
        [LinearMap s v w]))
-> [LinearMap s v w]
-> LinearMap s (DualVector u) (LinearMap s v w)
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 (DualVector u)
-> [LinearMap s v w]
-> (DualVector u +> LinearMap s v w, [LinearMap s v w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis (DualVector u)
bu
                           ([LinearMap s v w] -> LinearMap s (DualVector u) (LinearMap s v w))
-> [LinearMap s v w]
-> LinearMap s (DualVector u) (LinearMap s v w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([w] -> Maybe (LinearMap s v w, [w])) -> [w] -> [LinearMap s v w]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((LinearMap s v w, [w]) -> Maybe (LinearMap s v w, [w])
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ((LinearMap s v w, [w]) -> Maybe (LinearMap s v w, [w]))
-> ([w] -> (LinearMap s v w, [w]))
-> [w]
-> Maybe (LinearMap s v w, [w])
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 -> [w] -> (v +> w, [w])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis v
bv) [w]
ws
               , Int -> [w] -> [w]
forall a. Int -> [a] -> [a]
drop (SubBasis (DualVector u) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis (DualVector u)
bu Int -> Int -> Int
forall a. Num a => a -> a -> a
* SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension SubBasis v
bv) [w]
ws )
  recomposeContraLinMap :: (f (Scalar w) -> w)
-> f (DualVector (LinearMap s u v)) -> LinearMap s u v +> w
recomposeContraLinMap = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                               , DualSpaceWitness v
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
       -> Coercion
  (LinearMap s (Tensor s (DualVector u) v) w)
  (LinearMap s (LinearMap s u v) w)
forall s v w x.
(LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s) =>
Coercion
  (LinearMap s (Tensor s (DualVector v) w) x)
  (LinearMap s (LinearMap s v w) x)
argFromTensor Coercion
  (LinearMap s (Tensor s (DualVector u) v) w)
  (LinearMap s (LinearMap s u v) w)
-> LinearMap s (Tensor s (DualVector u) v) w
-> LinearMap s (LinearMap s u v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w)
-> f (LinearMap
        (Scalar (DualVector u)) (DualVector u) (DualVector v))
-> (DualVector u ⊗ v) +> w
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 (f (LinearMap
      (Scalar (DualVector u)) (DualVector u) (DualVector v))
 -> LinearMap s (Tensor s (DualVector u) v) w)
-> f (LinearMap
        (Scalar (DualVector u)) (DualVector u) (DualVector v))
-> LinearMap s (Tensor s (DualVector u) v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Tensor s u (DualVector v)
 -> LinearMap s (DualVector u) (DualVector v))
-> f (Tensor s u (DualVector v))
-> f (LinearMap
        (Scalar (DualVector u)) (DualVector u) (DualVector v))
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 (Coercion
  (Tensor s u (DualVector v))
  (LinearMap s (DualVector u) (DualVector v))
-> Tensor s u (DualVector v)
-> LinearMap s (DualVector u) (DualVector v)
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 Coercion
  (Tensor s u (DualVector v))
  (LinearMap s (DualVector u) (DualVector v))
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap) f (Tensor s u (DualVector v))
f (DualVector (LinearMap s u v))
dds
  recomposeContraLinMapTensor :: (f (Scalar w) -> w)
-> f (LinearMap s u v +> DualVector u)
-> (LinearMap s u v ⊗ u) +> w
recomposeContraLinMapTensor = DualFinitenessWitness u
-> DualSpaceWitness v
-> DualSpaceWitness u
-> (f (Scalar w) -> w)
-> f ((u +> v) +> DualVector u)
-> ((u +> v) ⊗ u) +> w
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 u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness u
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 :: 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
          = Coercion
  (LinearMap s (LinearMap s u v) (LinearMap s u' w))
  (LinearMap s (Tensor s (LinearMap s u v) u') w)
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
uncurryLinearMap Coercion
  (LinearMap s (LinearMap s u v) (LinearMap s u' w))
  (LinearMap s (Tensor s (LinearMap s u v) u') w)
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (LinearMap s (LinearMap s u v) (LinearMap s u' w))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (LinearMap s (Tensor s (LinearMap s u v) u') w)
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
. Coercion
  (Tensor s u (LinearMap s v (LinearMap s u' w)))
  (LinearMap s (LinearMap s u v) (LinearMap s u' w))
forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s) =>
Coercion
  (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
coUncurryLinearMap
           Coercion
  (Tensor s u (LinearMap s v (LinearMap s u' w)))
  (LinearMap s (LinearMap s u v) (LinearMap s u' w))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (Tensor s u (LinearMap s v (LinearMap s u' w)))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (LinearMap s (LinearMap s u v) (LinearMap s u' w))
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
. Coercion
  (LinearMap s (Tensor s v u') w) (LinearMap s v (LinearMap s u' w))
-> Coercion
     (Tensor s u (LinearMap s (Tensor s v u') w))
     (Tensor s u (LinearMap s v (LinearMap s u' 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 Coercion
  (LinearMap s (Tensor s v u') w) (LinearMap s v (LinearMap s u' w))
forall u v w s.
(LinearSpace u, Scalar u ~ s) =>
Coercion
  (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
curryLinearMap Coercion
  (Tensor s u (LinearMap s (Tensor s v u') w))
  (Tensor s u (LinearMap s v (LinearMap s u' w)))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (Tensor s u (LinearMap s (Tensor s v u') w))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (Tensor s u (LinearMap s v (LinearMap s u' w)))
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
. Coercion
  (LinearMap s (LinearMap s u (Tensor s v u')) w)
  (Tensor s u (LinearMap s (Tensor s v u') w))
forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s) =>
Coercion
  (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
coCurryLinearMap Coercion
  (LinearMap s (LinearMap s u (Tensor s v u')) w)
  (Tensor s u (LinearMap s (Tensor s v u') w))
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (LinearMap s (LinearMap s u (Tensor s v u')) w)
-> Coercion
     (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
     (Tensor s u (LinearMap s (Tensor s v u') w))
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
. Coercion
  (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
  (LinearMap s (LinearMap s u (Tensor s v u')) w)
forall s v w x.
(LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s) =>
Coercion
  (LinearMap s (Tensor s (DualVector v) w) x)
  (LinearMap s (LinearMap s v w) x)
argFromTensor
             Coercion
  (LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
  (LinearMap s (Tensor s (LinearMap s u v) u') w)
-> LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w
-> LinearMap s (Tensor s (LinearMap s u v) u') w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w)
-> f (DualVector u +> DualVector (Tensor s v u'))
-> (DualVector u ⊗ Tensor s v u') +> w
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
               (f (LinearMap
      (Scalar (DualVector u))
      (DualVector u)
      (LinearMap s v (DualVector u')))
 -> LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w)
-> f (LinearMap
        (Scalar (DualVector u))
        (DualVector u)
        (LinearMap s v (DualVector u')))
-> LinearMap s (Tensor s (DualVector u) (Tensor s v u')) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (LinearMap s u v) (DualVector u')
 -> LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
-> f (LinearMap s (LinearMap s u v) (DualVector u'))
-> f (LinearMap
        (Scalar (DualVector u))
        (DualVector u)
        (LinearMap s v (DualVector u')))
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 (Coercion
  (LinearMap s (LinearMap s u v) (DualVector u'))
  (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
-> LinearMap s (LinearMap s u v) (DualVector u')
-> LinearMap s (DualVector u) (LinearMap s v (DualVector u'))
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 (Coercion
   (LinearMap s (LinearMap s u v) (DualVector u'))
   (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
 -> LinearMap s (LinearMap s u v) (DualVector u')
 -> LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
-> Coercion
     (LinearMap s (LinearMap s u v) (DualVector u'))
     (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
-> LinearMap s (LinearMap s u v) (DualVector u')
-> LinearMap s (DualVector u) (LinearMap s v (DualVector u'))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (Tensor s u (LinearMap s v (DualVector u')))
  (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap Coercion
  (Tensor s u (LinearMap s v (DualVector u')))
  (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
-> Coercion
     (LinearMap s (LinearMap s u v) (DualVector u'))
     (Tensor s u (LinearMap s v (DualVector u')))
-> Coercion
     (LinearMap s (LinearMap s u v) (DualVector u'))
     (LinearMap s (DualVector u) (LinearMap s v (DualVector u')))
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
. Coercion
  (LinearMap s (LinearMap s u v) (DualVector u'))
  (Tensor s u (LinearMap s v (DualVector u')))
forall s u v w.
(LinearSpace u, Scalar u ~ s, LinearSpace v, Scalar v ~ s) =>
Coercion
  (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
coCurryLinearMap) f (LinearMap s (LinearMap s u v) (DualVector u'))
f ((u +> v) +> DualVector u')
dds
  uncanonicallyToDual :: LinearMap s u v -+> DualVector (LinearMap s u v)
uncanonicallyToDual = case ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                             , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
           -> Coercion (LinearMap s u v) (Tensor s (DualVector u) v)
-> LinearFunction
     (Scalar (DualVector v))
     (LinearMap s u v)
     (Tensor s (DualVector u) v)
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 Coercion (LinearMap s u v) (Tensor s (DualVector u) v)
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor LinearFunction
  (Scalar (DualVector v))
  (LinearMap s u v)
  (Tensor s (DualVector u) v)
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s (DualVector u) v)
     (Tensor (Scalar u) u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (LinearMap s u v)
     (Tensor (Scalar u) u (DualVector 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
>>> LinearFunction s v (DualVector v)
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s (DualVector u) v)
     (Tensor s (DualVector u) (DualVector v))
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 (DualVector v)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  (Scalar (DualVector v))
  (Tensor s (DualVector u) v)
  (Tensor s (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s (DualVector u) (DualVector v))
     (Tensor (Scalar u) u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s (DualVector u) v)
     (Tensor (Scalar u) u (DualVector 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
>>> LinearFunction
  (Scalar (DualVector v))
  (Tensor s (DualVector u) (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
              LinearFunction
  (Scalar (DualVector v))
  (Tensor s (DualVector u) (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor s (DualVector u) (DualVector v))
     (Tensor (Scalar u) u (DualVector 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
>>> LinearFunction s (DualVector u) u
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
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 (DualVector u) u
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
     (Tensor (Scalar u) u (DualVector v))
-> LinearFunction
     (Scalar (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
     (Tensor (Scalar u) u (DualVector 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
>>> LinearFunction
  (Scalar (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
  (Tensor (Scalar u) u (DualVector v))
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 ( DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness :: DualFinitenessWitness u
                               , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
     (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness, DualSpaceWitness v
DualSpaceWitness)
           -> Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor s (DualVector u) v)
     (LinearMap s u v)
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 Coercion (Tensor s (DualVector u) v) (LinearMap s u v)
forall s v w.
Coercion (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor LinearFunction
  (Scalar (DualVector u))
  (Tensor s (DualVector u) v)
  (LinearMap s u v)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor s (DualVector u) v)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (LinearMap s u v)
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
<<< LinearFunction s (DualVector v) v
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor s (DualVector u) (DualVector v))
     (Tensor s (DualVector u) v)
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 (DualVector v) v
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual LinearFunction
  (Scalar (DualVector u))
  (Tensor s (DualVector u) (DualVector v))
  (Tensor s (DualVector u) v)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor s (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor s (DualVector u) v)
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
<<< LinearFunction
  (Scalar (DualVector u))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
  (Tensor s (DualVector u) (DualVector v))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor
              LinearFunction
  (Scalar (DualVector u))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
  (Tensor s (DualVector u) (DualVector v))
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor s (DualVector u) (DualVector v))
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
<<< LinearFunction s u (DualVector u)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
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 u (DualVector u)
forall v. FiniteDimensional v => DualVector v -+> v
uncanonicallyFromDual LinearFunction
  (Scalar (DualVector u))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) u)
-> LinearFunction
     (Scalar (DualVector u))
     (Tensor (Scalar u) u (DualVector v))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector u))
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
<<< LinearFunction
  (Scalar (DualVector u))
  (Tensor (Scalar u) u (DualVector v))
  (Tensor (Scalar (DualVector v)) (DualVector v) u)
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor

  tensorEquality :: (LinearMap s u v ⊗ w) -> (LinearMap s u v ⊗ w) -> Bool
tensorEquality = (LinearMap s u v ⊗ w) -> (LinearMap s u v ⊗ w) -> Bool
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 ( FiniteDimensional u => DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u
                               , FiniteDimensional v => DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v ) of
      (DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
       , DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness)
          -> DualSpaceWitness (LinearMap s u v)
-> DualFinitenessWitness (LinearMap s u v)
forall v.
FiniteDimensional (DualVector v) =>
DualSpaceWitness v -> DualFinitenessWitness v
DualFinitenessWitness DualSpaceWitness (LinearMap s u v)
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 :: 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 FiniteDimensional u => DualFinitenessWitness u
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @u of
      DualFinitenessWitness DualSpaceWitness u
DualSpaceWitness
         -> (DualVector u ⊗ Tensor s v w)
-> (DualVector u ⊗ Tensor s v w) -> Bool
forall v w.
(FiniteDimensional v, TensorSpace w, Eq w, Scalar w ~ Scalar v) =>
(v ⊗ w) -> (v ⊗ w) -> Bool
tensorEquality (TensorProduct (DualVector u) (Tensor s v w)
-> Tensor s (DualVector u) (Tensor s v w)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (LinearMap s u v) w
TensorProduct (DualVector u) (Tensor s v w)
s :: Tensor s (DualVector u) (v⊗w)) (TensorProduct (DualVector u) (Tensor s v w)
-> Tensor s (DualVector u) (Tensor s v w)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct (LinearMap s u v) w
TensorProduct (DualVector u) (Tensor s 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
\$ :: (u +> v) -> v -> u
(\$) u +> v
m
  | Int
du Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dv    = ((LinearFunction
  (Scalar v)
  (LinearMap (Scalar v) v u)
  (LinearFunction (Scalar v) v u)
forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinearLinearFunction
  (Scalar v)
  (LinearMap (Scalar v) v u)
  (LinearFunction (Scalar v) v u)
-> LinearMap (Scalar v) v u -> LinearFunction (Scalar v) v u
forall s v w. LinearFunction s v w -> v -> w
-+$>(u +> v) -> LinearMap (Scalar v) v u
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeRightInverse u +> v
m)LinearFunction (Scalar v) v u -> v -> u
forall s v w. LinearFunction s v w -> v -> w
-+$>)
  | Int
du Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dv    = ((LinearFunction
  (Scalar v)
  (LinearMap (Scalar v) v u)
  (LinearFunction (Scalar v) v u)
forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinearLinearFunction
  (Scalar v)
  (LinearMap (Scalar v) v u)
  (LinearFunction (Scalar v) v u)
-> LinearMap (Scalar v) v u -> LinearFunction (Scalar v) v u
forall s v w. LinearFunction s v w -> v -> w
-+$>(u +> v) -> LinearMap (Scalar v) v u
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeLeftInverse u +> v
m)LinearFunction (Scalar v) v u -> v -> u
forall s v w. LinearFunction s v w -> v -> w
-+$>)
  | Bool
otherwise  = let v's :: [Maybe (DualVector v)]
v's = [v] -> [Maybe (DualVector v)]
forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis ([v] -> [Maybe (DualVector v)]) -> [v] -> [Maybe (DualVector v)]
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) = (u +> v) -> (SubBasis u, DList v)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap u +> v
m
                 in (u, [Scalar v]) -> u
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((u, [Scalar v]) -> u) -> (v -> (u, [Scalar v])) -> v -> u
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 -> SubBasis u -> [Scalar u] -> (u, [Scalar u])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
mbas [ Scalar v
-> (DualVector v -> Scalar v) -> Maybe (DualVector v) -> Scalar v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scalar v
0 (DualVector v -> v -> Scalar v
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 = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
       dv :: Int
dv = SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis v
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 :: (u +> v) -> v +> u
pseudoInverse u +> v
m
  | Int
du Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
dv    = (u +> v) -> v +> u
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeRightInverse u +> v
m
  | Int
du Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dv    = (u +> v) -> v +> u
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeLeftInverse u +> v
m
  | Bool
otherwise  = (u +> v) -> v +> u
forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse u +> v
m
 where du :: Int
du = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
       dv :: Int
dv = SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis v
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 :: (u +> v) -> v +> u
unsafeLeftInverse = DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uli DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness v
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
             = (u +> DualVector u)
-> LinearMap (Scalar (DualVector u)) (DualVector u) u
forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse (LinearMap (Scalar v) (DualVector v) (DualVector u)
DualVector v +> DualVector u
m' LinearMap (Scalar v) (DualVector v) (DualVector u)
-> LinearMap (Scalar v) u (DualVector v)
-> LinearMap (Scalar v) u (DualVector u)
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
. (LinearFunction (Scalar v) v (DualVector v)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) u v)
     (LinearMap (Scalar v) u (DualVector v))
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 (Scalar v) v (DualVector v)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  (Scalar v)
  (LinearMap (Scalar v) u v)
  (LinearMap (Scalar v) u (DualVector v))
-> LinearMap (Scalar v) u v
-> LinearMap (Scalar v) u (DualVector v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
LinearMap (Scalar v) u v
m))
                         LinearMap (Scalar (DualVector u)) (DualVector u) u
-> LinearMap (Scalar (DualVector u)) v (DualVector u)
-> LinearMap (Scalar (DualVector u)) v u
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 (DualVector u)) (DualVector v) (DualVector u)
DualVector v +> DualVector u
m' LinearMap (Scalar (DualVector u)) (DualVector v) (DualVector u)
-> LinearMap (Scalar (DualVector u)) v (DualVector v)
-> LinearMap (Scalar (DualVector u)) v (DualVector u)
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
. LinearFunction (Scalar v) v (DualVector v)
-> LinearMap (Scalar (DualVector u)) v (DualVector v)
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 (Scalar v) v (DualVector v)
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual
        where m' :: DualVector v +> DualVector u
m' = LinearFunction
  (Scalar (DualVector v))
  (LinearMap (Scalar u) u (DualVector (DualVector v)))
  (DualVector v +> DualVector u)
forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint LinearFunction
  (Scalar (DualVector v))
  (LinearMap (Scalar u) u (DualVector (DualVector v)))
  (DualVector v +> DualVector u)
-> LinearMap (Scalar u) u (DualVector (DualVector v))
-> DualVector v +> DualVector u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
LinearMap (Scalar u) u (DualVector (DualVector 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 :: (u +> v) -> v +> u
unsafeRightInverse = DualSpaceWitness u -> DualSpaceWitness v -> (u +> v) -> v +> u
uri DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness v
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
             = (LinearFunction (Scalar u) (DualVector u) u
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (DualVector v) (DualVector u))
     (LinearMap (Scalar v) (DualVector v) u)
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 (Scalar u) (DualVector u) u
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  (Scalar v)
  (LinearMap (Scalar v) (DualVector v) (DualVector u))
  (LinearMap (Scalar v) (DualVector v) u)
-> LinearMap (Scalar v) (DualVector v) (DualVector u)
-> LinearMap (Scalar v) (DualVector v) u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (DualVector v) (DualVector u)
DualVector v +> DualVector u
m')
                          LinearMap (Scalar v) (DualVector v) u
-> LinearMap (Scalar v) v (DualVector v) -> v +> u
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 +> v) -> LinearMap (Scalar v) v (DualVector v)
forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse (u +> v
LinearMap (Scalar v) u v
m LinearMap (Scalar v) u v
-> LinearMap (Scalar v) (DualVector v) u
-> LinearMap (Scalar v) (DualVector v) v
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
. (LinearFunction (Scalar u) (DualVector u) u
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (DualVector v) (DualVector u))
     (LinearMap (Scalar v) (DualVector v) u)
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 (Scalar u) (DualVector u) u
forall v. FiniteDimensional v => v -+> DualVector v
uncanonicallyToDual LinearFunction
  (Scalar v)
  (LinearMap (Scalar v) (DualVector v) (DualVector u))
  (LinearMap (Scalar v) (DualVector v) u)
-> LinearMap (Scalar v) (DualVector v) (DualVector u)
-> LinearMap (Scalar v) (DualVector v) u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (DualVector v) (DualVector u)
DualVector v +> DualVector u
m'))
        where m' :: DualVector v +> DualVector u
m' = LinearFunction
  (Scalar (DualVector v))
  (LinearMap (Scalar u) u (DualVector (DualVector v)))
  (DualVector v +> DualVector u)
forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint LinearFunction
  (Scalar (DualVector v))
  (LinearMap (Scalar u) u (DualVector (DualVector v)))
  (DualVector v +> DualVector u)
-> LinearMap (Scalar u) u (DualVector (DualVector v))
-> DualVector v +> DualVector u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u +> v
LinearMap (Scalar u) u (DualVector (DualVector 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 :: (u +> v) -> v +> u
unsafeInverse u +> v
m = ([Scalar u] -> u) -> [DualVector v] -> v +> u
forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
 Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap ((u, [Scalar v]) -> u
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((u, [Scalar v]) -> u)
-> ([Scalar v] -> (u, [Scalar v])) -> [Scalar v] -> u
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 u -> [Scalar u] -> (u, [Scalar u])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis u
mbas)
                                        ([DualVector v] -> v +> u) -> [DualVector v] -> v +> u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [DualVector v
-> (DualVector v -> DualVector v)
-> Maybe (DualVector v)
-> DualVector v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DualVector v
forall v. AdditiveGroup v => v
zeroV DualVector v -> DualVector v
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 = [v] -> [Maybe (DualVector v)]
forall v.
(SemiInner v, RealFrac' (Scalar v)) =>
[v] -> [Maybe (DualVector v)]
dualBasis ([v] -> [Maybe (DualVector v)]) -> [v] -> [Maybe (DualVector v)]
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) = (u +> v) -> (SubBasis u, DList v)
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 :: DualVector v -+> v
riesz = case FiniteDimensional v => DualFinitenessWitness v
forall v. FiniteDimensional v => DualFinitenessWitness v
dualFinitenessWitness @v of
  DualFinitenessWitness DualSpaceWitness v
DualSpaceWitness
      -> LinearMap (Scalar (DualVector v)) (DualVector v) v
-> DualVector v -+> v
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 (LinearMap (Scalar (DualVector v)) (DualVector v) v
 -> DualVector v -+> v)
-> (LinearMap (Scalar v) v (DualVector v)
    -> LinearMap (Scalar (DualVector v)) (DualVector v) v)
-> LinearMap (Scalar v) v (DualVector v)
-> DualVector v -+> v
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 (DualVector v)
-> LinearMap (Scalar (DualVector v)) (DualVector v) v
forall u v.
(FiniteDimensional u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
unsafeInverse (LinearMap (Scalar v) v (DualVector v) -> DualVector v -+> v)
-> LinearMap (Scalar v) v (DualVector v) -> DualVector v -+> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction (Scalar (DualVector v)) v (DualVector v)
-> LinearMap (Scalar v) v (DualVector v)
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 (Scalar (DualVector v)) v (DualVector v)
forall v. (LSpace v, InnerSpace v) => v -+> DualVector v
coRiesz

sRiesz :: ∀ v . FiniteDimensional v => DualSpace v -+> v
sRiesz :: DualSpace v -+> v
sRiesz = case ( ScalarSpaceWitness v
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
              , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
 (ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness) -> (DualSpace v -> v) -> DualSpace v -+> v
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((DualSpace v -> v) -> DualSpace v -+> v)
-> (DualSpace v -> v) -> DualSpace v -+> v
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) = DualSpace v -> (SubBasis v, [Scalar v] -> [Scalar v])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap (DualSpace v -> (SubBasis v, [Scalar v] -> [Scalar v]))
-> DualSpace v -> (SubBasis v, [Scalar v] -> [Scalar v])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualSpace v
dv
       in (v, [Scalar v]) -> v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((v, [Scalar v]) -> v)
-> ([Scalar v] -> (v, [Scalar v])) -> [Scalar v] -> v
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 -> [Scalar v] -> (v, [Scalar v])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis v
bas ([Scalar v] -> v) -> [Scalar v] -> v
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 :: v -+> DualVector v
coRiesz = case ( ScalarSpaceWitness v
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
               , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
 (ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
      -> LinearFunction
  (Scalar (DualVector v))
  (Tensor
     (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
  (DualVector v)
forall v. TensorSpace v => (v ⊗ Scalar v) -+> v
fromFlatTensor LinearFunction
  (Scalar (DualVector v))
  (Tensor
     (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
  (DualVector v)
-> LinearFunction
     (Scalar (DualVector v))
     v
     (Tensor
        (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
-> v -+> DualVector v
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
. Coercion
  (LinearMap (Scalar v) v (Scalar v))
  (Tensor
     (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
-> LinearFunction
     (Scalar (DualVector v))
     (LinearMap (Scalar v) v (Scalar v))
     (Tensor
        (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
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 Coercion
  (LinearMap (Scalar v) v (Scalar v))
  (Tensor
     (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor LinearFunction
  (Scalar (DualVector v))
  (LinearMap (Scalar v) v (Scalar v))
  (Tensor
     (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
-> LinearFunction
     (Scalar (DualVector v)) v (LinearMap (Scalar v) v (Scalar v))
-> LinearFunction
     (Scalar (DualVector v))
     v
     (Tensor
        (Scalar (DualVector v)) (DualVector v) (Scalar (DualVector v)))
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
. LinearFunction
  (Scalar (DualVector v))
  (LinearFunction (Scalar (Scalar v)) v (Scalar v))
  (LinearMap (Scalar v) v (Scalar v))
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunction LinearFunction
  (Scalar (DualVector v))
  (LinearFunction (Scalar (Scalar v)) v (Scalar v))
  (LinearMap (Scalar v) v (Scalar v))
-> LinearFunction
     (Scalar (DualVector v))
     v
     (LinearFunction (Scalar (Scalar v)) v (Scalar v))
-> LinearFunction
     (Scalar (DualVector v)) v (LinearMap (Scalar v) v (Scalar v))
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
. LinearFunction
  (Scalar (DualVector v))
  v
  (LinearFunction (Scalar (Scalar v)) v (Scalar v))
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 :: Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz = case ( ScalarSpaceWitness v
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v
                        , DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
 (ScalarSpaceWitness v
ScalarSpaceWitness,DualSpaceWitness v
DualSpaceWitness)
      -> \Int
p DualSpace v
dv -> Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"().<"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> v -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
7 (LinearFunction (Scalar v) (DualSpace v) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRieszLinearFunction (Scalar v) (DualSpace v) v -> DualSpace v -> v
forall (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 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (ZeroDim ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ (V0 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V0 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (V0 ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ ℝ ℝ) where showsPrec :: Int -> LinearMap ℝ ℝ ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ ℝ ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ (V1 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V1 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (V1 ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ (V2 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V2 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (V2 ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ (V3 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V3 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (V3 ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
showsPrecAsRiesz
instance Show (LinearMap ℝ (V4 ℝ) ℝ) where showsPrec :: Int -> LinearMap ℝ (V4 ℝ) ℝ -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ (V4 ℝ) ℝ -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
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 -> [Char] -> [Char]
showsPrec = case ( DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
                   , DualSpaceWitness w
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w ) of
      (DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness) -> Int -> LinearMap s (v, w) s -> [Char] -> [Char]
forall v.
(FiniteDimensional v, InnerSpace v, Show v, HasBasis (Scalar v),
 Basis (Scalar v) ~ ()) =>
Int -> DualSpace v -> [Char] -> [Char]
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 :: (v +> ℝ) -> [(Basis ℝ, v)]
rieszDecomposition (LinearMap TensorProduct (DualVector v) ℝ
r) = [((), LinearFunction ℝ (Tensor ℝ v ℝ) v
forall v. TensorSpace v => (v ⊗ Scalar v) -+> v
fromFlatTensor LinearFunction ℝ (Tensor ℝ v ℝ) v -> Tensor ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct v ℝ -> Tensor ℝ v ℝ
forall s v w. TensorProduct v w -> Tensor s v w
Tensor TensorProduct v ℝ
TensorProduct (DualVector v) ℝ
r)]
instance ( RieszDecomposable x, RieszDecomposable y
         , Scalar x ~ Scalar y, Scalar (DualVector x) ~ Scalar (DualVector y) )
              => RieszDecomposable (x,y) where
  rieszDecomposition :: (v +> (x, y)) -> [(Basis (x, y), v)]
rieszDecomposition v +> (x, y)
m = ((Basis x, v) -> (Either (Basis x) (Basis y), v))
-> [(Basis x, v)] -> [(Either (Basis x) (Basis y), v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Basis x -> Either (Basis x) (Basis y))
-> (Basis x, v) -> (Either (Basis x) (Basis y), v)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Basis x -> Either (Basis x) (Basis y)
forall a b. a -> Either a b
Left) (LinearMap (Scalar v) v x -> [(Basis x, v)]
forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition (LinearMap (Scalar v) v x -> [(Basis x, v)])
-> LinearMap (Scalar v) v x -> [(Basis x, v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (x, y) x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst LinearMap (Scalar v) (x, y) x
-> (v +> (x, y)) -> LinearMap (Scalar v) v x
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)
                      [(Either (Basis x) (Basis y), v)]
-> [(Either (Basis x) (Basis y), v)]
-> [(Either (Basis x) (Basis y), v)]
forall a. [a] -> [a] -> [a]
++ ((Basis y, v) -> (Either (Basis x) (Basis y), v))
-> [(Basis y, v)] -> [(Either (Basis x) (Basis y), v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Basis y -> Either (Basis x) (Basis y))
-> (Basis y, v) -> (Either (Basis x) (Basis y), v)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Basis y -> Either (Basis x) (Basis y)
forall a b. b -> Either a b
Right) (LinearMap (Scalar v) v y -> [(Basis y, v)]
forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition (LinearMap (Scalar v) v y -> [(Basis y, v)])
-> LinearMap (Scalar v) v y -> [(Basis y, v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (x, y) y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd LinearMap (Scalar v) (x, y) y
-> (v +> (x, y)) -> LinearMap (Scalar v) v y
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 :: (v +> ZeroDim ℝ) -> [(Basis (ZeroDim ℝ), v)]
rieszDecomposition v +> ZeroDim ℝ
_ = []
instance RieszDecomposable (V0 ℝ) where
  rieszDecomposition :: (v +> V0 ℝ) -> [(Basis (V0 ℝ), v)]
rieszDecomposition v +> V0 ℝ
_ = []
instance RieszDecomposable (V1 ℝ) where
  rieszDecomposition :: (v +> V1 ℝ) -> [(Basis (V1 ℝ), v)]
rieszDecomposition v +> V1 ℝ
m = [(Basis (V1 ℝ)
forall (t :: * -> *). R1 t => E t
ex, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V1 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V1 ℝ)) (LinearMap ℝ v ℝ)
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 ((V1 ℝ -> ℝ) -> LinearFunction ℝ (V1 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V1 ℝ -> Getting ℝ (V1 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V1 ℝ) ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) LinearFunction ℝ (LinearMap ℝ v (V1 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V1 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V1 ℝ)
v +> V1 ℝ
m)]
#if MIN_VERSION_free_vector_spaces(0,2,0)
   where ex = e @0
#endif
instance RieszDecomposable (V2 ℝ) where
  rieszDecomposition :: (v +> V2 ℝ) -> [(Basis (V2 ℝ), v)]
rieszDecomposition v +> V2 ℝ
m = [ (Basis (V2 ℝ)
forall (t :: * -> *). R1 t => E t
ex, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V2 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V2 ℝ)) (LinearMap ℝ v ℝ)
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 ((V2 ℝ -> ℝ) -> LinearFunction ℝ (V2 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V2 ℝ -> Getting ℝ (V2 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V2 ℝ) ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) LinearFunction ℝ (LinearMap ℝ v (V2 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V2 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V2 ℝ)
v +> V2 ℝ
m)
                         , (Basis (V2 ℝ)
forall (t :: * -> *). R2 t => E t
ey, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V2 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V2 ℝ)) (LinearMap ℝ v ℝ)
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 ((V2 ℝ -> ℝ) -> LinearFunction ℝ (V2 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V2 ℝ -> Getting ℝ (V2 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V2 ℝ) ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) LinearFunction ℝ (LinearMap ℝ v (V2 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V2 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V2 ℝ)
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 :: (v +> V3 ℝ) -> [(Basis (V3 ℝ), v)]
rieszDecomposition v +> V3 ℝ
m = [ (Basis (V3 ℝ)
forall (t :: * -> *). R1 t => E t
ex, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V3 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
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 ((V3 ℝ -> ℝ) -> LinearFunction ℝ (V3 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V3 ℝ -> Getting ℝ (V3 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V3 ℝ) ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V3 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V3 ℝ)
v +> V3 ℝ
m)
                         , (Basis (V3 ℝ)
forall (t :: * -> *). R2 t => E t
ey, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V3 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
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 ((V3 ℝ -> ℝ) -> LinearFunction ℝ (V3 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V3 ℝ -> Getting ℝ (V3 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V3 ℝ) ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V3 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V3 ℝ)
v +> V3 ℝ
m)
                         , (Basis (V3 ℝ)
forall (t :: * -> *). R3 t => E t
ez, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V3 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
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 ((V3 ℝ -> ℝ) -> LinearFunction ℝ (V3 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V3 ℝ -> Getting ℝ (V3 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V3 ℝ) ℝ
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)) LinearFunction ℝ (LinearMap ℝ v (V3 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V3 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V3 ℝ)
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 :: (v +> V4 ℝ) -> [(Basis (V4 ℝ), v)]
rieszDecomposition v +> V4 ℝ
m = [ (Basis (V4 ℝ)
forall (t :: * -> *). R1 t => E t
ex, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V4 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
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 ((V4 ℝ -> ℝ) -> LinearFunction ℝ (V4 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V4 ℝ -> Getting ℝ (V4 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V4 ℝ) ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)) LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V4 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V4 ℝ)
v +> V4 ℝ
m)
                         , (Basis (V4 ℝ)
forall (t :: * -> *). R2 t => E t
ey, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V4 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
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 ((V4 ℝ -> ℝ) -> LinearFunction ℝ (V4 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V4 ℝ -> Getting ℝ (V4 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V4 ℝ) ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)) LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V4 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V4 ℝ)
v +> V4 ℝ
m)
                         , (Basis (V4 ℝ)
forall (t :: * -> *). R3 t => E t
ez, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V4 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
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 ((V4 ℝ -> ℝ) -> LinearFunction ℝ (V4 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V4 ℝ -> Getting ℝ (V4 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V4 ℝ) ℝ
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)) LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V4 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V4 ℝ)
v +> V4 ℝ
m)
                         , (Basis (V4 ℝ)
forall (t :: * -> *). R4 t => E t
ew, LinearFunction ℝ (LinearMap ℝ v ℝ) v
forall v. FiniteDimensional v => DualSpace v -+> v
sRiesz LinearFunction ℝ (LinearMap ℝ v ℝ) v -> LinearMap ℝ v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (V4 ℝ) ℝ
-> LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
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 ((V4 ℝ -> ℝ) -> LinearFunction ℝ (V4 ℝ) ℝ
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (V4 ℝ -> Getting ℝ (V4 ℝ) ℝ -> ℝ
forall s a. s -> Getting a s a -> a
^.Getting ℝ (V4 ℝ) ℝ
forall (t :: * -> *) a. R4 t => Lens' (t a) a
_w)) LinearFunction ℝ (LinearMap ℝ v (V4 ℝ)) (LinearMap ℝ v ℝ)
-> LinearMap ℝ v (V4 ℝ) -> LinearMap ℝ v ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ v (V4 ℝ)
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 .< :: Basis w -> v -> v +> w
.< v
v = LinearFunction (Scalar v) (LinearFunction (Scalar w) v w) (v +> w)
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
(v -+> w) -+> (v +> w)
sampleLinearFunction LinearFunction (Scalar v) (LinearFunction (Scalar w) v w) (v +> w)
-> LinearFunction (Scalar w) v w -> v +> w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (v -> w) -> LinearFunction (Scalar w) v w
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((v -> w) -> LinearFunction (Scalar w) v w)
-> (v -> w) -> LinearFunction (Scalar w) v w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \v
v' -> [(Basis w, Scalar w)] -> w
forall v. HasBasis v => [(Basis v, Scalar v)] -> v
recompose [(Basis w
bw, v
vv -> v -> Scalar v
forall 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 :: Int -> LinearMap s v u -> [Char] -> [Char]
rieszDecomposeShowsPrec Int
p LinearMap s v u
m = case (v +> u) -> [(Basis u, v)]
forall u v.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Scalar v ~ Scalar u) =>
(v +> u) -> [(Basis u, v)]
rieszDecomposition LinearMap s v u
v +> u
m of
            [] -> ([Char]
"zeroV"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
            ((Basis u
b₀,v
dv₀):[(Basis u, v)]
dvs) -> Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
6)
                            (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \[Char]
s -> Int -> Basis u -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @u Int
7 Basis u
b₀
                                                     ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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]
".<"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> v -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
7 v
dv₀
                                  ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Basis u, v) -> [Char] -> [Char])
-> [Char] -> [(Basis u, v)] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Basis u
b,v
dv)
                                        -> ([Char]
" ^+^ "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> Basis u -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @u Int
7 Basis u
b
                                                       ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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]
".<"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> v -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
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 ℝ) -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ v (V1 ℝ) -> [Char] -> [Char]
forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> [Char] -> [Char]
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (LinearMap ℝ v (V2 ℝ)) where
  showsPrec :: Int -> LinearMap ℝ v (V2 ℝ) -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ v (V2 ℝ) -> [Char] -> [Char]
forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> [Char] -> [Char]
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (LinearMap ℝ v (V3 ℝ)) where
  showsPrec :: Int -> LinearMap ℝ v (V3 ℝ) -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ v (V3 ℝ) -> [Char] -> [Char]
forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> [Char] -> [Char]
rieszDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (LinearMap ℝ v (V4 ℝ)) where
  showsPrec :: Int -> LinearMap ℝ v (V4 ℝ) -> [Char] -> [Char]
showsPrec = Int -> LinearMap ℝ v (V4 ℝ) -> [Char] -> [Char]
forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> [Char] -> [Char]
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) -> [Char] -> [Char]
showsPrec = case
      (DualSpaceWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness x, DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness y) of
      (DualSpaceWitness x
DualSpaceWitness, DualSpaceWitness y
DualSpaceWitness) -> Int -> LinearMap s v (x, y) -> [Char] -> [Char]
forall u v s.
(RieszDecomposable u, FiniteDimensional v, v ~ DualVector v,
 Show v, Scalar u ~ s, Scalar v ~ s) =>
Int -> LinearMap s v u -> [Char] -> [Char]
rieszDecomposeShowsPrec


infixr 7 .⊗

(.⊗) :: ( TensorSpace v, HasBasis v, TensorSpace w
        , Num' (Scalar v), Scalar v ~ Scalar w )
         => Basis v -> w -> v⊗w
Basis v
b .⊗ :: Basis v -> w -> v ⊗ w
.⊗ w
w = Basis v -> v
forall v. HasBasis v => Basis v -> v
basisValue Basis v
b v -> w -> v ⊗ w
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 :: (ℝ ⊗ w) -> [(Basis ℝ, w)]
tensorDecomposition (Tensor TensorProduct ℝ w
r) = [((), w
TensorProduct ℝ w
r)]
  showsPrecBasis :: Int -> Basis ℝ -> [Char] -> [Char]
showsPrecBasis Int
_ = Basis ℝ -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows
instance ∀ x y . ( TensorDecomposable x, TensorDecomposable y
                 , Scalar x ~ Scalar y, Scalar (DualVector x) ~ Scalar (DualVector y) )
              => TensorDecomposable (x,y) where
  tensorDecomposition :: ((x, y) ⊗ w) -> [(Basis (x, y), w)]
tensorDecomposition (Tensor (tx,ty))
                = ((Basis x, w) -> (Either (Basis x) (Basis y), w))
-> [(Basis x, w)] -> [(Either (Basis x) (Basis y), w)]
forall a b. (a -> b) -> [a] -> [b]
map ((Basis x -> Either (Basis x) (Basis y))
-> (Basis x, w) -> (Either (Basis x) (Basis y), w)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Basis x -> Either (Basis x) (Basis y)
forall a b. a -> Either a b
Left) ((x ⊗ w) -> [(Basis x, w)]
forall v w. TensorDecomposable v => (v ⊗ w) -> [(Basis v, w)]
tensorDecomposition x ⊗ w
Tensor (Scalar y) x w
tx)
               [(Either (Basis x) (Basis y), w)]
-> [(Either (Basis x) (Basis y), w)]
-> [(Either (Basis x) (Basis y), w)]
forall a. [a] -> [a] -> [a]
++ ((Basis y, w) -> (Either (Basis x) (Basis y), w))
-> [(Basis y, w)] -> [(Either (Basis x) (Basis y), w)]
forall a b. (a -> b) -> [a] -> [b]
map ((Basis y -> Either (Basis x) (Basis y))
-> (Basis y, w) -> (Either (Basis x) (Basis y), w)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Basis y -> Either (Basis x) (Basis y)
forall a b. b -> Either a b
Right) ((y ⊗ w) -> [(Basis y, w)]
forall v w. TensorDecomposable v => (v ⊗ w) -> [(Basis v, w)]
tensorDecomposition y ⊗ w
ty)
  showsPrecBasis :: Int -> Basis (x, y) -> [Char] -> [Char]
showsPrecBasis Int
p (Left bx)
      = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"Left "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> Basis x -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @x Int
10 Basis x
bx
  showsPrecBasis Int
p (Right by)
      = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ([Char]
"Right "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> Basis y -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @y Int
10 Basis y
by

instance TensorDecomposable (ZeroDim ℝ) where
  tensorDecomposition :: (ZeroDim ℝ ⊗ w) -> [(Basis (ZeroDim ℝ), w)]
tensorDecomposition ZeroDim ℝ ⊗ w
_ = []
  showsPrecBasis :: Int -> Basis (ZeroDim ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ = Basis (ZeroDim ℝ) -> [Char] -> [Char]
forall a. Void -> a
absurd
instance TensorDecomposable (V0 ℝ) where
  tensorDecomposition :: (V0 ℝ ⊗ w) -> [(Basis (V0 ℝ), w)]
tensorDecomposition V0 ℝ ⊗ w
_ = []
#if MIN_VERSION_free_vector_spaces(0,2,0)
  showsPrecBasis = showsPrec
#else
  showsPrecBasis :: Int -> Basis (V0 ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ (Mat.E q) = (V0 [Char]
forall a. V0 a
V0V0 [Char] -> Getting [Char] (V0 [Char]) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] (V0 [Char]) [Char]
forall x. Lens' (V0 x) x
q [Char] -> [Char] -> [Char]
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 :: (V1 ℝ ⊗ w) -> [(Basis (V1 ℝ), w)]
tensorDecomposition (Tensor (V1 w)) = [(Basis (V1 ℝ)
forall (t :: * -> *). R1 t => E t
ex, w
w)]
  showsPrecBasis :: Int -> Basis (V1 ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ (Mat.E q) = ([Char] -> V1 [Char]
forall a. a -> V1 a
V1[Char]
"ex"V1 [Char] -> Getting [Char] (V1 [Char]) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] (V1 [Char]) [Char]
forall x. Lens' (V1 x) x
q [Char] -> [Char] -> [Char]
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 :: (V2 ℝ ⊗ w) -> [(Basis (V2 ℝ), w)]
tensorDecomposition (Tensor (V2 x y)) = [ (Basis (V2 ℝ)
forall (t :: * -> *). R1 t => E t
ex, w
x), (Basis (V2 ℝ)
forall (t :: * -> *). R2 t => E t
ey, w
y) ]
  showsPrecBasis :: Int -> Basis (V2 ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ (Mat.E q) = ([Char] -> [Char] -> V2 [Char]
forall a. a -> a -> V2 a
V2[Char]
"ex"[Char]
"ey"V2 [Char] -> Getting [Char] (V2 [Char]) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] (V2 [Char]) [Char]
forall x. Lens' (V2 x) x
q [Char] -> [Char] -> [Char]
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 :: (V3 ℝ ⊗ w) -> [(Basis (V3 ℝ), w)]
tensorDecomposition (Tensor (V3 x y z)) = [ (Basis (V3 ℝ)
forall (t :: * -> *). R1 t => E t
ex, w
x), (Basis (V3 ℝ)
forall (t :: * -> *). R2 t => E t
ey, w
y), (Basis (V3 ℝ)
forall (t :: * -> *). R3 t => E t
ez, w
z) ]
  showsPrecBasis :: Int -> Basis (V3 ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ (Mat.E q) = ([Char] -> [Char] -> [Char] -> V3 [Char]
forall a. a -> a -> a -> V3 a
V3[Char]
"ex"[Char]
"ey"[Char]
"ez"V3 [Char] -> Getting [Char] (V3 [Char]) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] (V3 [Char]) [Char]
forall x. Lens' (V3 x) x
q [Char] -> [Char] -> [Char]
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 :: (V4 ℝ ⊗ w) -> [(Basis (V4 ℝ), w)]
tensorDecomposition (Tensor (V4 x y z w)) = [ (Basis (V4 ℝ)
forall (t :: * -> *). R1 t => E t
ex, w
x), (Basis (V4 ℝ)
forall (t :: * -> *). R2 t => E t
ey, w
y), (Basis (V4 ℝ)
forall (t :: * -> *). R3 t => E t
ez, w
z), (Basis (V4 ℝ)
forall (t :: * -> *). R4 t => E t
ew, w
w) ]
  showsPrecBasis :: Int -> Basis (V4 ℝ) -> [Char] -> [Char]
showsPrecBasis Int
_ (Mat.E q) = ([Char] -> [Char] -> [Char] -> [Char] -> V4 [Char]
forall a. a -> a -> a -> a -> V4 a
V4[Char]
"ex"[Char]
"ey"[Char]
"ez"[Char]
"ew"V4 [Char] -> Getting [Char] (V4 [Char]) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] (V4 [Char]) [Char]
forall x. Lens' (V4 x) x
q [Char] -> [Char] -> [Char]
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 :: Int -> Tensor s u v -> [Char] -> [Char]
tensorDecomposeShowsPrec Int
p Tensor s u v
t = case (u ⊗ v) -> [(Basis u, v)]
forall v w. TensorDecomposable v => (v ⊗ w) -> [(Basis v, w)]
tensorDecomposition Tensor s u v
u ⊗ v
t of
            [] -> ([Char]
"zeroV"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
            ((Basis u
b₀,v
dv₀):[(Basis u, v)]
dvs) -> Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
6)
                            (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \[Char]
s -> Int -> Basis u -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @u Int
7 Basis u
b₀
                                                     ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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]
".⊗"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> v -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
7 v
dv₀
                                  ([Char] -> [Char]) -> [Char] -> [Char]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Basis u, v) -> [Char] -> [Char])
-> [Char] -> [(Basis u, v)] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Basis u
b,v
dv)
                                        -> ([Char]
" ^+^ "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> Basis u -> [Char] -> [Char]
forall v.
TensorDecomposable v =>
Int -> Basis v -> [Char] -> [Char]
showsPrecBasis @u Int
7 Basis u
b
                                                       ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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]
".⊗"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
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 -> v -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
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 -> [Char] -> [Char]
showsPrec = Int -> Tensor ℝ (V1 ℝ) v -> [Char] -> [Char]
forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
 Scalar v ~ s) =>
Int -> Tensor s u v -> [Char] -> [Char]
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (Tensor ℝ (V2 ℝ) v) where
  showsPrec :: Int -> Tensor ℝ (V2 ℝ) v -> [Char] -> [Char]
showsPrec = Int -> Tensor ℝ (V2 ℝ) v -> [Char] -> [Char]
forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
 Scalar v ~ s) =>
Int -> Tensor s u v -> [Char] -> [Char]
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (Tensor ℝ (V3 ℝ) v) where
  showsPrec :: Int -> Tensor ℝ (V3 ℝ) v -> [Char] -> [Char]
showsPrec = Int -> Tensor ℝ (V3 ℝ) v -> [Char] -> [Char]
forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
 Scalar v ~ s) =>
Int -> Tensor s u v -> [Char] -> [Char]
tensorDecomposeShowsPrec
instance (FiniteDimensional v, v ~ DualVector v, Scalar v ~ ℝ, Show v)
              => Show (Tensor ℝ (V4 ℝ) v) where
  showsPrec :: Int -> Tensor ℝ (V4 ℝ) v -> [Char] -> [Char]
showsPrec = Int -> Tensor ℝ (V4 ℝ) v -> [Char] -> [Char]
forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
 Scalar v ~ s) =>
Int -> Tensor s u v -> [Char] -> [Char]
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 -> [Char] -> [Char]
showsPrec = case
      (DualSpaceWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness x, DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness y) of
      (DualSpaceWitness x
DualSpaceWitness, DualSpaceWitness y
DualSpaceWitness) -> Int -> Tensor s (x, y) v -> [Char] -> [Char]
forall u v s.
(TensorDecomposable u, FiniteDimensional v, Show v, Scalar u ~ s,
 Scalar v ~ s) =>
Int -> Tensor s u v -> [Char] -> [Char]
tensorDecomposeShowsPrec


(^) :: Num a => a -> Int -> a
^ :: a -> Int -> 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 :: p (LinearMap s u v) -> Int
freeDimension p (LinearMap s u v)
_ = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
                       Int -> Int -> Int
forall a. Num a => a -> a -> a
* [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
  toFullUnboxVect :: LinearMap s u v -> Vector (Scalar (LinearMap s u v))
toFullUnboxVect = SubBasis u
-> LinearMap (Scalar u) u v
-> Either (SubBasis u, [v] -> [v]) ([v] -> [v])
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
forall v. FiniteDimensional v => SubBasis v
entireBasis (LinearMap (Scalar u) u v
 -> Either (SubBasis u, [v] -> [v]) ([v] -> [v]))
-> (Either (SubBasis u, [v] -> [v]) ([v] -> [v]) -> Vector s)
-> LinearMap (Scalar u) u v
-> Vector s
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 [v] -> [v]
l -> [Vector s] -> Vector s
forall a. Unbox a => [Vector a] -> Vector a
UArr.concat ([Vector s] -> Vector s) -> [Vector s] -> Vector s
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v -> Vector s
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect (v -> Vector s) -> [v] -> [Vector s]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [v] -> [v]
l []
  unsafeFromFullUnboxVect :: Vector (Scalar (LinearMap s u v)) -> LinearMap s u v
unsafeFromFullUnboxVect Vector (Scalar (LinearMap s u v))
arrv = (LinearMap s u v, [v]) -> LinearMap s u v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((LinearMap s u v, [v]) -> LinearMap s u v)
-> ([v] -> (LinearMap s u v, [v])) -> [v] -> LinearMap s u v
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 u -> [v] -> (LinearMap (Scalar u) u v, [v])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis
          ([v] -> LinearMap s u v) -> [v] -> LinearMap s u v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Vector s -> v
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect (Vector s -> v) -> Vector s -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int -> Vector s -> Vector s
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
UArr.slice (Int
dvInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
j) Int
dv Vector s
Vector (Scalar (LinearMap s u v))
arrv | Int
j <- [Int
0 .. Int
duInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
   where du :: Int
du = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
         dv :: Int
dv = [v] -> Int
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 :: p (Tensor s u v) -> Int
freeDimension p (Tensor s u v)
_ = SubBasis (DualVector u) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis (DualVector u)
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (DualVector u))
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
* [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
  toFullUnboxVect :: Tensor s u v -> Vector (Scalar (Tensor s u v))
toFullUnboxVect = Coercion (Tensor s u v) (LinearMap s (DualVector u) v)
-> Tensor s u v -> LinearMap s (DualVector u) v
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 Coercion (Tensor s u v) (LinearMap s (DualVector u) v)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
asLinearMap (Tensor s u v -> LinearMap s (DualVector u) v)
-> (LinearMap s (DualVector u) v -> Vector s)
-> Tensor s u v
-> Vector s
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
>>> SubBasis (DualVector u)
-> (DualVector u +> v)
-> Either (SubBasis (DualVector u), DList v) (DList v)
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
decomposeLinMapWithin SubBasis (DualVector u)
forall v. FiniteDimensional v => SubBasis v
entireBasis (LinearMap s (DualVector u) v
 -> Either (SubBasis (DualVector u), DList v) (DList v))
-> (Either (SubBasis (DualVector u), DList v) (DList v)
    -> Vector s)
-> LinearMap s (DualVector u) v
-> Vector s
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 -> [Vector s] -> Vector s
forall a. Unbox a => [Vector a] -> Vector a
UArr.concat ([Vector s] -> Vector s) -> [Vector s] -> Vector s
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ v -> Vector s
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect (v -> Vector s) -> [v] -> [Vector s]
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 :: Vector (Scalar (Tensor s u v)) -> Tensor s u v
unsafeFromFullUnboxVect Vector (Scalar (Tensor s u v))
arrv = Coercion (LinearMap s (DualVector u) v) (Tensor s u v)
forall s v w.
(LinearSpace v, Scalar v ~ s) =>
Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
fromLinearMap Coercion (LinearMap s (DualVector u) v) (Tensor s u v)
-> LinearMap s (DualVector u) v -> Tensor s u v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap s (DualVector u) v, [v]) -> LinearMap s (DualVector u) v
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((LinearMap s (DualVector u) v, [v])
 -> LinearMap s (DualVector u) v)
-> ([v] -> (LinearMap s (DualVector u) v, [v]))
-> [v]
-> LinearMap s (DualVector u) v
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 (DualVector u) -> [v] -> (DualVector u +> v, [v])
forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
SubBasis v -> [w] -> (v +> w, [w])
recomposeLinMap SubBasis (DualVector u)
forall v. FiniteDimensional v => SubBasis v
entireBasis
          ([v] -> LinearMap s (DualVector u) v)
-> [v] -> LinearMap s (DualVector u) v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Vector s -> v
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect (Vector s -> v) -> Vector s -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int -> Vector s -> Vector s
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
UArr.slice (Int
dvInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
j) Int
dv Vector s
Vector (Scalar (Tensor s u v))
arrv | Int
j <- [Int
0 .. Int
duInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
   where du :: Int
du = SubBasis (DualVector u) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis (DualVector u)
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (DualVector u))
         dv :: Int
dv = [v] -> Int
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 :: p (LinearFunction s u v) -> Int
freeDimension p (LinearFunction s u v)
_ = SubBasis u -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis u
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis u)
                       Int -> Int -> Int
forall a. Num a => a -> a -> a
* [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
  toFullUnboxVect :: LinearFunction s u v -> Vector (Scalar (LinearFunction s u v))
toFullUnboxVect LinearFunction s u v
f = LinearMap s u v -> Vector (Scalar (LinearMap s u v))
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect (LinearFunction s u v -> LinearMap s u v
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 :: Vector (Scalar (LinearFunction s u v)) -> LinearFunction s u v
unsafeFromFullUnboxVect Vector (Scalar (LinearFunction s u v))
arrv = LinearMap s u v -> LinearFunction s u v
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 (Vector (Scalar (LinearMap s u v)) -> LinearMap s u v
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect Vector (Scalar (LinearFunction s u v))
Vector (Scalar (LinearMap 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 :: (v +> DualVector w) -+> (w +> DualVector v)
adjoint = case ( DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v
               , DualSpaceWitness w
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness w ) of
   (DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness w
DualSpaceWitness)
          -> Coercion
  (Tensor (Scalar w) (DualVector w) (DualVector v))
  (w +> DualVector v)
-> LinearFunction
     (Scalar (DualVector w))
     (Tensor (Scalar w) (DualVector w) (DualVector v))
     (w +> DualVector v)
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 Coercion
  (Tensor (Scalar w) (DualVector w) (DualVector v))
  (w +> DualVector v)
forall s v w.
Coercion (Tensor s (DualVector v) w) (LinearMap s v w)
fromTensor LinearFunction
  (Scalar (DualVector w))
  (Tensor (Scalar w) (DualVector w) (DualVector v))
  (w +> DualVector v)
-> LinearFunction
     (Scalar (DualVector w))
     (LinearMap (Scalar w) v (DualVector w))
     (Tensor (Scalar w) (DualVector w) (DualVector v))
-> LinearFunction
     (Scalar (DualVector w))
     (LinearMap (Scalar w) v (DualVector w))
     (w +> DualVector v)
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
. LinearFunction
  (Scalar (DualVector w))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
  (Tensor (Scalar w) (DualVector w) (DualVector v))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor LinearFunction
  (Scalar (DualVector w))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
  (Tensor (Scalar w) (DualVector w) (DualVector v))
-> LinearFunction
     (Scalar (DualVector w))
     (LinearMap (Scalar w) v (DualVector w))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
-> LinearFunction
     (Scalar (DualVector w))
     (LinearMap (Scalar w) v (DualVector w))
     (Tensor (Scalar w) (DualVector w) (DualVector v))
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
. Coercion
  (LinearMap (Scalar w) v (DualVector w))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
-> LinearFunction
     (Scalar (DualVector w))
     (LinearMap (Scalar w) v (DualVector w))
     (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
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 Coercion
  (LinearMap (Scalar w) v (DualVector w))
  (Tensor (Scalar (DualVector v)) (DualVector v) (DualVector w))
forall s v w.
Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
asTensor




multiSplit :: Int -> Int -> [a] -> ([[a]], [a])
multiSplit :: Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
chunkSize Int
0 [a]
l = ([],[a]
l)
multiSplit Int
chunkSize Int
nChunks [a]
l = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
chunkSize [a]
l of
    ([a]
chunk, [a]
rest) -> ([[a]] -> [[a]]) -> ([[a]], [a]) -> ([[a]], [a])
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]
chunk[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) (([[a]], [a]) -> ([[a]], [a])) -> ([[a]], [a]) -> ([[a]], [a])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int -> [a] -> ([[a]], [a])
forall a. Int -> Int -> [a] -> ([[a]], [a])
multiSplit Int
chunkSize (Int
nChunksInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
rest