-- -*- coding: utf-8 -*-
 {-# LANGUAGE Safe,MultiParamTypeClasses, ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts, FunctionalDependencies, FlexibleInstances #-}
 {-# LANGUAGE TypeOperators, TypeFamilies, DefaultSignatures #-}
 {-# LANGUAGE UnicodeSyntax, DeriveGeneric, DeriveDataTypeable #-}
 {-# LANGUAGE ConstraintKinds, UndecidableInstances, OverloadedStrings #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE GADTs, AllowAmbiguousTypes, PolyKinds, RankNTypes #-}
 -- | These should match standard definitions of vector spaces.
 -- Used for reference: K. Chandrasekhara Rao: Functional Analysis.
 -- also see Warner: Modern algebra.
 module Math.Matrix.Interface where
 import safe GHC.Generics hiding ((:*:),(:+:))
 import safe Text.PrettyPrint hiding ((<>))
 import safe Data.Data
 import safe Data.Kind (Type)
 import safe Data.Typeable
 import safe Data.Monoid hiding (Dual, Endo)
 import safe Data.Ratio
 import safe Data.Traversable
 import safe Data.Complex
 import safe Data.Foldable
 import safe Data.List (intersperse)
 import safe Data.Word
 import safe Data.Int
 import safe qualified Data.Set
 import safe Prelude hiding (id,(.))
 import safe Control.Category
 import safe Control.Applicative
 import safe qualified Control.Arrow as Arrow
 import safe Data.Type.Equality
 import safe qualified Control.Applicative as Applicative
 import safe Control.Monad.Fix (fix)
 import safe Control.Monad (join, MonadPlus(..))
 import safe Data.Functor.Contravariant
 import safe Math.Tools.PrettyP
 import safe Math.Tools.Visitor
 import safe Math.Tools.FixedPoint
 import safe Math.Tools.Universe
 import safe Math.Tools.I
 import safe Math.Tools.CoFunctor
 import safe Math.Tools.Arrow
 import safe Math.Tools.Isomorphism
 import safe Math.Tools.Endomorphism

 infixl 7 %.%
 infix 7 %*
 infix 7 %.
 infixl 6 %+
 infixl 6 %-
 infixr 5 :*:
 
 -- | The primary data type for matrices.
 -- Note that indices are represented in the functors,
 -- If you want to use numeric indices, use 'Math.Matrix.Simple'.
 -- This can be viewed as a bicategory with one object ('a').
 -- <https://ncatlab.org/nlab/show/bicategory>
 -- or as a monoidal category <https://ncatlab.org/nlab/show/monoidal+category>
 -- or as a matrix over a base field 'a' <https://ncatlab.org/nlab/show/matrix>
 -- or as a tensor product of functors 'f' and 'g' <https://ncatlab.org/nlab/show/tensor+product>
 -- or as a composition of functors 'f' and 'g'
 newtype (f :*: g) a = Matrix { forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells :: f (g a) }
   deriving (Typeable, (forall x. (:*:) f g a -> Rep ((:*:) f g a) x)
-> (forall x. Rep ((:*:) f g a) x -> (:*:) f g a)
-> Generic ((:*:) f g a)
forall x. Rep ((:*:) f g a) x -> (:*:) f g a
forall x. (:*:) f g a -> Rep ((:*:) f g a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) k (g :: k -> k) (a :: k) x.
Rep ((:*:) f g a) x -> (:*:) f g a
forall k (f :: k -> *) k (g :: k -> k) (a :: k) x.
(:*:) f g a -> Rep ((:*:) f g a) x
$cfrom :: forall k (f :: k -> *) k (g :: k -> k) (a :: k) x.
(:*:) f g a -> Rep ((:*:) f g a) x
from :: forall x. (:*:) f g a -> Rep ((:*:) f g a) x
$cto :: forall k (f :: k -> *) k (g :: k -> k) (a :: k) x.
Rep ((:*:) f g a) x -> (:*:) f g a
to :: forall x. Rep ((:*:) f g a) x -> (:*:) f g a
Generic, (:*:) f g a -> (:*:) f g a -> Bool
((:*:) f g a -> (:*:) f g a -> Bool)
-> ((:*:) f g a -> (:*:) f g a -> Bool) -> Eq ((:*:) f g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) k (g :: k -> k) (a :: k).
Eq (f (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
$c== :: forall k (f :: k -> *) k (g :: k -> k) (a :: k).
Eq (f (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
== :: (:*:) f g a -> (:*:) f g a -> Bool
$c/= :: forall k (f :: k -> *) k (g :: k -> k) (a :: k).
Eq (f (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
/= :: (:*:) f g a -> (:*:) f g a -> Bool
Eq)

  -- matrixLinearmap :: (Scalar (f (g a)) ~ a) => ((Dual :*: f) :*: g) a -> ((f :*: g) a) :-> I a
  -- matrixLinearmap (Matrix (Matrix (Covector m))) = m . LinearMap Refl cells



  -- instance FunctorArrow f LinearMap where
  --   amap (LinearMap p m) = LinearMap Refl $ Matrix $ liftA2 (Matrix . liftA2 Matrix) $ cells m



  -- cellsLinear :: (Indexable f, LinearTransform f g a,Diagonalizable f a) => f a :-> g a -> f (g a)
  -- cellsLinear = cells . fromLinear

 -- | This method of matrix construction is especially nice.
 -- This is the functoriality of the tensor product.

 {-# INLINE matrix #-}
 matrix :: (Functor m, Functor n) => (a -> b -> c) -> m a -> n b -> (m :*: n) c
 matrix :: forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix a -> b -> c
f m a
x = \n b
y -> m (n c) -> (:*:) m n c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (m (n c) -> (:*:) m n c) -> m (n c) -> (:*:) m n c
forall a b. (a -> b) -> a -> b
$ ((a -> n c) -> m a -> m (n c)) -> m a -> (a -> n c) -> m (n c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> n c) -> m a -> m (n c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a
x ((a -> n c) -> m (n c)) -> (a -> n c) -> m (n c)
forall a b. (a -> b) -> a -> b
$ \a
a -> 
                             ((b -> c) -> n b -> n c) -> n b -> (b -> c) -> n c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> n b -> n c
forall a b. (a -> b) -> n a -> n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n b
y ((b -> c) -> n c) -> (b -> c) -> n c
forall a b. (a -> b) -> a -> b
$ \b
b -> a -> b -> c
f a
a b
b

 inverseMatrix :: (Contravariant m, Contravariant n)
  => (g a -> c -> b) -> (m :*: n) c -> n b -> (m :*: g) a
 inverseMatrix :: forall {k} (m :: * -> *) (n :: * -> *) (g :: k -> *) (a :: k) c b.
(Contravariant m, Contravariant n) =>
(g a -> c -> b) -> (:*:) m n c -> n b -> (:*:) m g a
inverseMatrix g a -> c -> b
f (Matrix m (n c)
x) n b
y = m (g a) -> (:*:) m g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (m (g a) -> (:*:) m g a) -> m (g a) -> (:*:) m g a
forall a b. (a -> b) -> a -> b
$ ((g a -> n c) -> m (n c) -> m (g a))
-> m (n c) -> (g a -> n c) -> m (g a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (g a -> n c) -> m (n c) -> m (g a)
forall (p :: * -> *) a b. CoFunctor p => (a -> b) -> p b -> p a
inverseImage m (n c)
x ((g a -> n c) -> m (g a)) -> (g a -> n c) -> m (g a)
forall a b. (a -> b) -> a -> b
$ \g a
a ->
                                 ((c -> b) -> n b -> n c) -> n b -> (c -> b) -> n c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (c -> b) -> n b -> n c
forall (p :: * -> *) a b. CoFunctor p => (a -> b) -> p b -> p a
inverseImage n b
y ((c -> b) -> n c) -> (c -> b) -> n c
forall a b. (a -> b) -> a -> b
$ \c
b -> g a -> c -> b
f g a
a c
b

 leftInverseMatrix :: (Contravariant m, Functor n)
   => (g a -> c -> b) -> (m :*: n) b -> n c -> (m :*: g) a
 leftInverseMatrix :: forall {k} (m :: * -> *) (n :: * -> *) (g :: k -> *) (a :: k) c b.
(Contravariant m, Functor n) =>
(g a -> c -> b) -> (:*:) m n b -> n c -> (:*:) m g a
leftInverseMatrix g a -> c -> b
f (Matrix m (n b)
x) n c
y = m (g a) -> (:*:) m g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (m (g a) -> (:*:) m g a) -> m (g a) -> (:*:) m g a
forall a b. (a -> b) -> a -> b
$ ((g a -> n b) -> m (n b) -> m (g a))
-> m (n b) -> (g a -> n b) -> m (g a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (g a -> n b) -> m (n b) -> m (g a)
forall (p :: * -> *) a b. CoFunctor p => (a -> b) -> p b -> p a
inverseImage m (n b)
x ((g a -> n b) -> m (g a)) -> (g a -> n b) -> m (g a)
forall a b. (a -> b) -> a -> b
$ \g a
a ->
                                      ((c -> b) -> n c -> n b) -> n c -> (c -> b) -> n b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (c -> b) -> n c -> n b
forall a b. (a -> b) -> n a -> n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n c
y ((c -> b) -> n b) -> (c -> b) -> n b
forall a b. (a -> b) -> a -> b
$ \c
b -> g a -> c -> b
f g a
a c
b

 rightInverseMatrix :: (Functor m, Contravariant n)
   => (t -> a -> b) -> m t -> n b -> (m :*: n) a
 rightInverseMatrix :: forall (m :: * -> *) (n :: * -> *) t a b.
(Functor m, Contravariant n) =>
(t -> a -> b) -> m t -> n b -> (:*:) m n a
rightInverseMatrix t -> a -> b
f m t
x n b
y = m (n a) -> (:*:) m n a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (m (n a) -> (:*:) m n a) -> m (n a) -> (:*:) m n a
forall a b. (a -> b) -> a -> b
$ ((t -> n a) -> m t -> m (n a)) -> m t -> (t -> n a) -> m (n a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (t -> n a) -> m t -> m (n a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m t
x ((t -> n a) -> m (n a)) -> (t -> n a) -> m (n a)
forall a b. (a -> b) -> a -> b
$ \t
a ->
                                       ((a -> b) -> n b -> n a) -> n b -> (a -> b) -> n a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> n b -> n a
forall (p :: * -> *) a b. CoFunctor p => (a -> b) -> p b -> p a
inverseImage n b
y ((a -> b) -> n a) -> (a -> b) -> n a
forall a b. (a -> b) -> a -> b
$ \a
b -> t -> a -> b
f t
a a
b

 -- | From "Kenneth Foner: Functional Pearl: Getting a Quick Fix on Comonads"
 -- <https://raw.githubusercontent.com/plaidfinch/GQFC-1.pdf>
 loeb :: (Functor f) => f (f a -> a) -> f a
 loeb :: forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb f (f a -> a)
ffs = (f a -> f a) -> f a
forall a. (a -> a) -> a
fix (\f a
fa -> ((f a -> a) -> a) -> f (f a -> a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ f a
fa) f (f a -> a)
ffs)

 loebM :: (Monad m) => m a -> (a -> m (m b -> b)) -> m b
 loebM :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> m (m b -> b)) -> m b
loebM m a
m a -> m (m b -> b)
f = m (m b -> b) -> m b
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb (m a
m m a -> (a -> m (m b -> b)) -> m (m b -> b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m (m b -> b)
f)

 loebloeb :: (Functor f) => f (f (f a -> a) -> f a -> a) -> f a
 loebloeb :: forall (f :: * -> *) a.
Functor f =>
f (f (f a -> a) -> f a -> a) -> f a
loebloeb = f (f a -> a) -> f a
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb (f (f a -> a) -> f a)
-> (f (f (f a -> a) -> f a -> a) -> f (f a -> a))
-> f (f (f a -> a) -> f a -> a)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (f (f a -> a) -> f a -> a) -> f (f a -> a)
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb

 -- | construct a matrix where each element may refer to other elements
 -- for computation.
 spreadsheetMatrix :: (Functor f, Functor g) => (a -> b -> (f :*: g) c -> c)
   -> f a -> g b -> (f :*: g) c
 spreadsheetMatrix :: forall (f :: * -> *) (g :: * -> *) a b c.
(Functor f, Functor g) =>
(a -> b -> (:*:) f g c -> c) -> f a -> g b -> (:*:) f g c
spreadsheetMatrix a -> b -> (:*:) f g c -> c
f f a
x g b
y = (:*:) f g ((:*:) f g c -> c) -> (:*:) f g c
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb ((:*:) f g ((:*:) f g c -> c) -> (:*:) f g c)
-> (:*:) f g ((:*:) f g c -> c) -> (:*:) f g c
forall a b. (a -> b) -> a -> b
$ (a -> b -> (:*:) f g c -> c)
-> f a -> g b -> (:*:) f g ((:*:) f g c -> c)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix a -> b -> (:*:) f g c -> c
f f a
x g b
y

 mapWithSelf :: (Functor f) => (f b -> a -> b) -> f a -> f b
 mapWithSelf :: forall (f :: * -> *) b a.
Functor f =>
(f b -> a -> b) -> f a -> f b
mapWithSelf f b -> a -> b
f = f (f b -> b) -> f b
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb (f (f b -> b) -> f b) -> (f a -> f (f b -> b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f b -> b) -> f a -> f (f b -> b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f b -> a -> b) -> a -> f b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip f b -> a -> b
f)

 selfM :: (Monad m) => (m a -> a) -> m a
 selfM :: forall (m :: * -> *) a. Monad m => (m a -> a) -> m a
selfM = m (m a -> a) -> m a
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb (m (m a -> a) -> m a)
-> ((m a -> a) -> m (m a -> a)) -> (m a -> a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (m a -> a) -> m (m a -> a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

 selfJoinM :: (Monad m) => m (m (m a -> a)) -> m a
 selfJoinM :: forall (m :: * -> *) a. Monad m => m (m (m a -> a)) -> m a
selfJoinM = m (m a -> a) -> m a
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb (m (m a -> a) -> m a)
-> (m (m (m a -> a)) -> m (m a -> a)) -> m (m (m a -> a)) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (m (m (m a -> a)) -> (m (m a -> a) -> m (m a -> a)) -> m (m a -> a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (m a -> a) -> m (m a -> a)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)

 spreadsheet :: (Functor f, Functor g) => (f :*: g) ((f :*: g) a -> a) -> (f :*: g) a
 spreadsheet :: forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Functor g) =>
(:*:) f g ((:*:) f g a -> a) -> (:*:) f g a
spreadsheet = (:*:) f g ((:*:) f g a -> a) -> (:*:) f g a
forall (f :: * -> *) a. Functor f => f (f a -> a) -> f a
loeb ((:*:) f g ((:*:) f g a -> a) -> (:*:) f g a)
-> ((:*:) f g ((:*:) f g a -> a) -> (:*:) f g ((:*:) f g a -> a))
-> (:*:) f g ((:*:) f g a -> a)
-> (:*:) f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (g ((:*:) f g a -> a)) -> (:*:) f g ((:*:) f g a -> a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g ((:*:) f g a -> a)) -> (:*:) f g ((:*:) f g a -> a))
-> ((:*:) f g ((:*:) f g a -> a) -> f (g ((:*:) f g a -> a)))
-> (:*:) f g ((:*:) f g a -> a)
-> (:*:) f g ((:*:) f g a -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) f g ((:*:) f g a -> a) -> f (g ((:*:) f g a -> a))
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells

 inverseFix :: (Contravariant p) => (a -> a) -> p a
 inverseFix :: forall (p :: * -> *) a. Contravariant p => (a -> a) -> p a
inverseFix a -> a
f = let x :: p a
x = p a
x p a -> (a -> a) -> p a
forall (p :: * -> *) b a. CoFunctor p => p b -> (a -> b) -> p a
|>> a -> a
f in p a
x

 inverseFix2 :: (Contravariant p) => (a -> b) -> (b -> a) -> p a
 inverseFix2 :: forall (p :: * -> *) a b.
Contravariant p =>
(a -> b) -> (b -> a) -> p a
inverseFix2 a -> b
f b -> a
g = let x :: p a
x = p b
y p b -> (a -> b) -> p a
forall (p :: * -> *) b a. CoFunctor p => p b -> (a -> b) -> p a
|>> a -> b
f
                       y :: p b
y = p a
x p a -> (b -> a) -> p b
forall (p :: * -> *) b a. CoFunctor p => p b -> (a -> b) -> p a
|>> b -> a
g
                     in p a
x

 matrixCompose :: (Functor m, Functor n, Category cat)
                => m (cat b c) -> n (cat a b) -> (m :*: n) (cat a c)
 matrixCompose :: forall {k} (m :: * -> *) (n :: * -> *) (cat :: k -> k -> *)
       (b :: k) (c :: k) (a :: k).
(Functor m, Functor n, Category cat) =>
m (cat b c) -> n (cat a b) -> (:*:) m n (cat a c)
matrixCompose = (cat b c -> cat a b -> cat a c)
-> m (cat b c) -> n (cat a b) -> (:*:) m n (cat a c)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix cat b c -> cat a b -> cat a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<)

 tensorProduct :: (Num a, Functor m, Functor n) => m a -> n a -> (m :*: n) a
 tensorProduct :: forall a (m :: * -> *) (n :: * -> *).
(Num a, Functor m, Functor n) =>
m a -> n a -> (:*:) m n a
tensorProduct = (a -> a -> a) -> m a -> n a -> (:*:) m n a
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix a -> a -> a
forall a. Num a => a -> a -> a
(*)

 tensorProductLin :: (Linearizable arr (:*:) f g a, Num a, Functor f, Functor g)
  => f a -> g a -> arr (f a) (g a)
 tensorProductLin :: forall (arr :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
(Linearizable arr (:*:) f g a, Num a, Functor f, Functor g) =>
f a -> g a -> arr (f a) (g a)
tensorProductLin f a
x g a
y = (:*:) f g a -> arr (f a) (g a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) f g a -> arr (f a) (g a)) -> (:*:) f g a -> arr (f a) (g a)
forall a b. (a -> b) -> a -> b
$ f a -> g a -> (:*:) f g a
forall a (m :: * -> *) (n :: * -> *).
(Num a, Functor m, Functor n) =>
m a -> n a -> (:*:) m n a
tensorProduct f a
x g a
y

 -- | <https://en.wikipedia.org/wiki/Tensor_product>


  --  fmap (\u -> unI (lm -!< u)) v
  --
  --  \u -> (unI $ f u) %* v



 -- | bilinearity :
 --    \[f (a + b,c) = f(a, c) + f(b, c)\]
 --    \[f (k b, c) = k f(b, c)\]
 --    \[f (a, b + c) = f(a, b) + f(a,c)\]
 --    \[f (a, k c) = k f(a, c)\]
 -- <https://en.wikipedia.org/wiki/Bilinear_map>
 bilinearImpl :: (VectorSpace (g c), VectorSpace (f c), Scalar (g c) ~ c,
  Indexable f c, Indexable g c, Integral c, VectorSpace ((f :*: g) c))
   => (f c -> f c -> g c) -> f c -> f c -> (f :*: g) c
 bilinearImpl :: forall (g :: * -> *) c (f :: * -> *).
(VectorSpace (g c), VectorSpace (f c), Scalar (g c) ~ c,
 Indexable f c, Indexable g c, Integral c,
 VectorSpace ((:*:) f g c)) =>
(f c -> f c -> g c) -> f c -> f c -> (:*:) f g c
bilinearImpl f c -> f c -> g c
f f c
a f c
b = f c -> f c -> (:*:) f g c
asplit f c
a f c
b (:*:) f g c -> (:*:) f g c -> (:*:) f g c
forall v. VectorSpace v => v -> v -> v
%+ f c -> f c -> (:*:) f g c
bsplit f c
a f c
b
   where asplit :: f c -> f c -> (:*:) f g c
asplit f c
a' f c
b' = f (g c) -> (:*:) f g c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g c) -> (:*:) f g c) -> f (g c) -> (:*:) f g c
forall a b. (a -> b) -> a -> b
$ (Index f c -> g c) -> f (Index f c) -> f (g c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Index f c
p -> Index f c
p Index f c -> f c -> c
forall (m :: * -> *) a. Indexable m a => Index m a -> m a -> a
`indexProject` f c
a' Scalar (g c) -> g c -> g c
forall v. VectorSpace v => Scalar v -> v -> v
%* f c -> f c -> g c
f (Index f c -> c -> f c -> f c
forall (m :: * -> *) a.
Indexable m a =>
Index m a -> a -> m a -> m a
basisVector Index f c
p c
1 f c
forall v. VectorSpace v => v
vzero) f c
b') f (Index f c)
forall (m :: * -> *) a. Indexable m a => m (Index m a)
diagonalProjections
         bsplit :: f c -> f c -> (:*:) f g c
bsplit f c
a' f c
b' = f (g c) -> (:*:) f g c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g c) -> (:*:) f g c) -> f (g c) -> (:*:) f g c
forall a b. (a -> b) -> a -> b
$ (Index f c -> g c) -> f (Index f c) -> f (g c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Index f c
q -> Index f c
q Index f c -> f c -> c
forall (m :: * -> *) a. Indexable m a => Index m a -> m a -> a
`indexProject` f c
b' Scalar (g c) -> g c -> g c
forall v. VectorSpace v => Scalar v -> v -> v
%* f c -> f c -> g c
f f c
a' (Index f c -> c -> f c -> f c
forall (m :: * -> *) a.
Indexable m a =>
Index m a -> a -> m a -> m a
basisVector Index f c
q c
1 f c
forall v. VectorSpace v => v
vzero)) f (Index f c)
forall (m :: * -> *) a. Indexable m a => m (Index m a)
diagonalProjections



  -- bilinear :: (a -> b -> c) -> (f a :-> g a, f a :-> g a) -> f a :-> g a
  -- bilinear f (x,y) = linear $ bilinear_impl f (fromLinear x) (fromLinear y)

 applicativeMatrix :: (Applicative f, Functor m, Functor n)
                   => f (a -> b -> c)
                   -> (m :*: f) a -> (n :*: f) b
                   -> (m :*: n) (f c)
 applicativeMatrix :: forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a b c.
(Applicative f, Functor m, Functor n) =>
f (a -> b -> c) -> (:*:) m f a -> (:*:) n f b -> (:*:) m n (f c)
applicativeMatrix f (a -> b -> c)
f (Matrix m (f a)
x) (Matrix n (f b)
y) = (f a -> f b -> f c) -> m (f a) -> n (f b) -> (:*:) m n (f c)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix (\f a
a f b
b -> f (a -> b -> c)
f f (a -> b -> c) -> f a -> f (b -> c)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
a f (b -> c) -> f b -> f c
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
b) m (f a)
x n (f b)
y

 (>*<) :: (Applicative f, Functor m, Functor n)
                   => f (a -> b -> c) -> ((m :*: f) a, (n :*: f) b)
                   -> (m :*: n) (f c)
 f (a -> b -> c)
f >*< :: forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a b c.
(Applicative f, Functor m, Functor n) =>
f (a -> b -> c) -> ((:*:) m f a, (:*:) n f b) -> (:*:) m n (f c)
>*< ((:*:) m f a
x,(:*:) n f b
y) = f (a -> b -> c) -> (:*:) m f a -> (:*:) n f b -> (:*:) m n (f c)
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a b c.
(Applicative f, Functor m, Functor n) =>
f (a -> b -> c) -> (:*:) m f a -> (:*:) n f b -> (:*:) m n (f c)
applicativeMatrix f (a -> b -> c)
f (:*:) m f a
x (:*:) n f b
y

 -- | <https://en.wikipedia.org/wiki/Matrix_%28mathematics%29>
 class (Num (Scalar v)) => VectorSpace v where
   type Scalar v
   vzero :: v
   vnegate :: v -> v
   (%+)  :: v -> v -> v -- sum
   (%*)  :: Scalar v -> v -> v -- scalar product

 type NumIdentities a = (AdditiveIdentity a, MultiplicativeIdentity a)
 type Numeric a = (Num a, NumIdentities a)
 type NumFractional a = (Fractional a, NumIdentities a)
 type NumFloating a = (Floating a, NumIdentities a)
 type VectorSpaceOver v a = (VectorSpace v, Scalar v ~ a)
 type PrimitiveSpace v = (v ~ Scalar v, VectorSpace v)
 type ComplexVectorSpace v a = VectorSpaceOver v (Complex a)
 type Linear a b = (VectorSpace a, VectorSpace b, Scalar a ~ Scalar b)
 type LinearInnerProductSpace a b = (Linear a b, InnerProductSpace a, InnerProductSpace b)

 type SupportsMatrixMultiplication f g h a = (InnerProductSpaceFunctor g a, ConjugateSymmetric a,
                                              Transposable g h a, Functor f, Num a)

 type LinearIso f g a = (LinearTransform f g a, LinearTransform g f a)

 class (VectorSpace v) => BilinearVectorSpace v where
    biLin :: v -> v -> Scalar v

 -- | <https://en.wikipedia.org/wiki/Dot_product>
 -- | <https://en.wikipedia.org/wiki/Outer_product>
 class (VectorSpace m) => InnerProductSpace m where
   (%.) :: m -> m -> Scalar m
   areOrthogonal :: (Eq (Scalar m)) => m -> m -> Bool
   areOrthogonal m
a m
b = m
a m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
b Scalar m -> Scalar m -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar m
0
   canonicalNorm :: (Floating (Scalar m)) => m -> Scalar m
   canonicalNorm m
x = Scalar m -> Scalar m
forall a. Floating a => a -> a
sqrt(m
x m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
x)

 class (InnerProductSpace (f a), a ~ Scalar (f a))
  => InnerProductSpaceFunctor f a where
   innerProductF :: f a -> f a -> a
 
   default innerProductF :: (Scalar (f a) ~ a) => f a -> f a -> a
   innerProductF = f a -> f a -> a
f a -> f a -> Scalar (f a)
forall m. InnerProductSpace m => m -> m -> Scalar m
(%.)

 outer :: (InnerProductSpace m, Scalar m ~ Scalar v, VectorSpace v)
  => m -> v -> (m -> v)
 outer :: forall m v.
(InnerProductSpace m, Scalar m ~ Scalar v, VectorSpace v) =>
m -> v -> m -> v
outer m
a v
b m
x = (m
a m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
x) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
b


 -- | <https://en.wikipedia.org/wiki/Lie_algebra>
 class (VectorSpace m) => LieAlgebra m where
   (%<>%) ::  m -> m -> m  -- [x,y]

 class MetricSpace s where
    type Distance s
    distance :: s -> s -> Distance s

 class (MetricSpace s, (Floating (Distance s)))
  => DifferentialMetricSpace s where
    convergeTo :: (Monad m) => s -> (s -> m u) -> m u

 metricSpaceDerivative ::
    (DifferentialMetricSpace a, MetricSpace b, Distance a ~ Distance b, Fractional (Distance b), Monad m)
    => (a -> b) -> a -> m (Distance b)
 metricSpaceDerivative :: forall a b (m :: * -> *).
(DifferentialMetricSpace a, MetricSpace b, Distance a ~ Distance b,
 Fractional (Distance b), Monad m) =>
(a -> b) -> a -> m (Distance b)
metricSpaceDerivative a -> b
f a
x = 
   a -> (a -> m (Distance b)) -> m (Distance b)
forall s (m :: * -> *) u.
(DifferentialMetricSpace s, Monad m) =>
s -> (s -> m u) -> m u
forall (m :: * -> *) u. Monad m => a -> (a -> m u) -> m u
convergeTo a
x ((a -> m (Distance b)) -> m (Distance b))
-> (a -> m (Distance b)) -> m (Distance b)
forall a b. (a -> b) -> a -> b
$ \a
x' ->
     Distance b -> m (Distance b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Distance b -> m (Distance b)) -> Distance b -> m (Distance b)
forall a b. (a -> b) -> a -> b
$ b -> b -> Distance b
forall s. MetricSpace s => s -> s -> Distance s
distance (a -> b
f a
x') (a -> b
f a
x) Distance b -> Distance b -> Distance b
forall a. Fractional a => a -> a -> a
/ a -> a -> Distance a
forall s. MetricSpace s => s -> s -> Distance s
distance a
x' a
x


  -- compose_matrix_with :: (Diagonalizable m c, Diagonalizable g b, LinearIso g n b, LinearTransform m f a, LinearTransform m n c, Num c, Scalar c ~ Scalar (f a), Transposable g n b, Diagonalizable n b, Diagonalizable m a, Scalar (n c) ~ Scalar (m (f a))) =>
  --  (f a -> g b -> c) -> m a :-> f a -> g b :-> n b -> m c :-> n c
  -- compose_matrix_with f m1 m2 = linmatrix (bilinear f)
  --   (cells_linear m1, cells_linear $ transpose m2)
  --
  -- lie_compose :: (Indexable m, Indexable n, LinearTransform m g a, Diagonalizable m (g a), Diagonalizable g a, LinearTransform m n (g a), LinearIso n g a, Num (g a), LieAlgebra (g a), Transposable g n a, Diagonalizable n a, Diagonalizable m a, Scalar (n (g a)) ~ Scalar (m (g a)))
  --   => m a :-> g a -> g a :-> n a -> m (g a) :-> n (g a)
  -- lie_compose m1 m2 = linmatrix (bilinear (%<>%)) (cells_linear m1, (cells_linear $ transpose m2))
  

 -- | norm_squared is an optimization that often avoids computing square root
 class (VectorSpace m, Num (Scalar m)) => NormedSpace m where
   norm :: m -> Scalar m
   normSquared :: m -> Scalar m
   normSquared m
x = let x2 :: Scalar m
x2 = m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm m
x in Scalar m
x2Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
*Scalar m
x2
   default norm :: (Floating (Scalar m)) => m -> Scalar m
   norm m
x = Scalar m -> Scalar m
forall a. Floating a => a -> a
sqrt (m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
normSquared m
x)
   {-# MINIMAL norm | normSquared #-}

 -- | This computes norm of each row, then computes the norm of the resulting column vector.
 matrix_norm :: (Functor f, NormedSpace (g a), NormedSpace (f (Scalar (g a))))
   => (f :*: g) a -> Scalar (f (Scalar (g a)))
 matrix_norm :: forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
(Functor f, NormedSpace (g a), NormedSpace (f (Scalar (g a)))) =>
(:*:) f g a -> Scalar (f (Scalar (g a)))
matrix_norm = f (Scalar (g a)) -> Scalar (f (Scalar (g a)))
forall m. NormedSpace m => m -> Scalar m
norm (f (Scalar (g a)) -> Scalar (f (Scalar (g a))))
-> ((:*:) f g a -> f (Scalar (g a)))
-> (:*:) f g a
-> Scalar (f (Scalar (g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (g a -> Scalar (g a)) -> f (g a) -> f (Scalar (g a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> Scalar (g a)
forall m. NormedSpace m => m -> Scalar m
norm (f (g a) -> f (Scalar (g a)))
-> ((:*:) f g a -> f (g a)) -> (:*:) f g a -> f (Scalar (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) f g a -> f (g a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells

 normedSpaceDerivate :: (NormedSpace t, VectorSpace v,
  Fractional (Scalar v), Scalar t ~ Scalar v)
    => (t -> v) -> (t, t) -> v
 normedSpaceDerivate :: forall t v.
(NormedSpace t, VectorSpace v, Fractional (Scalar v),
 Scalar t ~ Scalar v) =>
(t -> v) -> (t, t) -> v
normedSpaceDerivate t -> v
f (t
x, t
dx) = (Scalar v -> Scalar v
forall a. Fractional a => a -> a
recip (t -> Scalar t
forall m. NormedSpace m => m -> Scalar m
norm t
dx)) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* (t -> v
f (t
x t -> t -> t
forall v. VectorSpace v => v -> v -> v
%+ t
dx) v -> v -> v
forall v. VectorSpace v => v -> v -> v
%- t -> v
f t
x)


 class CompleteSpace m where

 class ConjugateSymmetric m where
   conj :: m -> m

 class (Scalar (m a) ~ Scalar (n a), Functor m, Functor n) => LinearTransform m n a where
   (<*>>) :: n a -> (m :*: n) a -> m a -- ^ vector times matrix
   (<<*>) :: (m :*: n) a -> m a -> n a -- ^ matrix times vector


 data Lin b c where
   Lin :: (f :*: g) a -> Lin (f a) (g a)

 class (Functor m, Functor n) => Transposable m n a where
   transposeImpl :: (m :*: n) a -> (n :*: m) a

 instance Transposable ((->) row) ((->) col) a where
   transposeImpl :: (:*:) ((->) row) ((->) col) a -> (:*:) ((->) col) ((->) row) a
transposeImpl (Matrix row -> (col -> a)
f) = (col -> (row -> a)) -> (:*:) ((->) col) ((->) row) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((col -> (row -> a)) -> (:*:) ((->) col) ((->) row) a)
-> (col -> (row -> a)) -> (:*:) ((->) col) ((->) row) a
forall a b. (a -> b) -> a -> b
$ \col
a row
b -> row -> (col -> a)
f row
b col
a

 instance (Transposable f h (g (k a)), Transposable g h (k a),
           Transposable g k a, Transposable f k (g a),
           Scalar ((f :*: g) a) ~ Scalar ((h :*: k) a))
  => Transposable (f :*: g) (h :*: k) a where
   transposeImpl :: (:*:) (f :*: g) (h :*: k) a -> (:*:) (h :*: k) (f :*: g) a
transposeImpl = (:*:) h k ((:*:) f g a) -> (:*:) (h :*: k) (f :*: g) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((:*:) h k ((:*:) f g a) -> (:*:) (h :*: k) (f :*: g) a)
-> ((:*:) (f :*: g) (h :*: k) a -> (:*:) h k ((:*:) f g a))
-> (:*:) (f :*: g) (h :*: k) a
-> (:*:) (h :*: k) (f :*: g) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. h (k ((:*:) f g a)) -> (:*:) h k ((:*:) f g a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix
                  (h (k ((:*:) f g a)) -> (:*:) h k ((:*:) f g a))
-> ((:*:) (f :*: g) (h :*: k) a -> h (k ((:*:) f g a)))
-> (:*:) (f :*: g) (h :*: k) a
-> (:*:) h k ((:*:) f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (k (f (g a)) -> k ((:*:) f g a))
-> h (k (f (g a))) -> h (k ((:*:) f g a))
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (g a) -> (:*:) f g a) -> k (f (g a)) -> k ((:*:) f g a)
forall a b. (a -> b) -> k a -> k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g a) -> (:*:) f g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix)
                  (h (k (f (g a))) -> h (k ((:*:) f g a)))
-> ((:*:) (f :*: g) (h :*: k) a -> h (k (f (g a))))
-> (:*:) (f :*: g) (h :*: k) a
-> h (k ((:*:) f g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (k (g a)) -> k (f (g a))) -> h (f (k (g a))) -> h (k (f (g a)))
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (k (g a)) -> k (f (g a))
forall (g' :: * -> *) (f' :: * -> *) a'.
Transposable g' f' a' =>
g' (f' a') -> f' (g' a')
trans
                  (h (f (k (g a))) -> h (k (f (g a))))
-> ((:*:) (f :*: g) (h :*: k) a -> h (f (k (g a))))
-> (:*:) (f :*: g) (h :*: k) a
-> h (k (f (g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (g (k a)) -> f (k (g a))) -> h (f (g (k a))) -> h (f (k (g a)))
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g (k a) -> k (g a)) -> f (g (k a)) -> f (k (g a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (k a) -> k (g a)
forall (g' :: * -> *) (f' :: * -> *) a'.
Transposable g' f' a' =>
g' (f' a') -> f' (g' a')
trans)
                  (h (f (g (k a))) -> h (f (k (g a))))
-> ((:*:) (f :*: g) (h :*: k) a -> h (f (g (k a))))
-> (:*:) (f :*: g) (h :*: k) a
-> h (f (k (g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (h (g (k a))) -> h (f (g (k a)))
forall (g' :: * -> *) (f' :: * -> *) a'.
Transposable g' f' a' =>
g' (f' a') -> f' (g' a')
trans
                  (f (h (g (k a))) -> h (f (g (k a))))
-> ((:*:) (f :*: g) (h :*: k) a -> f (h (g (k a))))
-> (:*:) (f :*: g) (h :*: k) a
-> h (f (g (k a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (g (h (k a)) -> h (g (k a))) -> f (g (h (k a))) -> f (h (g (k a)))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (h (k a)) -> h (g (k a))
forall (g' :: * -> *) (f' :: * -> *) a'.
Transposable g' f' a' =>
g' (f' a') -> f' (g' a')
trans
                  (f (g (h (k a))) -> f (h (g (k a))))
-> ((:*:) (f :*: g) (h :*: k) a -> f (g (h (k a))))
-> (:*:) (f :*: g) (h :*: k) a
-> f (h (g (k a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) f g (h (k a)) -> f (g (h (k a)))
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f g (h (k a)) -> f (g (h (k a))))
-> ((:*:) (f :*: g) (h :*: k) a -> (:*:) f g (h (k a)))
-> (:*:) (f :*: g) (h :*: k) a
-> f (g (h (k a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((:*:) h k a -> h (k a))
-> (:*:) f g ((:*:) h k a) -> (:*:) f g (h (k a))
forall a b. (a -> b) -> (:*:) f g a -> (:*:) f g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:*:) h k a -> h (k a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f g ((:*:) h k a) -> (:*:) f g (h (k a)))
-> ((:*:) (f :*: g) (h :*: k) a -> (:*:) f g ((:*:) h k a))
-> (:*:) (f :*: g) (h :*: k) a
-> (:*:) f g (h (k a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) (f :*: g) (h :*: k) a -> (:*:) f g ((:*:) h k a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells
    where trans :: Transposable g' f' a' => g' (f' a') -> f' (g' a')
          trans :: forall (g' :: * -> *) (f' :: * -> *) a'.
Transposable g' f' a' =>
g' (f' a') -> f' (g' a')
trans = (:*:) f' g' a' -> f' (g' a')
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f' g' a' -> f' (g' a'))
-> (g' (f' a') -> (:*:) f' g' a') -> g' (f' a') -> f' (g' a')
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) g' f' a' -> (:*:) f' g' a'
forall (m :: * -> *) (n :: * -> *) a.
Transposable m n a =>
(:*:) m n a -> (:*:) n m a
transposeImpl ((:*:) g' f' a' -> (:*:) f' g' a')
-> (g' (f' a') -> (:*:) g' f' a') -> g' (f' a') -> (:*:) f' g' a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g' (f' a') -> (:*:) g' f' a'
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix

 -- | Oddly, scalars must match.
 instance (Scalar a ~ Scalar b) => Transposable ((,) a) ((,) b) c where
    transposeImpl :: (:*:) ((,) a) ((,) b) c -> (:*:) ((,) b) ((,) a) c
transposeImpl (Matrix (a
a,(b
b,c
c))) = (b, (a, c)) -> (:*:) ((,) b) ((,) a) c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (b
b,(a
a,c
c))

  -- transpose :: (Diagonalizable n a, LinearTransform n m a, LinearTransform m n a, Diagonalizable m a,Num a, Transposable m n a) => m a :-> n a -> n a :-> m a

 transpose :: (Transposable g f a, Linearizable arr (:*:) f g a, Linearizable arr (:*:) g f a) => arr (g a) (f a) -> arr (f a) (g a)
 transpose :: forall (g :: * -> *) (f :: * -> *) a (arr :: * -> * -> *).
(Transposable g f a, Linearizable arr (:*:) f g a,
 Linearizable arr (:*:) g f a) =>
arr (g a) (f a) -> arr (f a) (g a)
transpose arr (g a) (f a)
x = (:*:) f g a -> arr (f a) (g a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) f g a -> arr (f a) (g a)) -> (:*:) f g a -> arr (f a) (g a)
forall a b. (a -> b) -> a -> b
$ (:*:) g f a -> (:*:) f g a
forall (m :: * -> *) (n :: * -> *) a.
Transposable m n a =>
(:*:) m n a -> (:*:) n m a
transposeImpl ((:*:) g f a -> (:*:) f g a) -> (:*:) g f a -> (:*:) f g a
forall a b. (a -> b) -> a -> b
$ arr (g a) (f a) -> (:*:) g f a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear arr (g a) (f a)
x

 indexableTranspose :: (Functor n, Num a, Indexable m a) => (n :*: m) a -> (m :*: n) a
 indexableTranspose :: forall (n :: * -> *) a (m :: * -> *).
(Functor n, Num a, Indexable m a) =>
(:*:) n m a -> (:*:) m n a
indexableTranspose (Matrix n (m a)
m) = (Index m a -> m a -> a) -> m (Index m a) -> n (m a) -> (:*:) m n a
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix Index m a -> m a -> a
forall (m :: * -> *) a. Index m a -> m a -> a
runIndex m (Index m a)
forall (m :: * -> *) a. Indexable m a => m (Index m a)
diagonalProjections n (m a)
m

 updateColumn :: (Applicative h) => (a -> f b -> g c) -> h a -> (h :*: f) b -> (h :*: g) c
 updateColumn :: forall {k} {k} (h :: * -> *) a (f :: k -> *) (b :: k) (g :: k -> *)
       (c :: k).
Applicative h =>
(a -> f b -> g c) -> h a -> (:*:) h f b -> (:*:) h g c
updateColumn a -> f b -> g c
f h a
col (Matrix h (f b)
m) = h (g c) -> (:*:) h g c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (h (g c) -> (:*:) h g c) -> h (g c) -> (:*:) h g c
forall a b. (a -> b) -> a -> b
$ (a -> f b -> g c) -> h a -> h (f b -> g c)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> f b -> g c
f h a
col h (f b -> g c) -> h (f b) -> h (g c)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> h (f b)
m

 updateRow :: (a -> f (g b) -> f' (g' b')) -> a -> (f :*: g) b -> (f' :*: g') b'
 updateRow :: forall {k} {k} {k} {k} a (f :: k -> *) (g :: k -> k) (b :: k)
       (f' :: k -> *) (g' :: k -> k) (b' :: k).
(a -> f (g b) -> f' (g' b')) -> a -> (:*:) f g b -> (:*:) f' g' b'
updateRow a -> f (g b) -> f' (g' b')
f a
row (Matrix f (g b)
m) = f' (g' b') -> (:*:) f' g' b'
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f' (g' b') -> (:*:) f' g' b') -> f' (g' b') -> (:*:) f' g' b'
forall a b. (a -> b) -> a -> b
$ a -> f (g b) -> f' (g' b')
f a
row f (g b)
m

 -- | Example use:
 -- 
 -- > write_column (Vector3 3 4 5) `ycoord3` identity3 == [[1,3,0],[0,4,0],[0,5,1]]
 -- 
 class UpdateableMatrixDimension f where
   writeRow    :: (Applicative h) => h a -> f ((f :*: h) a -> (f :*: h) a)
   writeColumn :: (Applicative h) => h a -> f ((h :*: f) a -> (h :*: f) a)

 -- | Cramer's rule <https://en.wikipedia.org/wiki/Cramer%27s_rule>.
 -- 
 -- Solves \({\mathbf x}\) from matrix equation \(A{\mathbf x} = {\mathbf b}\), where \(A\) is first parameter and \({\mathbf b}\)
 -- is second parameter. Returns vector \({\mathbf x}\). Satisfies requirements:
 -- 
 -- > a <<*> solve_matrix a b == b
 --
 -- \[{\mathbf x}_i = {{\det(A[A_{ki} := {\mathbf b}_k])} \over {\det(A)}}\]
 solveMatrix :: (Traceable m b, Fractional b, UpdateableMatrixDimension m)
      => (m :*: m) b -> m b -> m b
 solveMatrix :: forall (m :: * -> *) b.
(Traceable m b, Fractional b, UpdateableMatrixDimension m) =>
(:*:) m m b -> m b -> m b
solveMatrix (:*:) m m b
m m b
b = (((:*:) m m b -> (:*:) m m b) -> b)
-> m ((:*:) m m b -> (:*:) m m b) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(:*:) m m b -> (:*:) m m b
f -> b
mdetinverse b -> b -> b
forall a. Num a => a -> a -> a
* (:*:) m m b -> b
forall (m :: * -> *) a. Traceable m a => (:*:) m m a -> a
determinantImpl ((:*:) m m b -> (:*:) m m b
f (:*:) m m b
m)) (m b -> m ((:*:) m m b -> (:*:) m m b)
forall (f :: * -> *) (h :: * -> *) a.
(UpdateableMatrixDimension f, Applicative h) =>
h a -> f ((:*:) h f a -> (:*:) h f a)
forall (h :: * -> *) a.
Applicative h =>
h a -> m ((:*:) h m a -> (:*:) h m a)
writeColumn m b
b)
   where mdetinverse :: b
mdetinverse = b
1 b -> b -> b
forall a. Fractional a => a -> a -> a
/ (:*:) m m b -> b
forall (m :: * -> *) a. Traceable m a => (:*:) m m a -> a
determinantImpl (:*:) m m b
m

 (<!-!>) :: (m a -> a) -> (a -> m a -> m a) -> Index m a
 m a -> a
f <!-!> :: forall (m :: * -> *) a.
(m a -> a) -> (a -> m a -> m a) -> Index m a
<!-!> a -> m a -> m a
finv = (m a -> a) -> (a -> m a -> m a) -> Index m a
forall (m :: * -> *) a.
(m a -> a) -> (a -> m a -> m a) -> Index m a
MakeIndex m a -> a
f a -> m a -> m a
finv

 runIndex :: Index m a -> m a -> a
 runIndex :: forall (m :: * -> *) a. Index m a -> m a -> a
runIndex (MakeIndex m a -> a
f a -> m a -> m a
_) m a
x = m a -> a
f m a
x

 appIndex :: (Applicative f) => f (Index m a) -> f (m a) -> f a
 appIndex :: forall (f :: * -> *) (m :: * -> *) a.
Applicative f =>
f (Index m a) -> f (m a) -> f a
appIndex = (Index m a -> m a -> a) -> f (Index m a) -> f (m a) -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Index m a -> m a -> a
forall (m :: * -> *) a. Index m a -> m a -> a
scalarProjection

 data Index m a = MakeIndex {
    forall (m :: * -> *) a. Index m a -> m a -> a
scalarProjection :: m a -> a,
    forall (m :: * -> *) a. Index m a -> a -> m a -> m a
modifyVector :: a -> m a -> m a -- element to insert, vector to use to fill rest of dimensions
  }

 class (Applicative m) => Indexable m a where
   {-# MINIMAL diagonalProjections, indexableIndices #-}
   diagonalProjections :: m (Index m a)
   basisVector :: Index m a -> a -> m a -> m a
   indexProject :: Index m a -> m a -> a
   indexableIndices :: (Integral a) => m a
   basisVector = Index m a -> a -> m a -> m a
forall (m :: * -> *) a. Index m a -> a -> m a -> m a
modifyVector
   indexProject = Index m a -> m a -> a
forall (m :: * -> *) a. Index m a -> m a -> a
scalarProjection

 class AdditiveIdentity a where
   additiveIdentity :: a
 
 class MultiplicativeIdentity a where
   multiplicativeIdentity :: a

 -- | <https://en.wikipedia.org/wiki/Square_matrix>
 class (Indexable m a, Transposable m m a) => Diagonalizable m a where
   identity :: (Num a) => (m :*: m) a
   diagonalImpl :: (m :*: m) a -> m a
   diagonalMatrixImpl :: m a -> (m :*: m) a -> (m :*: m) a

 basis :: (Num a, Diagonalizable m a) => m (m a)
 basis :: forall a (m :: * -> *). (Num a, Diagonalizable m a) => m (m a)
basis = (:*:) m m a -> m (m a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells (:*:) m m a
forall (m :: * -> *) a. (Diagonalizable m a, Num a) => (:*:) m m a
identity

 coefficients :: (Foldable m, Applicative m, VectorSpace v) => m (Scalar v) -> m v -> v
 coefficients :: forall (m :: * -> *) v.
(Foldable m, Applicative m, VectorSpace v) =>
m (Scalar v) -> m v -> v
coefficients m (Scalar v)
coeff = m v -> v
forall (t :: * -> *) a. (Foldable t, VectorSpace a) => t a -> a
vsum (m v -> v) -> (m v -> m v) -> m v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Scalar v -> v -> v) -> m (Scalar v) -> m v -> m v
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
(%*) m (Scalar v)
coeff

  -- bilinear_map :: (Foldable m, VectorSpace a, Diagonalizable m b, Diagonalizable m c)
  --   => (m b -> m c -> a) -> m (Scalar a) -> m (Scalar a) -> a

 bilinearMap :: (Num c, Num b, VectorSpace a, Foldable m, Foldable n, Diagonalizable m b, Diagonalizable n c)
   => (m b -> n c -> a) -> m (Scalar a) -> n (Scalar a) -> a
 bilinearMap :: forall c b a (m :: * -> *) (n :: * -> *).
(Num c, Num b, VectorSpace a, Foldable m, Foldable n,
 Diagonalizable m b, Diagonalizable n c) =>
(m b -> n c -> a) -> m (Scalar a) -> n (Scalar a) -> a
bilinearMap m b -> n c -> a
f m (Scalar a)
x n (Scalar a)
y = m (Scalar a) -> m a -> a
forall (m :: * -> *) v.
(Foldable m, Applicative m, VectorSpace v) =>
m (Scalar v) -> m v -> v
coefficients m (Scalar a)
x (m a -> a) -> m a -> a
forall a b. (a -> b) -> a -> b
$ (n a -> a) -> m (n a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (n (Scalar a) -> n a -> a
forall (m :: * -> *) v.
(Foldable m, Applicative m, VectorSpace v) =>
m (Scalar v) -> m v -> v
coefficients n (Scalar a)
y) (m (n a) -> m a) -> m (n a) -> m a
forall a b. (a -> b) -> a -> b
$ (:*:) m n a -> m (n a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) m n a -> m (n a)) -> (:*:) m n a -> m (n a)
forall a b. (a -> b) -> a -> b
$ (m b -> n c -> a) -> m (m b) -> n (n c) -> (:*:) m n a
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix m b -> n c -> a
f m (m b)
forall a (m :: * -> *). (Num a, Diagonalizable m a) => m (m a)
basis n (n c)
forall a (m :: * -> *). (Num a, Diagonalizable m a) => m (m a)
basis

 -- | <https://en.wikipedia.org/wiki/Linear_map#Matrices>
 linearMap_ :: (Num a, Foldable m, Diagonalizable m a, VectorSpace b) => (m a -> b) -> m (Scalar b) -> b
 linearMap_ :: forall a (m :: * -> *) b.
(Num a, Foldable m, Diagonalizable m a, VectorSpace b) =>
(m a -> b) -> m (Scalar b) -> b
linearMap_ m a -> b
f m (Scalar b)
x = m (Scalar b) -> m b -> b
forall (m :: * -> *) v.
(Foldable m, Applicative m, VectorSpace v) =>
m (Scalar v) -> m v -> v
coefficients m (Scalar b)
x (m b -> b) -> m b -> b
forall a b. (a -> b) -> a -> b
$ (m a -> b) -> m (m a) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> b
f m (m a)
forall a (m :: * -> *). (Num a, Diagonalizable m a) => m (m a)
basis

 linearMap' :: (Num a,b ~ Scalar (n b), Foldable m, Diagonalizable m a, VectorSpace (n b))
   => (m a -> n b) -> m b -> n b
 linearMap' :: forall a b (n :: * -> *) (m :: * -> *).
(Num a, b ~ Scalar (n b), Foldable m, Diagonalizable m a,
 VectorSpace (n b)) =>
(m a -> n b) -> m b -> n b
linearMap' = (m a -> n b) -> m b -> n b
(m a -> n b) -> m (Scalar (n b)) -> n b
forall a (m :: * -> *) b.
(Num a, Foldable m, Diagonalizable m a, VectorSpace b) =>
(m a -> b) -> m (Scalar b) -> b
linearMap_




  -- linear_id = linear_map id


 linearIdentity :: (Linearizable arr (:*:) m m a, LinearTransform m m a, Diagonalizable m a, Num a) => arr (m a) (m a)
 linearIdentity :: forall (arr :: * -> * -> *) (m :: * -> *) a.
(Linearizable arr (:*:) m m a, LinearTransform m m a,
 Diagonalizable m a, Num a) =>
arr (m a) (m a)
linearIdentity = (:*:) m m a -> arr (m a) (m a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear (:*:) m m a
forall (m :: * -> *) a. (Diagonalizable m a, Num a) => (:*:) m m a
identity

  -- diagonal :: (LinearTransform m m a, Diagonalizable m a) => m a :-> m a -> m a

 diagonal :: (Linearizable arr (:*:) m m a, Diagonalizable m a) => arr (m a) (m a) -> m a
 diagonal :: forall (arr :: * -> * -> *) (m :: * -> *) a.
(Linearizable arr (:*:) m m a, Diagonalizable m a) =>
arr (m a) (m a) -> m a
diagonal = (:*:) m m a -> m a
forall (m :: * -> *) a. Diagonalizable m a => (:*:) m m a -> m a
diagonalImpl ((:*:) m m a -> m a)
-> (arr (m a) (m a) -> (:*:) m m a) -> arr (m a) (m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear

 class (Functor m, Functor n) => ProjectionSpace (m :: Type -> Type) (n :: Type -> Type) where
    data (m \\\ n) a
    projectFirst   :: m a -> n a
    projectSecond  :: m a -> (m \\\ n) a
    joinVector :: n a -> (m \\\ n) a -> m a

 -- | CodiagonalMatrix represents a matrix that can be split along the diagonal.
 -- The Codiagonal type represents a matrix without its diagonal.
 -- The ProjectionVector type represents a vector down from first element of diagonal
 -- when the diagonal is removed. This vector often has less elements than the original vector.
 -- Similarly for vector right from the first element of diagonal.
 class CodiagonalMatrix m a where
    data Codiagonal m a
    type (m \\ a)
    codiagonalImpl :: (m :*: m) a -> Codiagonal m a
    (|\|) :: m a -> Codiagonal m a -> (m :*: m) a
    downProject  :: Codiagonal m a -> m \\ a
    rightProject :: Codiagonal m a -> m \\ a

  -- codiagonal :: (Num a, Diagonalizable m a, LinearTransform m m a, CodiagonalMatrix m a) => m a :-> m a -> Codiagonal m a
  -- codiagonal = codiagonal_impl . fromLinear

 -- | NOTICE: Linearizable instances for matrices that have similar dimensions are special.
 class (Category arr) => Linearizable arr prod f g a | arr -> prod where
    fromLinear :: arr (f a) (g a) -> (prod f g) a
    linear :: (prod f g) a -> arr (f a) (g a)

 -- | <https://ncatlab.org/nlab/show/dimension>
 class (Diagonalizable m a) => Traceable m a where
   traceImpl :: (m :*: m) a -> a
   determinantImpl :: (m :*: m) a -> a
   vectorDimension :: m a -> a
   default vectorDimension :: (Num a) => m a -> a
   vectorDimension (m a
f :: m a) = (:*:) m m a -> a
forall (m :: * -> *) a. Traceable m a => (:*:) m m a -> a
traceImpl ((:*:) m m a
forall (m :: * -> *) a. (Diagonalizable m a, Num a) => (:*:) m m a
identity :: (m :*: m) a)

 class (Category arr,Traceable m a) => LinearTraceable arr m a | m a -> arr where
   determinant :: arr (m a) (m a) -> a
   trace       :: arr (m a) (m a) -> a
   default determinant :: (Linearizable arr (:*:) m m a) => arr (m a) (m a) -> a
   default trace :: (Linearizable arr (:*:) m m a) => arr (m a) (m a) -> a
   determinant = (:*:) m m a -> a
forall (m :: * -> *) a. Traceable m a => (:*:) m m a -> a
determinantImpl ((:*:) m m a -> a)
-> (arr (m a) (m a) -> (:*:) m m a) -> arr (m a) (m a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear
   trace = (:*:) m m a -> a
forall (m :: * -> *) a. Traceable m a => (:*:) m m a -> a
traceImpl ((:*:) m m a -> a)
-> (arr (m a) (m a) -> (:*:) m m a) -> arr (m a) (m a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear

 -- | <http://en.wikipedia.org/wiki/Adjugate>
 -- \({\mathsf{cofactor}}(A) = |A|(A^{-1})^{\top}\) <https://en.wikipedia.org/wiki/Cross_product>
 class (Traceable m a) => Invertible m a where
    cofactorImpl :: (m :*: m) a -> (m :*: m) a
    adjucateImpl :: (m :*: m) a -> (m :*: m) a
    inverseImpl  :: (m :*: m) a -> (m :*: m) a

 class (LinearTraceable arr m a) => LinearInvertible arr m a where
    cofactor :: arr (m a) (m a) -> arr (m a) (m a)
    adjucate :: arr (m a) (m a) -> arr (m a) (m a)
    inverse  :: arr (m a) (m a) -> arr (m a) (m a)
    default cofactor :: (Invertible m a, Linearizable arr (:*:) m m a) => arr (m a) (m a) -> arr (m a) (m a)
    default adjucate :: (Invertible m a, Linearizable arr (:*:) m m a) => arr (m a) (m a) -> arr (m a) (m a)
    default inverse :: (Invertible m a, Linearizable arr (:*:) m m a) => arr (m a) (m a) -> arr (m a) (m a)
    cofactor = (:*:) m m a -> arr (m a) (m a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) m m a -> arr (m a) (m a))
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> arr (m a) (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) m m a -> (:*:) m m a
forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
cofactorImpl ((:*:) m m a -> (:*:) m m a)
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> (:*:) m m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear
    adjucate = (:*:) m m a -> arr (m a) (m a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) m m a -> arr (m a) (m a))
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> arr (m a) (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) m m a -> (:*:) m m a
forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
adjucateImpl ((:*:) m m a -> (:*:) m m a)
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> (:*:) m m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear
    inverse  = (:*:) m m a -> arr (m a) (m a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) m m a -> arr (m a) (m a))
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> arr (m a) (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) m m a -> (:*:) m m a
forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
inverseImpl ((:*:) m m a -> (:*:) m m a)
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> (:*:) m m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear

 -- | this computes \[f(A) = (A^{-1})^{\top}\]
 -- it's used to compute dual basis for a set of basis vectors.
 dualBasisImpl :: (Invertible m a) => (m :*: m) a -> (m :*: m) a
 dualBasisImpl :: forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
dualBasisImpl (:*:) m m a
a = (:*:) m m a -> (:*:) m m a
forall (m :: * -> *) (n :: * -> *) a.
Transposable m n a =>
(:*:) m n a -> (:*:) n m a
transposeImpl ((:*:) m m a -> (:*:) m m a
forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
inverseImpl (:*:) m m a
a)
 
 dualBasis :: (Invertible m a, Linearizable arr (:*:) m m a)
  => arr (m a) (m a) -> arr (m a) (m a)
 dualBasis :: forall (m :: * -> *) a (arr :: * -> * -> *).
(Invertible m a, Linearizable arr (:*:) m m a) =>
arr (m a) (m a) -> arr (m a) (m a)
dualBasis = (:*:) m m a -> arr (m a) (m a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear ((:*:) m m a -> arr (m a) (m a))
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> arr (m a) (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) m m a -> (:*:) m m a
forall (m :: * -> *) a.
Invertible m a =>
(:*:) m m a -> (:*:) m m a
dualBasisImpl ((:*:) m m a -> (:*:) m m a)
-> (arr (m a) (m a) -> (:*:) m m a)
-> arr (m a) (m a)
-> (:*:) m m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (m a) (m a) -> (:*:) m m a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear

  -- is_unitary :: (Invertible m a, Eq (LinearMap (m a) (m a)),
  --               ConjugateSymmetric (LinearMap (m a) (m a)))
  --   => m a :-> m a -> Bool
  -- is_unitary m = conj -!< m == inverse m

 class (Functor m) => EigenDecomposable m a where
   eigenvalues :: (m :*: m) a -> m a

 class (EigenDecomposable m a) => EigenVectorable m a where
   eigenvectors :: (m :*: m) a -> (m :*: m) a

 class (Applicative m, Applicative n) => AppendableVector m n where
   type (m :+: n) :: Type -> Type
   (||>>) :: m a -> n a -> (m :+: n) a

 class (AppendableVector m n) => SplittableVector m n where
   vsplit   :: (m :+: n) a -> (m a, n a)

 -- | Iverson bracket: <http://en.wikipedia.org/wiki/Iverson_bracket>

 class Conditional a where
   fromBoolean :: Bool -> a

 class StandardBasis m where
   unitVectors :: [m]

 class (VectorSpace v) => CoordinateSpace v where
   type Coordinate v 
   index  :: Coordinate v -> v -> Scalar v
   listVector :: [Scalar v] -> v  -- convert list to vector
   dimensionSize :: v -> Int
   coordinates :: v -> [Coordinate v]

 -- | vector space with scalars in Num class
 class (Num (Scalar v), VectorSpace v) => NumSpace v 

 -- | vector space with fractional scalars
 class (Fractional (Scalar v), NumSpace v) => FractionalSpace v 


 -- | <https://en.wikipedia.org/wiki/Dual_space#Injection_into_the_double-dual>
 class (VectorSpace v) => FiniteDimensional v d i arr where
    finite :: arr ((d :*: d) v) (i v)

 class HasIdentityLinear v arr where
    matIdentity :: (Ord a, Num a, ConjugateSymmetric a) => arr (v a) (v a)

 class (VectorSpace v) => Dualizable v d where
   covector :: (v -> Scalar v) -> d v
   bracket :: d v -> v -> Scalar v

 -- | <https://en.wikipedia.org/wiki/Laplace_operator>
 --   <https://en.wikipedia.org/wiki/Divergence>
 --   <https://en.wikipedia.org/wiki/Gradient>
 --   <https://en.wikipedia.org/wiki/Directional_derivative>
 -- Notice: for directional derivative,
 -- the direction is not automatically normalized, since that needs NormedSpace
 class (VectorSpace v) => VectorDerivative v d arr | d -> arr, v arr -> d where
   divergence :: arr v v -> d v  -- (Del %. f)(v)
   grad       :: d v -> arr v v    -- (Del f)(v)
   directionalDerivative :: v -> d v -> d v -- (v %. Del f)(x)
   laplace    :: d v -> d v    -- (Del^2 f)(v)
   laplace = arr v v -> d v
forall v (d :: * -> *) (arr :: * -> * -> *).
VectorDerivative v d arr =>
arr v v -> d v
divergence (arr v v -> d v) -> (d v -> arr v v) -> d v -> d v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. d v -> arr v v
forall v (d :: * -> *) (arr :: * -> * -> *).
VectorDerivative v d arr =>
d v -> arr v v
grad
   {-# MINIMAL divergence, grad, directionalDerivative #-}

 -- | version of directional derivative that normalizes the direction:
 -- <https://mathworld.wolfram.com/DirectionalDerivative.html>
 normalizedDirectionalDerivative :: (VectorDerivative v d arr, NormedSpace v, Fractional (Scalar v))
    => v -> d v -> d v
 normalizedDirectionalDerivative :: forall v (d :: * -> *) (arr :: * -> * -> *).
(VectorDerivative v d arr, NormedSpace v, Fractional (Scalar v)) =>
v -> d v -> d v
normalizedDirectionalDerivative v
v d v
d =
    v -> d v -> d v
forall v (d :: * -> *) (arr :: * -> * -> *).
VectorDerivative v d arr =>
v -> d v -> d v
directionalDerivative ((Scalar v
1Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/v -> Scalar v
forall m. NormedSpace m => m -> Scalar m
norm v
v) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
v) d v
d

 -- | <https://en.wikipedia.org/wiki/Curl_(mathematics)>
 class VectorCrossProduct v arr where
   curl       :: arr v v -> arr v v  -- (Del * f)(v)
 
 -- | <https://en.wikipedia.org/wiki/Vector_Laplacian>
 class VectorLaplacian v arr where
   vectorLaplace :: arr v v -> arr v v -- (Del^2 A)(v)

  --   default vector_laplace :: (VectorCrossProduct v arr) => arr v v -> arr v v


 class (Functor f) => ProjectionDual f d a where
    projectionDual :: f (d (f a))

 matrixM :: (Traversable f, Traversable g, Monad m) => 
            (a -> b -> m c) -> f a -> g b -> m ((f :*: g) c)
 matrixM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b c.
(Traversable f, Traversable g, Monad m) =>
(a -> b -> m c) -> f a -> g b -> m ((:*:) f g c)
matrixM a -> b -> m c
f f a
row g b
col = do f (g c)
res <- ((a -> m (g c)) -> f a -> m (f (g c)))
-> f a -> (a -> m (g c)) -> m (f (g c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (g c)) -> f a -> m (f (g c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM f a
row ((a -> m (g c)) -> m (f (g c))) -> (a -> m (g c)) -> m (f (g c))
forall a b. (a -> b) -> a -> b
$ \a
a ->
                               ((b -> m c) -> g b -> m (g c)) -> g b -> (b -> m c) -> m (g c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> m c) -> g b -> m (g c)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> g a -> m (g b)
mapM g b
col ((b -> m c) -> m (g c)) -> (b -> m c) -> m (g c)
forall a b. (a -> b) -> a -> b
$ \b
b -> a -> b -> m c
f a
a b
b
                        (:*:) f g c -> m ((:*:) f g c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:*:) f g c -> m ((:*:) f g c)) -> (:*:) f g c -> m ((:*:) f g c)
forall a b. (a -> b) -> a -> b
$ f (g c) -> (:*:) f g c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix f (g c)
res

 matrixMatrix :: (Functor m, Functor n, Functor m', Functor n')
              => (a -> b -> c)
              -> (m :*: m') a
              -> (n :*: n') b
              -> ((m :*: n) :*: (m' :*: n')) c
 matrixMatrix :: forall (m :: * -> *) (n :: * -> *) (m' :: * -> *) (n' :: * -> *) a
       b c.
(Functor m, Functor n, Functor m', Functor n') =>
(a -> b -> c)
-> (:*:) m m' a -> (:*:) n n' b -> (:*:) (m :*: n) (m' :*: n') c
matrixMatrix a -> b -> c
f (Matrix m (m' a)
x) (Matrix n (n' b)
y) = (:*:) m n ((:*:) m' n' c) -> (:*:) (m :*: n) (m' :*: n') c
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((:*:) m n ((:*:) m' n' c) -> (:*:) (m :*: n) (m' :*: n') c)
-> (:*:) m n ((:*:) m' n' c) -> (:*:) (m :*: n) (m' :*: n') c
forall a b. (a -> b) -> a -> b
$ ((m' a -> n' b -> (:*:) m' n' c)
-> m (m' a) -> n (n' b) -> (:*:) m n ((:*:) m' n' c)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix ((m' a -> n' b -> (:*:) m' n' c)
 -> m (m' a) -> n (n' b) -> (:*:) m n ((:*:) m' n' c))
-> ((a -> b -> c) -> m' a -> n' b -> (:*:) m' n' c)
-> (a -> b -> c)
-> m (m' a)
-> n (n' b)
-> (:*:) m n ((:*:) m' n' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b -> c) -> m' a -> n' b -> (:*:) m' n' c
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix) a -> b -> c
f m (m' a)
x n (n' b)
y



  -- eigenvectors_generic :: (a ~ Scalar (n a),
  --                 Fractional a, VectorSpace (n a),EigenDecomposable m a)
  --                => (m :*: m) a -> (n a -> n a) -> (m :*: n) a
  --
  -- eigenvectors_generic :: (Fractional (g a), EigenDecomposable f (g a))
  --    => (f :*: f) (g a) -> (g a -> g a) -> (f :*: g) a
  -- eigenvectors_generic m a = Matrix $ fmap (fix . (a %/)) (eigenvalues m)

 newtype Basis m = Basis [m]

 (%-) :: (VectorSpace v) => v -> v -> v
 v
x %- :: forall v. VectorSpace v => v -> v -> v
%- v
y = v
x v -> v -> v
forall v. VectorSpace v => v -> v -> v
%+ (v -> v
forall v. VectorSpace v => v -> v
vnegate v
y)

 (%/) :: (Fractional (Scalar v),VectorSpace v) => v -> Scalar v -> v
 v
x %/ :: forall v.
(Fractional (Scalar v), VectorSpace v) =>
v -> Scalar v -> v
%/ Scalar v
y = (Scalar v
1 Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ Scalar v
y) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
x

 -- | <https://en.wikipedia.org/wiki/Angle>
 innerproductspaceCosAngle :: (InnerProductSpace m, Floating (Scalar m)) => m -> m -> Scalar m
 innerproductspaceCosAngle :: forall m.
(InnerProductSpace m, Floating (Scalar m)) =>
m -> m -> Scalar m
innerproductspaceCosAngle m
x m
y = (m
x m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
y)
               Scalar m -> Scalar m -> Scalar m
forall a. Fractional a => a -> a -> a
/ (m -> Scalar m
forall m.
(Floating (Scalar m), InnerProductSpace m) =>
m -> Scalar m
innerproductspaceNorm m
x Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
* m -> Scalar m
forall m.
(Floating (Scalar m), InnerProductSpace m) =>
m -> Scalar m
innerproductspaceNorm m
y)

 normedLieAlgebraSinAngle :: (LieAlgebra m, NormedSpace m, Floating (Scalar m)) => m -> m -> Scalar m
 normedLieAlgebraSinAngle :: forall m.
(LieAlgebra m, NormedSpace m, Floating (Scalar m)) =>
m -> m -> Scalar m
normedLieAlgebraSinAngle m
x m
y = m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm (m
x m -> m -> m
forall m. LieAlgebra m => m -> m -> m
%<>% m
y)
               Scalar m -> Scalar m -> Scalar m
forall a. Fractional a => a -> a -> a
/ (m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm m
x Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
* m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm m
y)

 -- | <https://en.wikipedia.org/wiki/Angle>
 angle :: (InnerProductSpace m, Floating (Scalar m)) => m -> m -> Scalar m
 angle :: forall m.
(InnerProductSpace m, Floating (Scalar m)) =>
m -> m -> Scalar m
angle m
x m
y = Scalar m -> Scalar m
forall a. Floating a => a -> a
acos (m -> m -> Scalar m
forall m.
(InnerProductSpace m, Floating (Scalar m)) =>
m -> m -> Scalar m
innerproductspaceCosAngle m
x m
y)

  -- -- | <https://en.wikipedia.org/wiki/Cross_product>
  -- -- This is a skew-symmetric matrix whose application to a vector
  -- -- is same as cross product of a with the vector.
  -- -- @cross_product_matrix v <<*> w == v %<>% w@.
  -- cross_product_matrix :: (Num a, LinearTransform m m a, Traceable m a, LieAlgebra (m a)) => m a -> m a :-> m a
  -- cross_product_matrix a = linear $ Matrix $ fmap (%<>% a) $ cells (identity $ vector_dimension a)

 iVec,jVec,kVec,lVec :: (StandardBasis v) => v
 iVec :: forall v. StandardBasis v => v
iVec = [v]
forall m. StandardBasis m => [m]
unitVectors [v] -> Int -> v
forall a. HasCallStack => [a] -> Int -> a
!! Int
0
 jVec :: forall v. StandardBasis v => v
jVec = [v]
forall m. StandardBasis m => [m]
unitVectors [v] -> Int -> v
forall a. HasCallStack => [a] -> Int -> a
!! Int
1
 kVec :: forall v. StandardBasis v => v
kVec = [v]
forall m. StandardBasis m => [m]
unitVectors [v] -> Int -> v
forall a. HasCallStack => [a] -> Int -> a
!! Int
2
 lVec :: forall v. StandardBasis v => v
lVec = [v]
forall m. StandardBasis m => [m]
unitVectors [v] -> Int -> v
forall a. HasCallStack => [a] -> Int -> a
!! Int
3

 {-# INLINABLE innerproductspaceNorm #-}
 innerproductspaceNorm :: (Floating (Scalar m), InnerProductSpace m)
                        => m -> Scalar m
 innerproductspaceNorm :: forall m.
(Floating (Scalar m), InnerProductSpace m) =>
m -> Scalar m
innerproductspaceNorm m
v = Scalar m -> Scalar m
forall a. Floating a => a -> a
sqrt (m
v m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
v)

 {-# INLINABLE innerproductspaceNormSquared #-}
 innerproductspaceNormSquared :: (Floating (Scalar m), InnerProductSpace m)
          => m -> Scalar m
 innerproductspaceNormSquared :: forall m.
(Floating (Scalar m), InnerProductSpace m) =>
m -> Scalar m
innerproductspaceNormSquared m
v = m
v m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
v

 vsum :: (Foldable t, VectorSpace a) => t a -> a
 vsum :: forall (t :: * -> *) a. (Foldable t, VectorSpace a) => t a -> a
vsum = (a -> a -> a) -> a -> t a -> a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall v. VectorSpace v => v -> v -> v
(%+) a
forall v. VectorSpace v => v
vzero

  -- fold_rows :: (Indexable m, LinearTransform m n a,Diagonalizable m a) => (n a -> b) -> m a :-> n a -> m b
  -- fold_rows f x = fmap f (cells $ fromLinear x)
  --
  -- fold_columns :: (Diagonalizable m a, Diagonalizable n a, LinearTransform m n a, LinearTransform n m a, Transposable m n a) 
  --               => (m a -> b) -> LinearMap (m a) (n a) -> n b
  -- fold_columns f x = fold_rows f (transpose x)

 indexUnit :: (StandardBasis v) => Int -> v
 indexUnit :: forall v. StandardBasis v => Int -> v
indexUnit Int
i = [v]
forall m. StandardBasis m => [m]
unitVectors [v] -> Int -> v
forall a. HasCallStack => [a] -> Int -> a
!! Int
i

 projection :: (Fractional (Scalar v), VectorSpace v, InnerProductSpace v)
            => v -> v -> v
 projection :: forall v.
(Fractional (Scalar v), VectorSpace v, InnerProductSpace v) =>
v -> v -> v
projection v
e v
a = ((v
e v -> v -> Scalar v
forall m. InnerProductSpace m => m -> m -> Scalar m
%. v
a) Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ (v
e v -> v -> Scalar v
forall m. InnerProductSpace m => m -> m -> Scalar m
%. v
e)) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
e

 normalize :: (Fractional (Scalar a), NormedSpace a) => a -> a
 normalize :: forall a. (Fractional (Scalar a), NormedSpace a) => a -> a
normalize a
x = (Scalar a
1 Scalar a -> Scalar a -> Scalar a
forall a. Fractional a => a -> a -> a
/ a -> Scalar a
forall m. NormedSpace m => m -> Scalar m
norm a
x) Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
%* a
x


  -- isEigenValue :: (Num a,Eq a, SquareMatrix m a) => (m :*: m) a -> a -> Bool
  -- isEigenValue m v = determinant (m %- (v %* identity)) == 0


 vectorLength :: (Floating (Scalar m), InnerProductSpace m)
               => m -> Scalar m
 vectorLength :: forall m.
(Floating (Scalar m), InnerProductSpace m) =>
m -> Scalar m
vectorLength m
x = Scalar m -> Scalar m
forall a. Floating a => a -> a
sqrt (m
x m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
x)

 divide :: (Fractional (Scalar v), VectorSpace v) => v -> Scalar v -> v
 divide :: forall v.
(Fractional (Scalar v), VectorSpace v) =>
v -> Scalar v -> v
divide v
v Scalar v
x = (Scalar v
1Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/Scalar v
x) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
v

 vaverage :: (Num v,Fractional (Scalar v),VectorSpace v) => [v] -> v
 vaverage :: forall v. (Num v, Fractional (Scalar v), VectorSpace v) => [v] -> v
vaverage [v]
lst = (Scalar v
1 Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ Int -> Scalar v
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
lst)) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* [v] -> v
forall (t :: * -> *) a. (Foldable t, VectorSpace a) => t a -> a
vsum [v]
lst

 toScalarList :: (StandardBasis m, InnerProductSpace m) => m -> [Scalar m]
 toScalarList :: forall m. (StandardBasis m, InnerProductSpace m) => m -> [Scalar m]
toScalarList m
m = [m
m m -> m -> Scalar m
forall m. InnerProductSpace m => m -> m -> Scalar m
%. m
c | m
c <- [m]
forall m. StandardBasis m => [m]
unitVectors]

 instance (Functor f, PpShowVerticalF f, PpShowF g) => PpShowF (f :*: g) where
 	  ppf :: forall a. PpShow a => (:*:) f g a -> Doc
ppf (Matrix f (g a)
x) = f Doc -> Doc
forall a. PpShow a => f a -> Doc
forall (f :: * -> *) a. (PpShowVerticalF f, PpShow a) => f a -> Doc
ppfVertical (f Doc -> Doc) -> f Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (g a -> Doc) -> f (g a) -> f Doc
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> (g a -> Doc) -> g a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g a -> Doc
forall a. PpShow a => g a -> Doc
forall (f :: * -> *) a. (PpShowF f, PpShow a) => f a -> Doc
ppf) f (g a)
x

 instance (PpShowF g, PpShowVerticalF f, Functor f, PpShow a) => PpShow ((f :*: g) a) where
 	  pp :: (:*:) f g a -> Doc
pp (:*:) f g a
x = (:*:) f g a -> Doc
forall a. PpShow a => (:*:) f g a -> Doc
forall (f :: * -> *) a. (PpShowF f, PpShow a) => f a -> Doc
ppf (:*:) f g a
x

 fromScalarList :: (VectorSpace a, StandardBasis a) => [Scalar a] -> a
 fromScalarList :: forall a. (VectorSpace a, StandardBasis a) => [Scalar a] -> a
fromScalarList [Scalar a]
lst = [a] -> a
forall (t :: * -> *) a. (Foldable t, VectorSpace a) => t a -> a
vsum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Scalar a -> a -> a) -> [Scalar a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
(%*) [Scalar a]
lst [a]
forall m. StandardBasis m => [m]
unitVectors

 toListCS :: (CoordinateSpace v) => v -> [Scalar v]
 toListCS :: forall v. CoordinateSpace v => v -> [Scalar v]
toListCS v
m = [Coordinate v -> v -> Scalar v
forall v. CoordinateSpace v => Coordinate v -> v -> Scalar v
index Coordinate v
i v
m | Coordinate v
i <- v -> [Coordinate v]
forall v. CoordinateSpace v => v -> [Coordinate v]
coordinates v
m]

 toListCS2 :: (CoordinateSpace m, CoordinateSpace (Scalar m)) 
         => m -> [[Scalar (Scalar m)]]
 toListCS2 :: forall m.
(CoordinateSpace m, CoordinateSpace (Scalar m)) =>
m -> [[Scalar (Scalar m)]]
toListCS2 = (Scalar m -> [Scalar (Scalar m)])
-> [Scalar m] -> [[Scalar (Scalar m)]]
forall a b. (a -> b) -> [a] -> [b]
map Scalar m -> [Scalar (Scalar m)]
forall v. CoordinateSpace v => v -> [Scalar v]
toListCS ([Scalar m] -> [[Scalar (Scalar m)]])
-> (m -> [Scalar m]) -> m -> [[Scalar (Scalar m)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m -> [Scalar m]
forall v. CoordinateSpace v => v -> [Scalar v]
toListCS

  -- index2 :: (CoordinateSpace v, CoordinateSpace (Scalar v))
  --        => (Coordinate v,Coordinate (Scalar v)) 
  --        -> v -> Scalar (Scalar v)
  --
  -- index2 (row,col) (C e) = index col (index row e)

 coordinates2 :: (CoordinateSpace m, CoordinateSpace (Scalar m))
          => m -> [[(Coordinate m,Coordinate (Scalar m))]]
 coordinates2 :: forall m.
(CoordinateSpace m, CoordinateSpace (Scalar m)) =>
m -> [[(Coordinate m, Coordinate (Scalar m))]]
coordinates2 m
m = [[(Coordinate m
x,Coordinate (Scalar m)
y) | Coordinate (Scalar m)
y <- Scalar m -> [Coordinate (Scalar m)]
forall v. CoordinateSpace v => v -> [Coordinate v]
coordinates (Coordinate m -> m -> Scalar m
forall v. CoordinateSpace v => Coordinate v -> v -> Scalar v
index Coordinate m
x m
m)] | Coordinate m
x <- m -> [Coordinate m]
forall v. CoordinateSpace v => v -> [Coordinate v]
coordinates m
m]

 basisOf :: (StandardBasis m) => Basis m
 basisOf :: forall m. StandardBasis m => Basis m
basisOf = [m] -> Basis m
forall m. [m] -> Basis m
Basis [m]
forall m. StandardBasis m => [m]
unitVectors

 listMatrix :: (CoordinateSpace n, CoordinateSpace (Scalar n)) 
        => [[Scalar (Scalar n)]] -> n
 listMatrix :: forall n.
(CoordinateSpace n, CoordinateSpace (Scalar n)) =>
[[Scalar (Scalar n)]] -> n
listMatrix [[Scalar (Scalar n)]]
m = [Scalar n] -> n
forall v. CoordinateSpace v => [Scalar v] -> v
listVector ([Scalar n] -> n) -> [Scalar n] -> n
forall a b. (a -> b) -> a -> b
$ ([Scalar (Scalar n)] -> Scalar n)
-> [[Scalar (Scalar n)]] -> [Scalar n]
forall a b. (a -> b) -> [a] -> [b]
map [Scalar (Scalar n)] -> Scalar n
forall v. CoordinateSpace v => [Scalar v] -> v
listVector [[Scalar (Scalar n)]]
m

 -- | generalized implementation of matrix multiplication
 -- see <http://en.wikipedia.org/wiki/Matrix_multiplication>

 {-# INLINABLE (%*%) #-}
 (%*%) :: (SupportsMatrixMultiplication f g h a) => (f :*: g) a -> (g :*: h) a -> (f :*: h) a
 %*% :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
SupportsMatrixMultiplication f g h a =>
(:*:) f g a -> (:*:) g h a -> (:*:) f h a
(%*%) (Matrix f (g a)
m1) (:*:) g h a
m2 = (g a -> g a -> a) -> f (g a) -> h (g a) -> (:*:) f h a
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix g a -> g a -> a
g a -> g a -> Scalar (g a)
forall m. InnerProductSpace m => m -> m -> Scalar m
(%.) f (g a)
m1 ((:*:) h g a -> h (g a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) h g a -> h (g a)) -> (:*:) h g a -> h (g a)
forall a b. (a -> b) -> a -> b
$ (:*:) g h a -> (:*:) h g a
forall (m :: * -> *) (n :: * -> *) a.
Transposable m n a =>
(:*:) m n a -> (:*:) n m a
transposeImpl (:*:) g h a
m2)

 (%**%) :: (SupportsMatrixMultiplication f g h a,
         Linearizable arr (:*:) f h (Scalar (g a)), Linearizable arr (:*:) f g a,
         Linearizable arr (:*:) g h a)
     => arr (f a) (g a) -> arr (g a) (h a)
     -> arr (f (Scalar (g a))) (h (Scalar (g a)))
 %**% :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a
       (arr :: * -> * -> *).
(SupportsMatrixMultiplication f g h a,
 Linearizable arr (:*:) f h (Scalar (g a)),
 Linearizable arr (:*:) f g a, Linearizable arr (:*:) g h a) =>
arr (f a) (g a)
-> arr (g a) (h a) -> arr (f (Scalar (g a))) (h (Scalar (g a)))
(%**%) arr (f a) (g a)
a arr (g a) (h a)
b = (:*:) f h a -> arr (f a) (h a)
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
prod f g a -> arr (f a) (g a)
linear (arr (f a) (g a) -> (:*:) f g a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear arr (f a) (g a)
a (:*:) f g a -> (:*:) g h a -> (:*:) f h a
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
SupportsMatrixMultiplication f g h a =>
(:*:) f g a -> (:*:) g h a -> (:*:) f h a
%*% arr (g a) (h a) -> (:*:) g h a
forall {k} {k} (arr :: k -> k -> *)
       (prod :: (k -> k) -> (k -> k) -> k -> *) (f :: k -> k)
       (g :: k -> k) (a :: k).
Linearizable arr prod f g a =>
arr (f a) (g a) -> prod f g a
fromLinear arr (g a) (h a)
b)

  -- (%*%) :: (SupportsMatrixMultiplication f g h a) => (g a) :-> (h a) -> (h a) :-> (f a) -> (g a) :-> (f a)
  -- m1 %*% m2 = linmatrix (bilinear (%.)) (cells_linear m1, (cells_linear $ transpose m2))

 -- | In this version, we must assume VectorSpaceOver (h a) a constraint,
 -- but the result type is nicer.

  -- (%**%) :: (SupportsMatrixMultiplication f g h a) => g a :-> h a -> h a :-> f a -> g a :-> f a
  -- m1 %**% m2 = linmatrix (bilinear (%.))
  --   (cells_linear m1, (cells_linear $ transpose m2))

 type MatrixNorm arr h m a = (LinearTraceable arr m (Scalar (h a)), 
       InnerProductSpaceFunctor h a, 
       ConjugateSymmetric a, 
       Transposable h m a)

  -- -- | <https://en.wikipedia.org/wiki/Frobenius_inner_product>
  -- frobenius_inner_product :: (Traceable h a,
  --  SupportsMatrixMultiplication m m h a,
  --  Diagonalizable h a, LinearTransform h m a, LinearTransform m h a, Scalar a ~ a, MatrixNorm h m a, a ~ Scalar (h a), ConjugateSymmetric (h a), Scalar (m a) ~ Scalar (m (h a)), Indexable m)
  --  => LinearMap (h a) (m a) -> LinearMap (h a) (m a) -> a
  -- frobenius_inner_product a b = trace (hermitian_conjugate a . b)
  --
  -- hermitian_conjugate :: (Diagonalizable f a, Diagonalizable g a,
  --  LinearTransform f g a, LinearTransform g f a,
  --  Transposable f g a, ConjugateSymmetric a)
  --    => f a :-> g a -> g a :-> f a
  -- hermitian_conjugate f = linear $ fmap conj $ transpose_impl $ fromLinear f
  --
  -- -- | <https://en.wikipedia.org/wiki/Matrix_norm#Frobenius_norm>
  -- frobenius_norm :: (Traceable h a, SupportsMatrixMultiplication m m h a, Diagonalizable h a, LinearIso h m a, Scalar a ~ a, MatrixNorm h m a, ConjugateSymmetric (h a), Floating (Scalar (h a)), a ~ Scalar (h a), Scalar (m a) ~ Scalar (m (h a)), Indexable m)
  --   => LinearMap (h a) (m a) -> Scalar (h a)
  -- frobenius_norm a = sqrt (frobenius_inner_product a a)
  --
  -- linear_power :: (Diagonalizable h (h b), Diagonalizable h b) => h b :-> h b -> Integer -> h b :-> h b
  -- linear_power (LinearMap p f) 0 = LinearMap Refl $ identity_impl (vector_dimension $ cells f)
  -- linear_power f i = f . linear_power f (i-1)

 (%^%) :: (a ~ Scalar (f a), SupportsMatrixMultiplication f f f a, AdditiveIdentity a, MultiplicativeIdentity a, Diagonalizable f (f a), Diagonalizable f a)
  => (f :*: f) a -> Integer -> (f :*: f) a
 (:*:) f f a
x %^% :: forall a (f :: * -> *).
(a ~ Scalar (f a), SupportsMatrixMultiplication f f f a,
 AdditiveIdentity a, MultiplicativeIdentity a,
 Diagonalizable f (f a), Diagonalizable f a) =>
(:*:) f f a -> Integer -> (:*:) f f a
%^% Integer
0 = (:*:) f f a
forall (m :: * -> *) a. (Diagonalizable m a, Num a) => (:*:) m m a
identity
 (:*:) f f a
x %^% Integer
i = (:*:) f f a
x (:*:) f f a -> (:*:) f f a -> (:*:) f f a
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
SupportsMatrixMultiplication f g h a =>
(:*:) f g a -> (:*:) g h a -> (:*:) f h a
%*% ((:*:) f f a
x (:*:) f f a -> Integer -> (:*:) f f a
forall a (f :: * -> *).
(a ~ Scalar (f a), SupportsMatrixMultiplication f f f a,
 AdditiveIdentity a, MultiplicativeIdentity a,
 Diagonalizable f (f a), Diagonalizable f a) =>
(:*:) f f a -> Integer -> (:*:) f f a
%^% (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1))

  -- (%^%) :: (LinearTransform h h b, Scalar b ~ b, Functor h, Diagonalizable h b, Transposable h h b, Indexable h
  --  ,InnerProductSpace (h b), VectorSpaceOver (h b) b, Scalar (h (h b)) ~ b)
  --       => LinearMap (h b) (h b) -> Integer -> LinearMap (h b) (h b)
  -- x %^% 0 = linear_identity (vector_dimension $ diagonal x)
  -- x %^% i = x %*% (x %^% (i-1)) 

 (|><|) :: (Functor m, Functor n, InnerProductSpace a)
        => m a -> n a -> (m :*: n) (Scalar a)
 |><| :: forall (m :: * -> *) (n :: * -> *) a.
(Functor m, Functor n, InnerProductSpace a) =>
m a -> n a -> (:*:) m n (Scalar a)
(|><|) = (a -> a -> Scalar a) -> m a -> n a -> (:*:) m n (Scalar a)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix ((a -> a -> Scalar a) -> m a -> n a -> (:*:) m n (Scalar a))
-> (a -> a -> Scalar a) -> m a -> n a -> (:*:) m n (Scalar a)
forall a b. (a -> b) -> a -> b
$ \a
a a
b -> a
a a -> a -> Scalar a
forall m. InnerProductSpace m => m -> m -> Scalar m
%. a
b

 identityCS :: (CoordinateSpace m, CoordinateSpace (Scalar m),
                Num (Scalar (Scalar m))) 
            => (Int,Int) -> m
 identityCS :: forall m.
(CoordinateSpace m, CoordinateSpace (Scalar m),
 Num (Scalar (Scalar m))) =>
(Int, Int) -> m
identityCS (Int
b,Int
a) = [Scalar m] -> m
forall v. CoordinateSpace v => [Scalar v] -> v
listVector [ [Scalar (Scalar m)] -> Scalar m
forall v. CoordinateSpace v => [Scalar v] -> v
listVector [ if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then Scalar (Scalar m)
1 else Scalar (Scalar m)
0 
                                            | Int
i <- [Int
0..(Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]
                               | Int
j<- [Int
0..(Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]

 (%.%) :: (Num (Scalar m), CoordinateSpace m) => m -> m -> Scalar m
 m
x %.% :: forall m. (Num (Scalar m), CoordinateSpace m) => m -> m -> Scalar m
%.% m
y = [Scalar m] -> Scalar m
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Coordinate m -> m -> Scalar m
forall v. CoordinateSpace v => Coordinate v -> v -> Scalar v
index Coordinate m
i m
x Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
* Coordinate m -> m -> Scalar m
forall v. CoordinateSpace v => Coordinate v -> v -> Scalar v
index Coordinate m
i m
y | Coordinate m
i <- m -> [Coordinate m]
forall v. CoordinateSpace v => v -> [Coordinate v]
coordinates m
x]

 basisCoordinates :: (InnerProductSpace v) => Basis v -> v -> [Scalar v]
 basisCoordinates :: forall v. InnerProductSpace v => Basis v -> v -> [Scalar v]
basisCoordinates (Basis [v]
basis) v
x = (v -> Scalar v) -> [v] -> [Scalar v]
forall a b. (a -> b) -> [a] -> [b]
map (v -> v -> Scalar v
forall m. InnerProductSpace m => m -> m -> Scalar m
%. v
x) [v]
basis

 coordinateSpaceFunctionMatrix :: (CoordinateSpace m, StandardBasis v)
                => (v -> Scalar m) -> m
 coordinateSpaceFunctionMatrix :: forall m v.
(CoordinateSpace m, StandardBasis v) =>
(v -> Scalar m) -> m
coordinateSpaceFunctionMatrix v -> Scalar m
f = [Scalar m] -> m
forall v. CoordinateSpace v => [Scalar v] -> v
listVector ([Scalar m] -> m) -> [Scalar m] -> m
forall a b. (a -> b) -> a -> b
$ (v -> Scalar m) -> [v] -> [Scalar m]
forall a b. (a -> b) -> [a] -> [b]
map v -> Scalar m
f ([v] -> [Scalar m]) -> [v] -> [Scalar m]
forall a b. (a -> b) -> a -> b
$ [v]
forall m. StandardBasis m => [m]
unitVectors

 -- | This is the linearity condition:

 functionMatrix :: (Diagonalizable f b, Num b) => (f b -> g b) -> (f :*: g) b
 functionMatrix :: forall (f :: * -> *) b (g :: * -> *).
(Diagonalizable f b, Num b) =>
(f b -> g b) -> (:*:) f g b
functionMatrix f b -> g b
f = f (g b) -> (:*:) f g b
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g b) -> (:*:) f g b) -> f (g b) -> (:*:) f g b
forall a b. (a -> b) -> a -> b
$ (f b -> g b) -> f (f b) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> g b
f (f (f b) -> f (g b)) -> f (f b) -> f (g b)
forall a b. (a -> b) -> a -> b
$ (:*:) f f b -> f (f b)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f f b -> f (f b)) -> (:*:) f f b -> f (f b)
forall a b. (a -> b) -> a -> b
$ (:*:) f f b
forall (m :: * -> *) a. (Diagonalizable m a, Num a) => (:*:) m m a
identity

 instance (Show v) => Show (Basis v) where
   show :: Basis v -> String
show (Basis [v]
lst) = [v] -> String
forall a. Show a => a -> String
show [v]
lst

 instance ConjugateSymmetric Integer where { conj :: Integer -> Integer
conj = Integer -> Integer
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id }
 instance ConjugateSymmetric Int where { conj :: Int -> Int
conj = Int -> Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id }
 instance ConjugateSymmetric Float where { conj :: Float -> Float
conj = Float -> Float
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id }
 instance ConjugateSymmetric Double where { conj :: Double -> Double
conj = Double -> Double
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id }
 instance (Integral a) => ConjugateSymmetric (Ratio a) where { conj :: Ratio a -> Ratio a
conj = Ratio a -> Ratio a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id }
 instance (RealFloat a) => ConjugateSymmetric (Complex a) where
    conj :: Complex a -> Complex a
conj = Complex a -> Complex a
forall a. Num a => Complex a -> Complex a
conjugate
 instance (ConjugateSymmetric a) => ConjugateSymmetric (a -> a) where
    conj :: (a -> a) -> a -> a
conj a -> a
x = a -> a
x (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
forall m. ConjugateSymmetric m => m -> m
conj

 instance (ConjugateSymmetric a, ConjugateSymmetric b) => ConjugateSymmetric (a,b) where
    conj :: (a, b) -> (a, b)
conj (a
a,b
b) = (a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
a, b -> b
forall m. ConjugateSymmetric m => m -> m
conj b
b)


 instance (ConjugateSymmetric a, ConjugateSymmetric b, ConjugateSymmetric c) => ConjugateSymmetric (a,b,c) where
    conj :: (a, b, c) -> (a, b, c)
conj (a
a,b
b,c
c) = (a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
a, b -> b
forall m. ConjugateSymmetric m => m -> m
conj b
b, c -> c
forall m. ConjugateSymmetric m => m -> m
conj c
c)
 instance (ConjugateSymmetric a, ConjugateSymmetric b, ConjugateSymmetric c, ConjugateSymmetric d) => ConjugateSymmetric (a,b,c,d) where
    conj :: (a, b, c, d) -> (a, b, c, d)
conj (a
a,b
b,c
c,d
d) = (a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
a, b -> b
forall m. ConjugateSymmetric m => m -> m
conj b
b,c -> c
forall m. ConjugateSymmetric m => m -> m
conj c
c, d -> d
forall m. ConjugateSymmetric m => m -> m
conj d
d)

 -- | <https://ncatlab.org/nlab/show/Cayley-Dickson+construction>
 data CD a = CD a a
    deriving (Int -> CD a -> ShowS
[CD a] -> ShowS
CD a -> String
(Int -> CD a -> ShowS)
-> (CD a -> String) -> ([CD a] -> ShowS) -> Show (CD a)
forall a. Show a => Int -> CD a -> ShowS
forall a. Show a => [CD a] -> ShowS
forall a. Show a => CD a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CD a -> ShowS
showsPrec :: Int -> CD a -> ShowS
$cshow :: forall a. Show a => CD a -> String
show :: CD a -> String
$cshowList :: forall a. Show a => [CD a] -> ShowS
showList :: [CD a] -> ShowS
Show, CD a -> CD a -> Bool
(CD a -> CD a -> Bool) -> (CD a -> CD a -> Bool) -> Eq (CD a)
forall a. Eq a => CD a -> CD a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CD a -> CD a -> Bool
== :: CD a -> CD a -> Bool
$c/= :: forall a. Eq a => CD a -> CD a -> Bool
/= :: CD a -> CD a -> Bool
Eq)
 
 instance (ConjugateSymmetric a, Num a) => ConjugateSymmetric (CD a) where
   conj :: CD a -> CD a
conj (CD a
a a
b) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
a) (a -> a
forall a. Num a => a -> a
negate a
b)

 instance (ConjugateSymmetric a, Num a) => Num (CD a) where
   (CD a
a a
b) + :: CD a -> CD a -> CD a
+ (CD a
c a
d) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
c) (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
d)
   (CD a
a a
b) - :: CD a -> CD a -> CD a
- (CD a
c a
d) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
c) (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
d)
   negate :: CD a -> CD a
negate (CD a
a a
b) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a -> a
forall a. Num a => a -> a
negate a
a) (a -> a
forall a. Num a => a -> a
negate a
b)
   abs :: CD a -> CD a
abs (CD a
a a
b) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a -> a
forall a. Num a => a -> a
abs a
a) (a -> a
forall a. Num a => a -> a
abs a
b)
   signum :: CD a -> CD a
signum (CD a
a a
b) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a -> a
forall a. Num a => a -> a
signum a
a) (a -> a
forall a. Num a => a -> a
signum a
b)
   (CD a
a a
b) * :: CD a -> CD a -> CD a
* (CD a
c a
d) = a -> a -> CD a
forall a. a -> a -> CD a
CD (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
da -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
b) (a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
ca -> a -> a
forall a. Num a => a -> a -> a
*a
b)
   fromInteger :: Integer -> CD a
fromInteger Integer
i = a -> a -> CD a
forall a. a -> a -> CD a
CD (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i) a
0

 -- | <https://en.wikipedia.org/wiki/Convex_combination>
 -- This computes \[f([a_0,a_1,...,a_n], [{\mathbf b}_0,{\mathbf b}_1,...,{\mathbf b}_n]) = {{\sum_{j=0}^n{a_j{\mathbf b}_j}} \over \sum_{i=0}^n{a_i}}\]
 convex_combination :: (VectorSpace v, Fractional (Scalar v), Foldable t,
   Applicative t) => t (Scalar v) -> t v -> v
 convex_combination :: forall v (t :: * -> *).
(VectorSpace v, Fractional (Scalar v), Foldable t,
 Applicative t) =>
t (Scalar v) -> t v -> v
convex_combination t (Scalar v)
a t v
b = (Scalar v
1Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/t (Scalar v) -> Scalar v
forall a. Num a => t a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t (Scalar v)
a) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* t v -> v
forall (t :: * -> *) a. (Foldable t, VectorSpace a) => t a -> a
vsum ((Scalar v -> v -> v) -> t (Scalar v) -> t v -> t v
forall a b c. (a -> b -> c) -> t a -> t b -> t c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
(%*) t (Scalar v)
a t v
b)

                       
 instance (Integral a) => VectorSpace (Ratio a) where
    type Scalar (Ratio a) = Ratio a
    vzero :: Ratio a
vzero = a
0 a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
1
    vnegate :: Ratio a -> Ratio a
vnegate Ratio a
r = Ratio a -> Ratio a
forall a. Num a => a -> a
negate Ratio a
r
    Scalar (Ratio a)
n %* :: Scalar (Ratio a) -> Ratio a -> Ratio a
%* Ratio a
r = Ratio a
Scalar (Ratio a)
n Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
* Ratio a
r
    Ratio a
n %+ :: Ratio a -> Ratio a -> Ratio a
%+ Ratio a
r = Ratio a
n Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
+ Ratio a
r

 instance (Integral a) => NormedSpace (Ratio a) where
    norm :: Ratio a -> Scalar (Ratio a)
norm Ratio a
z = Ratio a -> Ratio a
forall a. Num a => a -> a
abs Ratio a
z


 instance (VectorSpace k) => VectorSpace (Basis k) where
    type Scalar (Basis k) = Scalar k
    vzero :: Basis k
vzero = [k] -> Basis k
forall m. [m] -> Basis m
Basis []
    vnegate :: Basis k -> Basis k
vnegate (Basis [k]
lst) = [k] -> Basis k
forall m. [m] -> Basis m
Basis ((k -> k) -> [k] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map k -> k
forall v. VectorSpace v => v -> v
vnegate [k]
lst)
    Scalar (Basis k)
n %* :: Scalar (Basis k) -> Basis k -> Basis k
%* (Basis [k]
lst) = [k] -> Basis k
forall m. [m] -> Basis m
Basis ((k -> k) -> [k] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map (Scalar k
Scalar (Basis k)
n Scalar k -> k -> k
forall v. VectorSpace v => Scalar v -> v -> v
%*) [k]
lst)
    (Basis [k]
lst) %+ :: Basis k -> Basis k -> Basis k
%+ (Basis [k]
lst') = [k] -> Basis k
forall m. [m] -> Basis m
Basis ([k]
lst [k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++ [k]
lst')

 instance (Num a) => VectorSpace [a] where
    type Scalar [a] = a
    vzero :: [a]
vzero = []
    vnegate :: [a] -> [a]
vnegate [a]
x = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. Num a => a -> a
negate [a]
x
    Scalar [a]
a %* :: Scalar [a] -> [a] -> [a]
%* [] = []
    Scalar [a]
a %* (a
c:[a]
cr) = (a
Scalar [a]
a a -> a -> a
forall a. Num a => a -> a -> a
* a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Scalar [a]
a Scalar [a] -> [a] -> [a]
forall v. VectorSpace v => Scalar v -> v -> v
%* [a]
cr)
    (a
c:[a]
cr) %+ :: [a] -> [a] -> [a]
%+ (a
d:[a]
dr) = (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cr [a] -> [a] -> [a]
forall v. VectorSpace v => v -> v -> v
%+ [a]
dr)
    [] %+ [a]
lst = [a]
lst
    [a]
lst %+ [] = [a]
lst

  -- instance Diagonalizable Stream Integer where
  --    vector_dimension [] = []
  --    vector_dimension (_:cr) = 0 : map succ (vector_dimension cr)
  --    identity lst = linear $ linmatrix (\x y -> if x == y then 1 else 0) -!< (lst,lst)
  --    diagonal x | (Matrix m) <- fromLinear x = 
  --      map (\i -> (m !! fromInteger i) !! fromInteger i) indexable_indices
  --    diagonal_matrix v   = linear $ linmatrix (\x y -> if x == y then v !! fromInteger x else 0) -!< (dim,dim)
  --       where dim = vector_dimension v
 
 instance VectorSpace Integer where
    type Scalar Integer = Integer
    vzero :: Integer
vzero = Integer
0
    vnegate :: Integer -> Integer
vnegate = Integer -> Integer
forall a. Num a => a -> a
negate
    Scalar Integer
a %* :: Scalar Integer -> Integer -> Integer
%* Integer
b = Integer
Scalar Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b
    Integer
a %+ :: Integer -> Integer -> Integer
%+ Integer
b = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b

 instance VectorSpace Int where
    type Scalar Int = Int
    vzero :: Int
vzero = Int
0
    vnegate :: Int -> Int
vnegate = Int -> Int
forall a. Num a => a -> a
negate
    Scalar Int
a %* :: Scalar Int -> Int -> Int
%* Int
b = Int
Scalar Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b
    Int
a %+ :: Int -> Int -> Int
%+ Int
b = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b

 instance VectorSpace Float where
    type Scalar Float = Float
    vzero :: Float
vzero = Float
0
    vnegate :: Float -> Float
vnegate = Float -> Float
forall a. Num a => a -> a
negate 
    Scalar Float
a %* :: Scalar Float -> Float -> Float
%* Float
b = Float
Scalar Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b
    Float
a %+ :: Float -> Float -> Float
%+ Float
b = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b

 instance VectorSpace Double where
    type Scalar Double = Double
    vzero :: Double
vzero = Double
0
    vnegate :: Double -> Double
vnegate = Double -> Double
forall a. Num a => a -> a
negate
    Scalar Double
a %* :: Scalar Double -> Double -> Double
%* Double
b = Double
Scalar Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
    Double
a %+ :: Double -> Double -> Double
%+ Double
b = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b

 -- | a pair of vector spaces is a vector space if they are over the same set of scalars.
 instance (VectorSpace a, VectorSpace b, Scalar a ~ Scalar b) => VectorSpace (a,b) where
    type Scalar (a,b) = Scalar a
    vzero :: (a, b)
vzero = (a
forall v. VectorSpace v => v
vzero,b
forall v. VectorSpace v => v
vzero)
    vnegate :: (a, b) -> (a, b)
vnegate (a
a,b
b) = (a -> a
forall v. VectorSpace v => v -> v
vnegate a
a,b -> b
forall v. VectorSpace v => v -> v
vnegate b
b)
    (a
a,b
b) %+ :: (a, b) -> (a, b) -> (a, b)
%+ (a
a',b
b') = (a
a a -> a -> a
forall v. VectorSpace v => v -> v -> v
%+ a
a', b
b b -> b -> b
forall v. VectorSpace v => v -> v -> v
%+ b
b')
    Scalar (a, b)
a %* :: Scalar (a, b) -> (a, b) -> (a, b)
%* (a
b,b
c) = (Scalar a
Scalar (a, b)
a Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
%* a
b, Scalar b
Scalar (a, b)
a Scalar b -> b -> b
forall v. VectorSpace v => Scalar v -> v -> v
%* b
c)

 instance (MetricSpace a, MetricSpace b, Distance a ~ Distance b, Floating (Distance b))
   => MetricSpace (a,b) where
    type Distance (a,b) = Distance a
    distance :: (a, b) -> (a, b) -> Distance (a, b)
distance (a
x,b
y) (a
x',b
y') = Distance b -> Distance b
forall a. Floating a => a -> a
sqrt( (a -> a -> Distance a
forall s. MetricSpace s => s -> s -> Distance s
distance a
x a
x')Distance b -> Integer -> Distance b
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 Distance b -> Distance b -> Distance b
forall a. Num a => a -> a -> a
+ (b -> b -> Distance b
forall s. MetricSpace s => s -> s -> Distance s
distance b
y b
y')Distance b -> Integer -> Distance b
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)

 -- | Note: Scalar (Complex a) = Complex a
 instance (RealFloat a) => VectorSpace (Complex a) where
    type Scalar (Complex a) = Complex a
    vzero :: Complex a
vzero = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
    vnegate :: Complex a -> Complex a
vnegate = Complex a -> Complex a
forall a. Num a => a -> a
negate
    Scalar (Complex a)
a %* :: Scalar (Complex a) -> Complex a -> Complex a
%* Complex a
b = Complex a
Scalar (Complex a)
a Complex a -> Complex a -> Complex a
forall a. Num a => a -> a -> a
* Complex a
b
    (a
r1 :+ a
i1) %+ :: Complex a -> Complex a -> Complex a
%+ (a
r2 :+ a
i2) = (a
r1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
r2) a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
i1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
i2)

 -- | <https://en.wikipedia.org/wiki/Inner_product_space>
 instance {-# OVERLAPPABLE #-} (RealFloat a) => InnerProductSpace (Complex a) where
    Complex a
a %. :: Complex a -> Complex a -> Scalar (Complex a)
%. Complex a
b = Complex a
a Complex a -> Complex a -> Complex a
forall a. Num a => a -> a -> a
* Complex a -> Complex a
forall m. ConjugateSymmetric m => m -> m
conj Complex a
b

 isPositiveDefiniteInnerProductSpace :: Complex a -> Bool
isPositiveDefiniteInnerProductSpace Complex a
m
  | Complex a
m Complex a -> Complex a -> Bool
forall a. Eq a => a -> a -> Bool
/= (a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0) = Complex a -> a
forall a. Complex a -> a
realPart (Complex a
m Complex a -> Complex a -> Scalar (Complex a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. Complex a
m) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
  | Bool
otherwise = Bool
True


 instance {-# OVERLAPPABLE #-} (RealFloat a) => NormedSpace (Complex a) where
    norm :: Complex a -> Scalar (Complex a)
norm Complex a
x = Complex a -> Complex a
forall a. Floating a => a -> a
sqrt (Complex a
x Complex a -> Complex a -> Scalar (Complex a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. Complex a
x)
    normSquared :: Complex a -> Scalar (Complex a)
normSquared Complex a
x = Complex a
x Complex a -> Complex a -> Scalar (Complex a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. Complex a
x

 instance (RealFloat a) => MetricSpace (Complex a) where
    type Distance (Complex a) = Scalar (Complex a)
    distance :: Complex a -> Complex a -> Distance (Complex a)
distance Complex a
a Complex a
b = Complex a -> Scalar (Complex a)
forall m. NormedSpace m => m -> Scalar m
norm (Complex a
b Complex a -> Complex a -> Complex a
forall a. Num a => a -> a -> a
- Complex a
a)

 instance (Num a) => StandardBasis (Complex a) where
    unitVectors :: [Complex a]
unitVectors = [(a
1 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0), (a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
1)]

 instance (VectorSpace a) => VectorSpace (Maybe a) where
    type Scalar (Maybe a) = Scalar a
    vzero :: Maybe a
vzero = a -> Maybe a
forall a. a -> Maybe a
Just a
forall v. VectorSpace v => v
vzero
    vnegate :: Maybe a -> Maybe a
vnegate = Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
forall v. VectorSpace v => v -> v
vnegate)
    Maybe a
x %+ :: Maybe a -> Maybe a -> Maybe a
%+ Maybe a
y = (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall v. VectorSpace v => v -> v -> v
(%+) Maybe a
x Maybe a
y
    Scalar (Maybe a)
a %* :: Scalar (Maybe a) -> Maybe a -> Maybe a
%* Maybe a
x = (a -> a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Scalar a
Scalar (Maybe a)
a Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
%*) Maybe a
x

 instance (Num (Scalar a), NormedSpace a) => NormedSpace (Maybe a) where
    norm :: Maybe a -> Scalar (Maybe a)
norm Maybe a
Nothing = Scalar a
Scalar (Maybe a)
0
    norm (Just a
x) = a -> Scalar a
forall m. NormedSpace m => m -> Scalar m
norm a
x

 instance NormedSpace Integer where { norm :: Integer -> Scalar Integer
norm = Integer -> Integer
Integer -> Scalar Integer
forall a. Num a => a -> a
abs }
 instance NormedSpace Int where { norm :: Int -> Scalar Int
norm = Int -> Int
Int -> Scalar Int
forall a. Num a => a -> a
abs }
 instance NormedSpace Float where { norm :: Float -> Scalar Float
norm = Float -> Float
Float -> Scalar Float
forall a. Num a => a -> a
abs }
 instance NormedSpace Double where { norm :: Double -> Scalar Double
norm = Double -> Double
Double -> Scalar Double
forall a. Num a => a -> a
abs }
 instance (Integral a) => InnerProductSpace (Ratio a) where { %. :: Ratio a -> Ratio a -> Scalar (Ratio a)
(%.) = Ratio a -> Ratio a -> Ratio a
Ratio a -> Ratio a -> Scalar (Ratio a)
forall a. Num a => a -> a -> a
(*) }
 instance InnerProductSpace Integer where { %. :: Integer -> Integer -> Scalar Integer
(%.) = Integer -> Integer -> Integer
Integer -> Integer -> Scalar Integer
forall a. Num a => a -> a -> a
(*) }
 instance InnerProductSpace Int where { %. :: Int -> Int -> Scalar Int
(%.) = Int -> Int -> Int
Int -> Int -> Scalar Int
forall a. Num a => a -> a -> a
(*) }
 instance InnerProductSpace Float where { %. :: Float -> Float -> Scalar Float
(%.) = Float -> Float -> Float
Float -> Float -> Scalar Float
forall a. Num a => a -> a -> a
(*) }
 instance InnerProductSpace Double where { %. :: Double -> Double -> Scalar Double
(%.) = Double -> Double -> Double
Double -> Double -> Scalar Double
forall a. Num a => a -> a -> a
(*) }

  -- instance (Num a) => VectorSpace (([] :*: []) a) where
  --   type Scalar (([] :*: []) a) = a
  --   vzero = Matrix []
  --   vnegate (Matrix x) = Matrix $ map vnegate x
  --   v %* (Matrix x) = Matrix $ map (v %*) x
  --   (Matrix x) %+ (Matrix y) = Matrix $ zipWith (%+) x y
  --
  -- instance (Floating a) => NormedSpace [a] where
  --   norm lst = sqrt (sum $ map (\a -> a*a) lst)

 instance AppendableVector [] [] where
   type ([] :+: []) = []
   [a]
lst ||>> :: forall a. [a] -> [a] -> (:+:) [] [] a
||>> [a]
lst' = [a]
lst [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
lst'

 instance {-# OVERLAPPABLE #-}
      (Show (f a)) => Show (([] :*: f) a) where
   show :: (:*:) [] f a -> String
show (Matrix [f a]
lst) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n" ((f a -> String) -> [f a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map f a -> String
forall a. Show a => a -> String
show [f a]
lst)

 instance (Num v) => VectorSpace (x -> v) where
    type Scalar (x -> v) = v
    vzero :: x -> v
vzero = v -> x -> v
forall a b. a -> b -> a
const v
0
    vnegate :: (x -> v) -> x -> v
vnegate x -> v
f = v -> v
forall a. Num a => a -> a
negate (v -> v) -> (x -> v) -> x -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. x -> v
f
    Scalar (x -> v)
a %* :: Scalar (x -> v) -> (x -> v) -> x -> v
%* x -> v
f = \x
i -> v
Scalar (x -> v)
a v -> v -> v
forall a. Num a => a -> a -> a
* x -> v
f x
i
    x -> v
f %+ :: (x -> v) -> (x -> v) -> x -> v
%+ x -> v
g = \x
i -> x -> v
f x
i v -> v -> v
forall a. Num a => a -> a -> a
+ x -> v
g x
i

 vec2Cast :: a :~: b -> a :~: b -> a :~: b
 vec2Cast :: forall {k} (a :: k) (b :: k). (a :~: b) -> (a :~: b) -> a :~: b
vec2Cast a :~: b
Refl a :~: b
Refl = a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl


 -- | <https://en.wikipedia.org/wiki/Commutator>
 instance (VectorSpace a, Num a) => LieAlgebra (a -> a) where
    a -> a
f %<>% :: (a -> a) -> (a -> a) -> a -> a
%<>% a -> a
g = (a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
g) (a -> a) -> (a -> a) -> a -> a
forall v. VectorSpace v => v -> v -> v
%- (a -> a
g (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f)

 instance (Num a) => LieAlgebra (Endo a) where
    Endo a
f %<>% :: Endo a -> Endo a -> Endo a
%<>% Endo a
g = (Endo a
f Endo a -> Endo a -> Endo a
forall a. Semigroup a => a -> a -> a
<> Endo a
g) Endo a -> Endo a -> Endo a
forall v. VectorSpace v => v -> v -> v
%- (Endo a
g Endo a -> Endo a -> Endo a
forall a. Semigroup a => a -> a -> a
<> Endo a
f)

 instance (Floating a) => VectorSpace (Product a) where
    type Scalar (Product a) = a
    vzero :: Product a
vzero = a -> Product a
forall a. a -> Product a
Product a
1
    vnegate :: Product a -> Product a
vnegate (Product a
x) = a -> Product a
forall a. a -> Product a
Product (a -> a
forall a. Fractional a => a -> a
recip a
x)
    Scalar (Product a)
a %* :: Scalar (Product a) -> Product a -> Product a
%* (Product a
x) = a -> Product a
forall a. a -> Product a
Product (a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
Scalar (Product a)
a)
    (Product a
x) %+ :: Product a -> Product a -> Product a
%+ (Product a
y) = a -> Product a
forall a. a -> Product a
Product (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)

 instance (Floating a, ConjugateSymmetric a) => InnerProductSpace (Product a) where
   (Product a
x) %. :: Product a -> Product a -> Scalar (Product a)
%. (Product a
y) = a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
y
 
 instance (Floating a, ConjugateSymmetric a) => InnerProductSpaceFunctor Product a

 instance (Num a) => VectorSpace (Sum a) where
    type Scalar (Sum a) = a
    vzero :: Sum a
vzero = a -> Sum a
forall a. a -> Sum a
Sum a
0
    vnegate :: Sum a -> Sum a
vnegate (Sum a
x) = a -> Sum a
forall a. a -> Sum a
Sum (a -> a
forall a. Num a => a -> a
negate a
x)
    Scalar (Sum a)
a %* :: Scalar (Sum a) -> Sum a -> Sum a
%* (Sum a
x) = a -> Sum a
forall a. a -> Sum a
Sum (a
Scalar (Sum a)
a a -> a -> a
forall a. Num a => a -> a -> a
* a
x)
    (Sum a
x) %+ :: Sum a -> Sum a -> Sum a
%+ (Sum a
y) = a -> Sum a
forall a. a -> Sum a
Sum (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)

 instance (NumFloating a, ConjugateSymmetric a) => NormedSpace (Sum a) where
    normSquared :: Sum a -> Scalar (Sum a)
normSquared Sum a
x = Sum a
x Sum a -> Sum a -> Scalar (Sum a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. Sum a
x

 instance (ConjugateSymmetric a, Num a) => InnerProductSpace (Sum a) where
    (Sum a
x) %. :: Sum a -> Sum a -> Scalar (Sum a)
%. (Sum a
y) = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
y

 instance (ConjugateSymmetric a, Num a) => InnerProductSpaceFunctor Sum a

 instance (Num a) => VectorSpace (First a) where
    type Scalar (First a) = a
    vzero :: First a
vzero = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
forall a. Maybe a
Nothing
    vnegate :: First a -> First a
vnegate (First Maybe a
m) = Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> Maybe a -> First a
forall a b. (a -> b) -> a -> b
$ Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
forall a. Num a => a -> a
negate) Maybe a
m
    Scalar (First a)
a %* :: Scalar (First a) -> First a -> First a
%* (First Maybe a
m) = Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> Maybe a -> First a
forall a b. (a -> b) -> a -> b
$ Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
Scalar (First a)
aa -> a -> a
forall a. Num a => a -> a -> a
*)) Maybe a
m
    (First (Just a
m)) %+ :: First a -> First a -> First a
%+ (First (Just a
n)) = Maybe a -> First a
forall a. Maybe a -> First a
First (a -> Maybe a
forall a. a -> Maybe a
Just (a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
n))
    (First Maybe a
Nothing) %+ (First Maybe a
m) = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
m
    (First Maybe a
m) %+ (First Maybe a
Nothing) = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
m

 instance (Floating a, ConjugateSymmetric a) => NormedSpace (First a) where
    normSquared :: First a -> Scalar (First a)
normSquared First a
x = First a
x First a -> First a -> Scalar (First a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. First a
x

 instance (Num a, ConjugateSymmetric a) => InnerProductSpace (First a) where
    (First (Just a
x)) %. :: First a -> First a -> Scalar (First a)
%. (First (Just a
y)) = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall m. ConjugateSymmetric m => m -> m
conj a
y
    (First Maybe a
Nothing) %. (First (Just a
y))  = a
Scalar (First a)
y
    (First (Just a
x)) %. (First Maybe a
Nothing)  = a
Scalar (First a)
x
    (First Maybe a
Nothing) %. (First Maybe a
Nothing)   = a
Scalar (First a)
0

 instance (Num a) => VectorSpace (Last a) where
    type Scalar (Last a) = a
    vzero :: Last a
vzero = Maybe a -> Last a
forall a. Maybe a -> Last a
Last Maybe a
forall a. Maybe a
Nothing
    vnegate :: Last a -> Last a
vnegate (Last Maybe a
m) = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> Maybe a -> Last a
forall a b. (a -> b) -> a -> b
$ Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
forall a. Num a => a -> a
negate) Maybe a
m
    Scalar (Last a)
a %* :: Scalar (Last a) -> Last a -> Last a
%* (Last Maybe a
m) = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> Maybe a -> Last a
forall a b. (a -> b) -> a -> b
$ Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
Scalar (Last a)
aa -> a -> a
forall a. Num a => a -> a -> a
*)) Maybe a
m
    (Last (Just a
m)) %+ :: Last a -> Last a -> Last a
%+ (Last (Just a
n)) = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> Maybe a -> Last a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
n
    (Last Maybe a
Nothing) %+ (Last Maybe a
m) = Maybe a -> Last a
forall a. Maybe a -> Last a
Last Maybe a
m
    (Last Maybe a
m) %+ (Last Maybe a
Nothing) = Maybe a -> Last a
forall a. Maybe a -> Last a
Last Maybe a
m

 instance (Floating a) => LieAlgebra (Product a) where
    Product a
f %<>% :: Product a -> Product a -> Product a
%<>% Product a
g = (Product a
f Product a -> Product a -> Product a
forall a. Semigroup a => a -> a -> a
<> Product a
g) Product a -> Product a -> Product a
forall v. VectorSpace v => v -> v -> v
%- (Product a
g Product a -> Product a -> Product a
forall a. Semigroup a => a -> a -> a
<> Product a
f)

 instance (LinearInnerProductSpace v w, Eq v, Eq w, Num (Scalar w), Ord (Scalar w)) => InnerProductSpace (v,w) where
    (v
a,w
b) %. :: (v, w) -> (v, w) -> Scalar (v, w)
%. (v
c,w
d) = v
a v -> v -> Scalar v
forall m. InnerProductSpace m => m -> m -> Scalar m
%. v
c Scalar w -> Scalar w -> Scalar w
forall a. Num a => a -> a -> a
+ w
b w -> w -> Scalar w
forall m. InnerProductSpace m => m -> m -> Scalar m
%. w
d

 -- | <https://en.wikipedia.org/wiki/Lie_algebra>
 instance (LieAlgebra a, LieAlgebra b, Scalar a ~ Scalar b) => LieAlgebra (a,b) where
    (a
a,b
b) %<>% :: (a, b) -> (a, b) -> (a, b)
%<>% (a
a',b
b') = (a
a a -> a -> a
forall m. LieAlgebra m => m -> m -> m
%<>% a
a', b
b b -> b -> b
forall m. LieAlgebra m => m -> m -> m
%<>% b
b')

 instance (Linear v w, Linear w u) => VectorSpace (v,w,u) where
    type Scalar (v,w,u) = Scalar v
    vzero :: (v, w, u)
vzero = (v
forall v. VectorSpace v => v
vzero,w
forall v. VectorSpace v => v
vzero,u
forall v. VectorSpace v => v
vzero)
    vnegate :: (v, w, u) -> (v, w, u)
vnegate (v
x,w
y,u
z) = (v -> v
forall v. VectorSpace v => v -> v
vnegate v
x, w -> w
forall v. VectorSpace v => v -> v
vnegate w
y,u -> u
forall v. VectorSpace v => v -> v
vnegate u
z)
    Scalar (v, w, u)
a %* :: Scalar (v, w, u) -> (v, w, u) -> (v, w, u)
%* (v
x,w
y,u
z) = (Scalar v
Scalar (v, w, u)
a Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
%* v
x, Scalar w
Scalar (v, w, u)
a Scalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
%* w
y,Scalar u
Scalar (v, w, u)
a Scalar u -> u -> u
forall v. VectorSpace v => Scalar v -> v -> v
%* u
z)
    (v
x,w
y,u
z) %+ :: (v, w, u) -> (v, w, u) -> (v, w, u)
%+ (v
x',w
y',u
z') = (v
x v -> v -> v
forall v. VectorSpace v => v -> v -> v
%+ v
x', w
y w -> w -> w
forall v. VectorSpace v => v -> v -> v
%+ w
y',u
z u -> u -> u
forall v. VectorSpace v => v -> v -> v
%+ u
z')

 instance (MetricSpace v, MetricSpace w, MetricSpace u, Distance v ~ Distance w,
   Distance w ~ Distance u, Floating (Distance v))
  => MetricSpace (v,w,u) where
    type Distance (v,w,u) = Distance v
    distance :: (v, w, u) -> (v, w, u) -> Distance (v, w, u)
distance (v
x,w
y,u
z) (v
x',w
y',u
z') = Distance u -> Distance u
forall a. Floating a => a -> a
sqrt((v -> v -> Distance v
forall s. MetricSpace s => s -> s -> Distance s
distance v
x v
x')Distance u -> Integer -> Distance u
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2Distance u -> Distance u -> Distance u
forall a. Num a => a -> a -> a
+(w -> w -> Distance w
forall s. MetricSpace s => s -> s -> Distance s
distance w
y w
y')Distance u -> Integer -> Distance u
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 Distance u -> Distance u -> Distance u
forall a. Num a => a -> a -> a
+ (u -> u -> Distance u
forall s. MetricSpace s => s -> s -> Distance s
distance u
z u
z')Distance u -> Integer -> Distance u
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)

 instance (LieAlgebra v, LieAlgebra w, LieAlgebra u, Scalar v ~ Scalar w, Scalar w ~ Scalar u)
   => LieAlgebra (v,w,u) where
    (v
a,w
b,u
c) %<>% :: (v, w, u) -> (v, w, u) -> (v, w, u)
%<>% (v
a',w
b',u
c') = (v
a v -> v -> v
forall m. LieAlgebra m => m -> m -> m
%<>% v
a', w
b w -> w -> w
forall m. LieAlgebra m => m -> m -> m
%<>% w
b', u
c u -> u -> u
forall m. LieAlgebra m => m -> m -> m
%<>% u
c')

 instance (Ord (Scalar u), Eq v, Eq w, Eq u,
  LinearInnerProductSpace v w,
  LinearInnerProductSpace w u,
  Num (Scalar w))
   => InnerProductSpace (v,w,u) where
     (v
a,w
b,u
c) %. :: (v, w, u) -> (v, w, u) -> Scalar (v, w, u)
%. (v
d,w
e,u
f) = v
a v -> v -> Scalar v
forall m. InnerProductSpace m => m -> m -> Scalar m
%. v
d Scalar u -> Scalar u -> Scalar u
forall a. Num a => a -> a -> a
+ w
b w -> w -> Scalar w
forall m. InnerProductSpace m => m -> m -> Scalar m
%. w
e Scalar u -> Scalar u -> Scalar u
forall a. Num a => a -> a -> a
+ u
c u -> u -> Scalar u
forall m. InnerProductSpace m => m -> m -> Scalar m
%. u
f

 -- | <https://en.wikipedia.org/wiki/Dot_product>
 instance (Universe a, Num b, ConjugateSymmetric b)
  => InnerProductSpace (a -> b) where
    a -> b
f %. :: (a -> b) -> (a -> b) -> Scalar (a -> b)
%. a -> b
g = [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a -> b
f a
i b -> b -> b
forall a. Num a => a -> a -> a
* b -> b
forall m. ConjugateSymmetric m => m -> m
conj (a -> b
g a
i) | a
i <- [a]
forall a. Universe a => [a]
allElements]

 instance (Num b, ConjugateSymmetric b, Universe a) => InnerProductSpaceFunctor ((->) a) b

  -- this function is identically zero for hilbert spaces.

 hilbertSpace :: (Num m, NormedSpace m) => m -> m -> Scalar m
 hilbertSpace :: forall m. (Num m, NormedSpace m) => m -> m -> Scalar m
hilbertSpace m
x m
y = m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm(m
xm -> m -> m
forall a. Num a => a -> a -> a
+m
y)Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
+m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
norm(m
xm -> m -> m
forall a. Num a => a -> a -> a
-m
y) Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
- Scalar m
2Scalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
*(m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
normSquared m
xScalar m -> Scalar m -> Scalar m
forall a. Num a => a -> a -> a
+m -> Scalar m
forall m. NormedSpace m => m -> Scalar m
normSquared m
y)

 lieAdjoint :: (LieAlgebra v) => v -> Endo v
 lieAdjoint :: forall v. LieAlgebra v => v -> Endo v
lieAdjoint v
x = (v -> v) -> Endo v
forall {a}. (a -> a) -> Endo a
Endo ((v -> v) -> Endo v) -> (v -> v) -> Endo v
forall a b. (a -> b) -> a -> b
$ \v
y -> v
x v -> v -> v
forall m. LieAlgebra m => m -> m -> m
%<>% v
y

 instance Conditional Integer where
   fromBoolean :: Bool -> Integer
fromBoolean Bool
True  = Integer
1
   fromBoolean Bool
False = Integer
0

 instance Conditional Int where
   fromBoolean :: Bool -> Int
fromBoolean Bool
True = Int
1
   fromBoolean Bool
False = Int
0

 instance Conditional Float where
   fromBoolean :: Bool -> Float
fromBoolean Bool
True = Float
1.0
   fromBoolean Bool
False = Float
0.0

  -- instance (Functor m) => Unital (:*:) m where
  --   type UUnit = I
  --   leftId = matrixLeftId
  --   rightId = matrixRightId

 -- | <https://en.wikipedia.org/wiki/Norm_(mathematics)>
 isOnUnitCircle :: (NormedSpace v, Eq (Scalar v)) => v -> Bool
 isOnUnitCircle :: forall v. (NormedSpace v, Eq (Scalar v)) => v -> Bool
isOnUnitCircle v
v = v -> Scalar v
forall m. NormedSpace m => m -> Scalar m
normSquared v
v Scalar v -> Scalar v -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar v
1

 -- | <https://en.wikipedia.org/wiki/Norm_(mathematics)>
 isInsideUnitCircle :: (NormedSpace v, Ord (Scalar v)) => v -> Bool
 isInsideUnitCircle :: forall v. (NormedSpace v, Ord (Scalar v)) => v -> Bool
isInsideUnitCircle v
v = v -> Scalar v
forall m. NormedSpace m => m -> Scalar m
normSquared v
v Scalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
<= Scalar v
1

  -- instance VectorSpace (f (Complex a)) => VectorSpace ((f :*: Complex) a) where
  --   type Scalar ((f :*: Complex) a) = Scalar (f (Complex a))
  --   vzero = Matrix vzero
  --   vnegate (Matrix v) = Matrix (vnegate v)
  --   (Matrix v) %+ (Matrix w) = Matrix (v %+ w)
  --   c %* (Matrix v) = Matrix (c %* v)

 instance {-# OVERLAPPING #-} (Functor f) => Transposable f Complex a where
   transposeImpl :: (:*:) f Complex a -> (:*:) Complex f a
transposeImpl (Matrix f (Complex a)
m) = Complex (f a) -> (:*:) Complex f a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (Complex (f a) -> (:*:) Complex f a)
-> Complex (f a) -> (:*:) Complex f a
forall a b. (a -> b) -> a -> b
$ (Complex a -> a) -> f (Complex a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Complex a -> a
forall a. Complex a -> a
realPart f (Complex a)
m f a -> f a -> Complex (f a)
forall a. a -> a -> Complex a
:+ (Complex a -> a) -> f (Complex a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Complex a -> a
forall a. Complex a -> a
imagPart f (Complex a)
m

 instance {-# OVERLAPPING #-} (Applicative f) => Transposable Complex f a where
   transposeImpl :: (:*:) Complex f a -> (:*:) f Complex a
transposeImpl (Matrix (f a
m :+ f a
n)) = f (Complex a) -> (:*:) f Complex a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (Complex a) -> (:*:) f Complex a)
-> f (Complex a) -> (:*:) f Complex a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Complex a) -> f a -> f a -> f (Complex a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Complex a
forall a. a -> a -> Complex a
(:+) f a
m f a
n

 -- | notice matrix of two complex numbers has special properties as matrix.
 instance {-# OVERLAPS #-} Transposable Complex Complex a where
   transposeImpl :: (:*:) Complex Complex a -> (:*:) Complex Complex a
transposeImpl (Matrix ((a
m :+ a
mi)
                       :+ (a
ni :+ a
n)))
     = Complex (Complex a) -> (:*:) Complex Complex a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (Complex (Complex a) -> (:*:) Complex Complex a)
-> Complex (Complex a) -> (:*:) Complex Complex a
forall a b. (a -> b) -> a -> b
$ ((a
m a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
ni)
              Complex a -> Complex a -> Complex (Complex a)
forall a. a -> a -> Complex a
:+ (a
mi a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
n))

 -- | diagonalizable instance for complex numbers.
 -- diagonal ((a+bi)+i(c+di)) = (a-d) + i(b+c)
 instance (Num a) => Diagonalizable Complex a where
   identity :: Num a => (:*:) Complex Complex a
identity = Complex (Complex a) -> (:*:) Complex Complex a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (Complex (Complex a) -> (:*:) Complex Complex a)
-> Complex (Complex a) -> (:*:) Complex Complex a
forall a b. (a -> b) -> a -> b
$ (a
1 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0) Complex a -> Complex a -> Complex (Complex a)
forall a. a -> a -> Complex a
:+ (a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
1)
   diagonalImpl :: (:*:) Complex Complex a -> Complex a
diagonalImpl (Matrix ((a
a :+ a
b) :+ (a
c :+ a
d))) = (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
d) a -> a -> Complex a
forall a. a -> a -> Complex a
:+ (a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
c)
   diagonalMatrixImpl :: Complex a -> (:*:) Complex Complex a -> (:*:) Complex Complex a
diagonalMatrixImpl (a
a :+ a
b) (:*:) Complex Complex a
m = Complex (Complex a) -> (:*:) Complex Complex a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (Complex (Complex a) -> (:*:) Complex Complex a)
-> Complex (Complex a) -> (:*:) Complex Complex a
forall a b. (a -> b) -> a -> b
$ (a
a a -> a -> Complex a
forall a. a -> a -> Complex a
:+ Complex a -> a
forall a. Complex a -> a
imagPart (Complex (Complex a) -> Complex a
forall a. Complex a -> a
realPart ((:*:) Complex Complex a -> Complex (Complex a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells (:*:) Complex Complex a
m)))
                                         Complex a -> Complex a -> Complex (Complex a)
forall a. a -> a -> Complex a
:+ (Complex a -> a
forall a. Complex a -> a
realPart (Complex (Complex a) -> Complex a
forall a. Complex a -> a
imagPart ((:*:) Complex Complex a -> Complex (Complex a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells (:*:) Complex Complex a
m)) a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a
forall a. Num a => a -> a
negate a
b)

 instance (Show (f a)) => Show ((Complex :*: f) a) where
   show :: (:*:) Complex f a -> String
show (Matrix (f a
a :+ f a
b)) = f a -> String
forall a. Show a => a -> String
show f a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :+ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ f a -> String
forall a. Show a => a -> String
show f a
b

 instance (Num a) => VectorSpace (I a) where
   type Scalar (I a) = a
   vzero :: I a
vzero = a -> I a
forall a. a -> I a
I a
0
   vnegate :: I a -> I a
vnegate (I a
x) = a -> I a
forall a. a -> I a
I (a -> a
forall a. Num a => a -> a
negate a
x)
   (I a
x) %+ :: I a -> I a -> I a
%+ (I a
y) = a -> I a
forall a. a -> I a
I (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
   Scalar (I a)
k %* :: Scalar (I a) -> I a -> I a
%* (I a
x) = a -> I a
forall a. a -> I a
I (a
Scalar (I a)
k a -> a -> a
forall a. Num a => a -> a -> a
* a
x)

  -- instance {-# OVERLAPPING #-}
  --  (Num a, Indexable f a, Indexable g a) => VectorSpace ((f :*: g) a) where
  --   type Scalar ((f :*: g) a) = a
  --   vzero = matrix (\a b -> 0) (indexable_indices :: f a) (indexable_indices :: g a)
  --   vnegate m = fmap negate m
  --   (Matrix f) %+ (Matrix g) = Matrix $ liftA2 (liftA2 (+)) f g
  --   k %* (Matrix f) = Matrix $ fmap (fmap (*k)) f

 instance (Functor f, Functor g) => Functor (g :*: f) where
    fmap :: forall a b. (a -> b) -> (:*:) g f a -> (:*:) g f b
fmap a -> b
f (Matrix g (f a)
x) = g (f b) -> (:*:) g f b
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (g (f b) -> (:*:) g f b) -> g (f b) -> (:*:) g f b
forall a b. (a -> b) -> a -> b
$ (f a -> f b) -> g (f a) -> g (f b)
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) g (f a)
x

 instance (Foldable f, Foldable g) => Foldable (f :*: g) where
    foldMap :: forall m a. Monoid m => (a -> m) -> (:*:) f g a -> m
foldMap a -> m
f (Matrix f (g a)
m) = (g a -> m) -> f (g a) -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> g a -> m
forall m a. Monoid m => (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) f (g a)
m

 instance (Traversable f, Traversable g) => Traversable (f :*: g) where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (:*:) f g a -> f ((:*:) f g b)
traverse a -> f b
f (Matrix f (g a)
m) = f (g b) -> (:*:) f g b
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g b) -> (:*:) f g b) -> f (f (g b)) -> f ((:*:) f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g a -> f (g b)) -> f (g a) -> f (f (g b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> g a -> f (g b)
traverse a -> f b
f) f (g a)
m

 instance (Applicative f, Applicative g) => Applicative (f :*: g) where
    pure :: forall a. a -> (:*:) f g a
pure = f (g a) -> (:*:) f g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g a) -> (:*:) f g a) -> (a -> f (g a)) -> a -> (:*:) f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g a -> f (g a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g a -> f (g a)) -> (a -> g a) -> a -> f (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> g a
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Matrix f (g (a -> b))
fs) <*> :: forall a b. (:*:) f g (a -> b) -> (:*:) f g a -> (:*:) f g b
<*> (Matrix f (g a)
xs) = f (g b) -> (:*:) f g b
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g b) -> (:*:) f g b) -> f (g b) -> (:*:) f g b
forall a b. (a -> b) -> a -> b
$ (g (a -> b) -> g a -> g b) -> f (g (a -> b) -> g a -> g b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) f (g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a -> g b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (g (a -> b))
fs f (g a -> g b) -> f (g a) -> f (g b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (g a)
xs

 instance (Alternative f, Alternative g) => Alternative (g :*: f) where
    empty :: forall a. (:*:) g f a
empty = g (f a) -> (:*:) g f a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix g (f a)
forall a. g a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
    (Matrix g (f a)
a) <|> :: forall a. (:*:) g f a -> (:*:) g f a -> (:*:) g f a
<|> (Matrix g (f a)
b) = g (f a) -> (:*:) g f a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (g (f a) -> (:*:) g f a) -> g (f a) -> (:*:) g f a
forall a b. (a -> b) -> a -> b
$ (f a -> f a -> f a) -> g (f a -> f a -> f a)
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) g (f a -> f a -> f a) -> g (f a) -> g (f a -> f a)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g (f a)
a g (f a -> f a) -> g (f a) -> g (f a)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g (f a)
b

 leftUnitor :: (I :*: f) a -> f a
 leftUnitor :: forall {k} (f :: k -> *) (a :: k). (:*:) I f a -> f a
leftUnitor (Matrix (I f a
x)) = f a
x

 rightUnitor :: (Functor f) => (f :*: I) a -> f a
 rightUnitor :: forall (f :: * -> *) a. Functor f => (:*:) f I a -> f a
rightUnitor (Matrix f (I a)
f) = (I a -> a) -> f (I a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap I a -> a
forall a. I a -> a
unI f (I a)
f

 associator :: (Functor f) => ((f :*: g) :*: h) a -> (f :*: (g :*: h)) a
 associator :: forall {k} {k} (f :: * -> *) (g :: k -> *) (h :: k -> k) (a :: k).
Functor f =>
(:*:) (f :*: g) h a -> (:*:) f (g :*: h) a
associator (Matrix (:*:) f g (h a)
f) = f ((:*:) g h a) -> (:*:) f (g :*: h) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f ((:*:) g h a) -> (:*:) f (g :*: h) a)
-> f ((:*:) g h a) -> (:*:) f (g :*: h) a
forall a b. (a -> b) -> a -> b
$ (g (h a) -> (:*:) g h a) -> f (g (h a)) -> f ((:*:) g h a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (h a) -> (:*:) g h a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g (h a)) -> f ((:*:) g h a)) -> f (g (h a)) -> f ((:*:) g h a)
forall a b. (a -> b) -> a -> b
$ (:*:) f g (h a) -> f (g (h a))
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells (:*:) f g (h a)
f
 
 unassociator :: (Functor f) => (f :*: (g :*: h)) a -> ((f :*: g) :*: h) a
 unassociator :: forall {k} {k} (f :: * -> *) (g :: k -> *) (h :: k -> k) (a :: k).
Functor f =>
(:*:) f (g :*: h) a -> (:*:) (f :*: g) h a
unassociator (Matrix f ((:*:) g h a)
f) = (:*:) f g (h a) -> (:*:) (f :*: g) h a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((:*:) f g (h a) -> (:*:) (f :*: g) h a)
-> (:*:) f g (h a) -> (:*:) (f :*: g) h a
forall a b. (a -> b) -> a -> b
$ f (g (h a)) -> (:*:) f g (h a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g (h a)) -> (:*:) f g (h a)) -> f (g (h a)) -> (:*:) f g (h a)
forall a b. (a -> b) -> a -> b
$ ((:*:) g h a -> g (h a)) -> f ((:*:) g h a) -> f (g (h a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:*:) g h a -> g (h a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells f ((:*:) g h a)
f

 instance (Functor f, Functor g, Num a, StandardBasis (g a), StandardBasis (f a))
    => StandardBasis ((f :*: g) a) where
    unitVectors :: [(:*:) f g a]
unitVectors = [[(:*:) f g a]] -> [(:*:) f g a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(:*:) f g a]] -> [(:*:) f g a])
-> [[(:*:) f g a]] -> [(:*:) f g a]
forall a b. (a -> b) -> a -> b
$ (:*:) [] [] ((:*:) f g a) -> [[(:*:) f g a]]
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) [] [] ((:*:) f g a) -> [[(:*:) f g a]])
-> (:*:) [] [] ((:*:) f g a) -> [[(:*:) f g a]]
forall a b. (a -> b) -> a -> b
$ (f a -> g a -> (:*:) f g a)
-> [f a] -> [g a] -> (:*:) [] [] ((:*:) f g a)
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix ((a -> a -> a) -> f a -> g a -> (:*:) f g a
forall (m :: * -> *) (n :: * -> *) a b c.
(Functor m, Functor n) =>
(a -> b -> c) -> m a -> n b -> (:*:) m n c
matrix a -> a -> a
forall a. Num a => a -> a -> a
(*)) [f a]
forall m. StandardBasis m => [m]
unitVectors [g a]
forall m. StandardBasis m => [m]
unitVectors

 instance (Num a) => Indexable Complex a where
   diagonalProjections :: Complex (Index Complex a)
diagonalProjections = Complex (Index Complex a)
forall a. Complex (Index Complex a)
diagonalProjectionsComplex
   indexableIndices :: Integral a => Complex a
indexableIndices = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
1

 diagonalProjectionsComplex :: Complex (Index Complex a)
 diagonalProjectionsComplex :: forall a. Complex (Index Complex a)
diagonalProjectionsComplex =  ((Complex a -> a)
-> (a -> Complex a -> Complex a) -> Index Complex a
forall (m :: * -> *) a.
(m a -> a) -> (a -> m a -> m a) -> Index m a
MakeIndex Complex a -> a
forall a. Complex a -> a
realPart (\a
a Complex a
c -> (a
a a -> a -> Complex a
forall a. a -> a -> Complex a
:+ Complex a -> a
forall a. Complex a -> a
imagPart Complex a
c)))
                            Index Complex a -> Index Complex a -> Complex (Index Complex a)
forall a. a -> a -> Complex a
:+ ((Complex a -> a)
-> (a -> Complex a -> Complex a) -> Index Complex a
forall (m :: * -> *) a.
(m a -> a) -> (a -> m a -> m a) -> Index m a
MakeIndex Complex a -> a
forall a. Complex a -> a
imagPart (\a
a Complex a
c -> (Complex a -> a
forall a. Complex a -> a
realPart Complex a
c a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
a)))

  -- example use: m <!> (xcoord3,ycoord3)

 (<!>) :: (Functor f, Functor g) => (g :*: f) a -> (g c -> b,f a -> c) -> b
 (:*:) g f a
m <!> :: forall (f :: * -> *) (g :: * -> *) a c b.
(Functor f, Functor g) =>
(:*:) g f a -> (g c -> b, f a -> c) -> b
<!> (g c -> b
x,f a -> c
y) = (g c -> b, f a -> c) -> Fold ((:*:) g f a) b
forall k (g :: * -> *) (f :: k -> *) (a :: k) b c.
(g c -> b, f a -> c) -> Fold ((:*:) g f a) b
MatrixFold (g c -> b
x,f a -> c
y) Fold ((:*:) g f a) b -> (:*:) g f a -> b
forall v a. Visitor v => Fold v a -> v -> a
forall a. Fold ((:*:) g f a) a -> (:*:) g f a -> a
`visit` (:*:) g f a
m

 instance (Functor g) => Visitor ((g :*: f) a) where
    data Fold ((g :*: f) a) b = forall c. MatrixFold (g c -> b,f a -> c)
    visit :: forall a. Fold ((:*:) g f a) a -> (:*:) g f a -> a
visit (MatrixFold (g c -> a
gt,f a -> c
ft)) (Matrix g (f a)
x) = g c -> a
gt ((f a -> c) -> g (f a) -> g c
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> c
ft g (f a)
x)

 reduceI :: (I :*: I) a -> I a
 reduceI :: forall a. (:*:) I I a -> I a
reduceI (Matrix (I I a
x)) = I a
x

 sumCoordinates :: (Foldable t, Num a) => t a -> a
 sumCoordinates :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sumCoordinates = (a -> a -> a) -> a -> t a -> a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.Foldable.foldr a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

 instance (Monad f, Monad g, forall b. Transposable g f b) => Monad (f :*: g) where
    (:*:) f g a
v >>= :: forall a b. (:*:) f g a -> (a -> (:*:) f g b) -> (:*:) f g b
>>= a -> (:*:) f g b
f = (:*:) f g ((:*:) f g b) -> (:*:) f g b
forall (g :: * -> *) (f :: * -> *) a.
(Monad g, Monad f, forall b. Transposable g f b) =>
(:*:) f g ((:*:) f g a) -> (:*:) f g a
joinMatrix ((:*:) f g ((:*:) f g b) -> (:*:) f g b)
-> (:*:) f g ((:*:) f g b) -> (:*:) f g b
forall a b. (a -> b) -> a -> b
$ (a -> (:*:) f g b) -> (:*:) f g a -> (:*:) f g ((:*:) f g b)
forall a b. (a -> b) -> (:*:) f g a -> (:*:) f g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (:*:) f g b
f (:*:) f g a
v

 instance (forall b. Transposable g f b, MonadFail f, MonadFail g) => MonadFail (f :*: g) where
    fail :: forall a. String -> (:*:) f g a
fail String
msg = f (g a) -> (:*:) f g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g a) -> (:*:) f g a) -> f (g a) -> (:*:) f g a
forall a b. (a -> b) -> a -> b
$ (Any -> g a) -> f Any -> f (g a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (g a -> Any -> g a
forall a b. a -> b -> a
const (g a -> Any -> g a) -> g a -> Any -> g a
forall a b. (a -> b) -> a -> b
$ String -> g a
forall a. String -> g a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg) (String -> f Any
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)

 joinMatrix :: (Monad g, Monad f, forall b. Transposable g f b)
  => (f :*: g) ((f :*: g) a) -> (f :*: g) a
 joinMatrix :: forall (g :: * -> *) (f :: * -> *) a.
(Monad g, Monad f, forall b. Transposable g f b) =>
(:*:) f g ((:*:) f g a) -> (:*:) f g a
joinMatrix = f (g a) -> (:*:) f g a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f (g a) -> (:*:) f g a)
-> ((:*:) f g ((:*:) f g a) -> f (g a))
-> (:*:) f g ((:*:) f g a)
-> (:*:) f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (g (g a) -> g a) -> f (g (g a)) -> f (g a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (g a) -> g a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (g (g a)) -> f (g a))
-> ((:*:) f g ((:*:) f g a) -> f (g (g a)))
-> (:*:) f g ((:*:) f g a)
-> f (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (f (g (g a))) -> f (g (g a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (f (g (g a))) -> f (g (g a)))
-> ((:*:) f g ((:*:) f g a) -> f (f (g (g a))))
-> (:*:) f g ((:*:) f g a)
-> f (g (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (g (f (g a)) -> f (g (g a))) -> f (g (f (g a))) -> f (f (g (g a)))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((:*:) f g (g a) -> f (g (g a))
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f g (g a) -> f (g (g a)))
-> (g (f (g a)) -> (:*:) f g (g a)) -> g (f (g a)) -> f (g (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) g f (g a) -> (:*:) f g (g a)
forall (m :: * -> *) (n :: * -> *) a.
Transposable m n a =>
(:*:) m n a -> (:*:) n m a
transposeImpl ((:*:) g f (g a) -> (:*:) f g (g a))
-> (g (f (g a)) -> (:*:) g f (g a))
-> g (f (g a))
-> (:*:) f g (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g (f (g a)) -> (:*:) g f (g a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix) (f (g (f (g a))) -> f (f (g (g a))))
-> ((:*:) f g ((:*:) f g a) -> f (g (f (g a))))
-> (:*:) f g ((:*:) f g a)
-> f (f (g (g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:*:) f g (f (g a)) -> f (g (f (g a)))
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells ((:*:) f g (f (g a)) -> f (g (f (g a))))
-> ((:*:) f g ((:*:) f g a) -> (:*:) f g (f (g a)))
-> (:*:) f g ((:*:) f g a)
-> f (g (f (g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((:*:) f g a -> f (g a))
-> (:*:) f g ((:*:) f g a) -> (:*:) f g (f (g a))
forall a b. (a -> b) -> (:*:) f g a -> (:*:) f g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:*:) f g a -> f (g a)
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
(:*:) f g a -> f (g a)
cells

 instance Transposable IO IO a where
   transposeImpl :: (:*:) IO IO a -> (:*:) IO IO a
transposeImpl = (:*:) IO IO a -> (:*:) IO IO a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

 type Projection f = forall a. f a -> a
 type ElementRemovals f g g' = forall a. f (g a -> g' a)

 data Determinance f g f' g' gg a' a res = Determinance {
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> g (g a -> gg a)
determinanceRemoves1 :: g (g a -> gg a),
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> g (f (gg a) -> f' (g' a'))
determinanceRemoves2 :: g (f (gg a) -> f' (g' a')),
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> Projection f
determinanceCoordProj1 :: Projection f,
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> Projection g
determinanceCoordProj2 :: Projection g,
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> g a -> res
determinanceCombine :: g a -> res,
   forall {k} {k} (f :: * -> *) (g :: * -> *) (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) a res.
Determinance f g f' g' gg a' a res -> (:*:) f' g' a' -> a
determinanceNestedDeterminant :: (f' :*: g') a' -> a
  }

 genericDeterminant :: (Functor f, Applicative g, Num a) =>
     Determinance f g f' g' gg a' a res -> (f :*: g) a -> res
 genericDeterminant :: forall {k} {k} (f :: * -> *) (g :: * -> *) a (f' :: k -> *)
       (g' :: k -> k) (gg :: * -> *) (a' :: k) res.
(Functor f, Applicative g, Num a) =>
Determinance f g f' g' gg a' a res -> (:*:) f g a -> res
genericDeterminant (Determinance g (g a -> gg a)
removes1 g (f (gg a) -> f' (g' a'))
removes2 Projection f
coord_proj1 Projection g
coord_proj2 g a -> res
combine (:*:) f' g' a' -> a
det) (Matrix f (g a)
m)
      = g a -> res
combine (g a -> res) -> g a -> res
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Num a => a -> a -> a
(*) (a -> a -> a) -> g a -> g (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g a) -> g a
Projection f
coord_proj1 f (g a)
m g (a -> a) -> g a -> g a
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a
amv  
    where amv :: g a
amv = ((g a -> gg a) -> a) -> g (g a -> gg a) -> g a
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((:*:) f' g' a' -> a
det ((:*:) f' g' a' -> a)
-> ((g a -> gg a) -> (:*:) f' g' a') -> (g a -> gg a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f' (g' a') -> (:*:) f' g' a'
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix (f' (g' a') -> (:*:) f' g' a')
-> ((g a -> gg a) -> f' (g' a')) -> (g a -> gg a) -> (:*:) f' g' a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g (f (gg a) -> f' (g' a')) -> f (gg a) -> f' (g' a')
Projection g
coord_proj2 g (f (gg a) -> f' (g' a'))
removes2 (f (gg a) -> f' (g' a'))
-> ((g a -> gg a) -> f (gg a)) -> (g a -> gg a) -> f' (g' a')
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((g a -> gg a) -> f (g a) -> f (gg a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` f (g a)
m)) g (g a -> gg a)
removes1

 instance (Num a) => Num (Endo a) where
    + :: Endo a -> Endo a -> Endo a
(+) = Endo a -> Endo a -> Endo a
forall v. VectorSpace v => v -> v -> v
(%+)
    Endo a
x - :: Endo a -> Endo a -> Endo a
- Endo a
y = Endo a
x Endo a -> Endo a -> Endo a
forall v. VectorSpace v => v -> v -> v
%+ Endo a -> Endo a
forall v. VectorSpace v => v -> v
vnegate Endo a
y
    (Endo a -> a
f) * :: Endo a -> Endo a -> Endo a
* (Endo a -> a
g) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
g
    negate :: Endo a -> Endo a
negate (Endo a -> a
f) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
negate (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f
    abs :: Endo a -> Endo a
abs (Endo a -> a
f) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f
    signum :: Endo a -> Endo a
signum Endo a
f = Endo a
f Endo a -> Endo a -> Endo a
forall a. Num a => a -> a -> a
- Endo a -> Endo a
forall a. Num a => a -> a
abs Endo a
f
    fromInteger :: Integer -> Endo a
fromInteger = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (Integer -> a -> a) -> Integer -> Endo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a -> a
forall a b. a -> b -> a
const (a -> a -> a) -> (Integer -> a) -> Integer -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

 instance (Num a) => VectorSpace (Endo a) where
    type Scalar (Endo a) = a
    vzero :: Endo a
vzero = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo (a -> a -> a
forall a b. a -> b -> a
const a
0)
    vnegate :: Endo a -> Endo a
vnegate (Endo a -> a
f) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
negate (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f
    Scalar (Endo a)
a %* :: Scalar (Endo a) -> Endo a -> Endo a
%* (Endo a -> a
f) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ \a
x -> a
Scalar (Endo a)
a a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
f a
x
    (Endo a -> a
f) %+ :: Endo a -> Endo a -> Endo a
%+ (Endo a -> a
g) = (a -> a) -> Endo a
forall {a}. (a -> a) -> Endo a
Endo ((a -> a) -> Endo a) -> (a -> a) -> Endo a
forall a b. (a -> b) -> a -> b
$ \a
x -> a -> a
f a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
g a
x

 instance (Num a) => VectorSpace (((->) row :*: (->) col) a) where
    type Scalar (((->) row :*: (->) col) a) = a
    vzero :: (:*:) ((->) row) ((->) col) a
vzero = (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a)
-> (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall a b. (a -> b) -> a -> b
$ (col -> a) -> row -> (col -> a)
forall a b. a -> b -> a
const ((col -> a) -> row -> (col -> a))
-> (col -> a) -> row -> (col -> a)
forall a b. (a -> b) -> a -> b
$ a -> col -> a
forall a b. a -> b -> a
const a
0
    vnegate :: (:*:) ((->) row) ((->) col) a -> (:*:) ((->) row) ((->) col) a
vnegate (Matrix row -> (col -> a)
m) = (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a)
-> (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall a b. (a -> b) -> a -> b
$ \row
i col
j -> a -> a
forall a. Num a => a -> a
negate (row -> (col -> a)
m row
i col
j)
    (Matrix row -> (col -> a)
m) %+ :: (:*:) ((->) row) ((->) col) a
-> (:*:) ((->) row) ((->) col) a -> (:*:) ((->) row) ((->) col) a
%+ (Matrix row -> (col -> a)
n) = (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a)
-> (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall a b. (a -> b) -> a -> b
$ \row
i col
j -> row -> (col -> a)
m row
i col
j a -> a -> a
forall a. Num a => a -> a -> a
+ row -> (col -> a)
n row
i col
j
    Scalar ((:*:) ((->) row) ((->) col) a)
a %* :: Scalar ((:*:) ((->) row) ((->) col) a)
-> (:*:) ((->) row) ((->) col) a -> (:*:) ((->) row) ((->) col) a
%* (Matrix row -> (col -> a)
m) = (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall {k} {k} (f :: k -> *) (g :: k -> k) (a :: k).
f (g a) -> (:*:) f g a
Matrix ((row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a)
-> (row -> (col -> a)) -> (:*:) ((->) row) ((->) col) a
forall a b. (a -> b) -> a -> b
$ \row
i col
j -> a
Scalar ((:*:) ((->) row) ((->) col) a)
a a -> a -> a
forall a. Num a => a -> a -> a
* row -> (col -> a)
m row
i col
j

 instance (Num a, Universe row, Universe col) => LinearTransform ((->) row) ((->) col) a where
    col -> a
colv <*>> :: (col -> a) -> (:*:) ((->) row) ((->) col) a -> row -> a
<*>> (Matrix row -> (col -> a)
m) = \row
i -> [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [col -> a
colv col
j a -> a -> a
forall a. Num a => a -> a -> a
* row -> (col -> a)
m row
i col
j | col
j <- [col]
forall a. Universe a => [a]
allElements]
    (Matrix row -> (col -> a)
m) <<*> :: (:*:) ((->) row) ((->) col) a -> (row -> a) -> col -> a
<<*> row -> a
rowv = \col
j -> [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [row -> (col -> a)
m row
i col
j a -> a -> a
forall a. Num a => a -> a -> a
* row -> a
rowv row
i | row
i <- [row]
forall a. Universe a => [a]
allElements]

 instance (Floating b, Universe a, ConjugateSymmetric b) => NormedSpace (a -> b) where
    norm :: (a -> b) -> Scalar (a -> b)
norm a -> b
f = b -> b
forall a. Floating a => a -> a
sqrt (a -> b
f (a -> b) -> (a -> b) -> Scalar (a -> b)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. a -> b
f)
    normSquared :: (a -> b) -> Scalar (a -> b)
normSquared a -> b
f = a -> b
f (a -> b) -> (a -> b) -> Scalar (a -> b)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. a -> b
f

 -- | <https://en.wikipedia.org/wiki/Frobenius_inner_product>
 instance (Integral col, Integral row, Universe row, Universe col, Floating a, ConjugateSymmetric a)
  => InnerProductSpace (((->) row :*: (->) col) a) where
    (Matrix row -> (col -> a)
m) %. :: (:*:) ((->) row) ((->) col) a
-> (:*:) ((->) row) ((->) col) a
-> Scalar ((:*:) ((->) row) ((->) col) a)
%. (Matrix row -> (col -> a)
n) = [Scalar ((:*:) ((->) row) ((->) col) a)]
-> Scalar ((:*:) ((->) row) ((->) col) a)
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Scalar ((:*:) ((->) row) ((->) col) a)]
 -> Scalar ((:*:) ((->) row) ((->) col) a))
-> [Scalar ((:*:) ((->) row) ((->) col) a)]
-> Scalar ((:*:) ((->) row) ((->) col) a)
forall a b. (a -> b) -> a -> b
$
       [a -> a
forall m. ConjugateSymmetric m => m -> m
conj (row -> (col -> a)
m row
i col
j) a -> a -> a
forall a. Num a => a -> a -> a
* (row -> (col -> a)
n row
i col
j) | row
i <- [row]
forall a. Universe a => [a]
allElements, col
j <- [col]
forall a. Universe a => [a]
allElements]

 instance (Integral row, Integral col, Floating a, Universe row, Universe col, ConjugateSymmetric a)
  => NormedSpace (((->) row :*: (->) col) a) where
    norm :: (:*:) ((->) row) ((->) col) a
-> Scalar ((:*:) ((->) row) ((->) col) a)
norm (:*:) ((->) row) ((->) col) a
m = a -> a
forall a. Floating a => a -> a
sqrt ((:*:) ((->) row) ((->) col) a
m (:*:) ((->) row) ((->) col) a
-> (:*:) ((->) row) ((->) col) a
-> Scalar ((:*:) ((->) row) ((->) col) a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. (:*:) ((->) row) ((->) col) a
m)
    normSquared :: (:*:) ((->) row) ((->) col) a
-> Scalar ((:*:) ((->) row) ((->) col) a)
normSquared (:*:) ((->) row) ((->) col) a
m = (:*:) ((->) row) ((->) col) a
m (:*:) ((->) row) ((->) col) a
-> (:*:) ((->) row) ((->) col) a
-> Scalar ((:*:) ((->) row) ((->) col) a)
forall m. InnerProductSpace m => m -> m -> Scalar m
%. (:*:) ((->) row) ((->) col) a
m

 instance MetricSpace (Ratio Integer) where
    type Distance (Ratio Integer) = Ratio Integer
    distance :: Ratio Integer -> Ratio Integer -> Distance (Ratio Integer)
distance Ratio Integer
x Ratio Integer
y = Ratio Integer -> Ratio Integer
forall a. Num a => a -> a
abs (Ratio Integer
x Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
- Ratio Integer
y)
 instance MetricSpace Integer where
    type Distance Integer = Integer
    distance :: Integer -> Integer -> Distance Integer
distance Integer
x Integer
y = Integer -> Integer
forall a. Num a => a -> a
abs (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y)
  
 instance MetricSpace Int where
    type Distance Int = Word
    distance :: Int -> Int -> Distance Int
distance Int
x Int
y = Int -> Distance Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Distance Int) -> Int -> Distance Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)

 instance MetricSpace Int8 where
    type Distance Int8 = Word8
    distance :: Int8 -> Int8 -> Distance Int8
distance Int8
x Int8
y = Int8 -> Distance Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Distance Int8) -> Int8 -> Distance Int8
forall a b. (a -> b) -> a -> b
$ Int8 -> Int8
forall a. Num a => a -> a
abs (Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
y)

 instance MetricSpace Int16 where
    type Distance Int16 = Word16
    distance :: Int16 -> Int16 -> Distance Int16
distance Int16
x Int16
y = Int16 -> Distance Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Distance Int16) -> Int16 -> Distance Int16
forall a b. (a -> b) -> a -> b
$ Int16 -> Int16
forall a. Num a => a -> a
abs (Int16
x Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
y)

 instance MetricSpace Int32 where
    type Distance Int32 = Word32
    distance :: Int32 -> Int32 -> Distance Int32
distance Int32
x Int32
y = Int32 -> Distance Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Distance Int32) -> Int32 -> Distance Int32
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32
forall a. Num a => a -> a
abs (Int32
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
y)

 instance MetricSpace Int64 where
    type Distance Int64 = Word64
    distance :: Int64 -> Int64 -> Distance Int64
distance Int64
x Int64
y = Int64 -> Distance Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Distance Int64) -> Int64 -> Distance Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
abs (Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
y)

 instance MetricSpace Double where
   type Distance Double = Double
   distance :: Double -> Double -> Distance Double
distance Double
x Double
y = Double -> Double
forall a. Num a => a -> a
abs(Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)
   
 instance MetricSpace Float where
   type Distance Float = Float
   distance :: Float -> Float -> Distance Float
distance Float
x Float
y = Float -> Float
forall a. Num a => a -> a
abs(Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y)

 instance AdditiveIdentity Integer where { additiveIdentity :: Integer
additiveIdentity = Integer
0 }
 instance AdditiveIdentity Int where { additiveIdentity :: Int
additiveIdentity = Int
0 }
 instance AdditiveIdentity Word where { additiveIdentity :: Word
additiveIdentity = Word
0 }
 instance AdditiveIdentity Float where { additiveIdentity :: Float
additiveIdentity = Float
0 }
 instance AdditiveIdentity Double where { additiveIdentity :: Double
additiveIdentity = Double
0 }

 instance MultiplicativeIdentity Integer where { multiplicativeIdentity :: Integer
multiplicativeIdentity = Integer
1 }
 instance MultiplicativeIdentity Int where { multiplicativeIdentity :: Int
multiplicativeIdentity = Int
1 }
 instance MultiplicativeIdentity Word where { multiplicativeIdentity :: Word
multiplicativeIdentity = Word
1 }
 instance MultiplicativeIdentity Float where { multiplicativeIdentity :: Float
multiplicativeIdentity = Float
1 }
 instance MultiplicativeIdentity Double where { multiplicativeIdentity :: Double
multiplicativeIdentity = Double
1 }