-- Copyright (c) 2010-2015, David Amos. All rights reserved.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_HADDOCK prune #-}

-- |A module defining the type and operations of free k-vector spaces over a basis b (for a field k)
module Math.Algebras.VectorSpace where

import Prelude hiding (  (<*), (*>) )

import Control.Applicative hiding ( (<*), (*>) )
import Control.Monad (ap)
import qualified Data.List as L
import qualified Data.Set as S -- only needed for toSet

infixr 7 *>
infixl 7 <*
infixl 6 <+>, <->, <<+>>, <<->>


-- |Given a field type k and a basis type b, Vect k b is the type of the free k-vector space over b.
-- Elements (values) of Vect k b consist of k-linear combinations of elements (values) of b.
--
-- In order for Vect k b to be a vector space, it is necessary that k is a field (that is, an instance of Fractional).
-- In practice, we often relax this condition, and require that k is a ring (that is, an instance of Num). In that case,
-- Vect k b should more correctly be called (the type of) the free k-module over b.
--
-- Most of the code requires that b is an instance of Ord. This is primarily to enable us to simplify to a normal form.
newtype Vect k b = V [(b,k)] deriving (Vect k b -> Vect k b -> Bool
(Vect k b -> Vect k b -> Bool)
-> (Vect k b -> Vect k b -> Bool) -> Eq (Vect k b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k b. (Eq b, Eq k) => Vect k b -> Vect k b -> Bool
/= :: Vect k b -> Vect k b -> Bool
$c/= :: forall k b. (Eq b, Eq k) => Vect k b -> Vect k b -> Bool
== :: Vect k b -> Vect k b -> Bool
$c== :: forall k b. (Eq b, Eq k) => Vect k b -> Vect k b -> Bool
Eq,Eq (Vect k b)
Eq (Vect k b) =>
(Vect k b -> Vect k b -> Ordering)
-> (Vect k b -> Vect k b -> Bool)
-> (Vect k b -> Vect k b -> Bool)
-> (Vect k b -> Vect k b -> Bool)
-> (Vect k b -> Vect k b -> Bool)
-> (Vect k b -> Vect k b -> Vect k b)
-> (Vect k b -> Vect k b -> Vect k b)
-> Ord (Vect k b)
Vect k b -> Vect k b -> Bool
Vect k b -> Vect k b -> Ordering
Vect k b -> Vect k b -> Vect k b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k b. (Ord b, Ord k) => Eq (Vect k b)
forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Bool
forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Ordering
forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Vect k b
min :: Vect k b -> Vect k b -> Vect k b
$cmin :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Vect k b
max :: Vect k b -> Vect k b -> Vect k b
$cmax :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Vect k b
>= :: Vect k b -> Vect k b -> Bool
$c>= :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Bool
> :: Vect k b -> Vect k b -> Bool
$c> :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Bool
<= :: Vect k b -> Vect k b -> Bool
$c<= :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Bool
< :: Vect k b -> Vect k b -> Bool
$c< :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Bool
compare :: Vect k b -> Vect k b -> Ordering
$ccompare :: forall k b. (Ord b, Ord k) => Vect k b -> Vect k b -> Ordering
$cp1Ord :: forall k b. (Ord b, Ord k) => Eq (Vect k b)
Ord)

instance (Show k, Eq k, Num k, Show b) => Show (Vect k b) where
    show :: Vect k b -> String
show (V []) = "0"
    show (V ts :: [(b, k)]
ts) = [String] -> String
concatWithPlus ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((b, k) -> String) -> [(b, k)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (b, k) -> String
forall a a. (Show a, Show a) => (a, a) -> String
showTerm [(b, k)]
ts
        where showTerm :: (a, a) -> String
showTerm (b :: a
b,x :: a
x) | a -> String
forall a. Show a => a -> String
show a
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "1" = a -> String
forall a. Show a => a -> String
show a
x
                             | a -> String
forall a. Show a => a -> String
show a
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "1" = a -> String
forall a. Show a => a -> String
show a
b
                             | a -> String
forall a. Show a => a -> String
show a
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-1" = "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b
                             | Bool
otherwise = (if String -> Bool
isAtomic (a -> String
forall a. Show a => a -> String
show a
x) then a -> String
forall a. Show a => a -> String
show a
x else "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")") String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           a -> String
forall a. Show a => a -> String
show a
b
                                           -- (if ' ' `notElem` show b then show b else "(" ++ show b ++ ")")
                                           -- if we put this here we miss the two cases above
              concatWithPlus :: [String] -> String
concatWithPlus (t1 :: String
t1:t2 :: String
t2:ts :: [String]
ts) = if String -> Char
forall a. [a] -> a
head String
t2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'
                                          then String
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
concatWithPlus (String
t2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ts)
                                          else String
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ '+' Char -> ShowS
forall a. a -> [a] -> [a]
: [String] -> String
concatWithPlus (String
t2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ts)
              concatWithPlus [t :: String
t] = String
t
              isAtomic :: String -> Bool
isAtomic (c :: Char
c:cs :: String
cs) = String -> Bool
isAtomic' String
cs
              isAtomic' :: String -> Bool
isAtomic' ('^':'-':cs :: String
cs) = String -> Bool
isAtomic' String
cs
              isAtomic' ('+':cs :: String
cs) = Bool
False
              isAtomic' ('-':cs :: String
cs) = Bool
False
              isAtomic' (c :: Char
c:cs :: String
cs) = String -> Bool
isAtomic' String
cs
              isAtomic' [] = Bool
True

terms :: Vect k b -> [(b, k)]
terms (V ts :: [(b, k)]
ts) = [(b, k)]
ts

-- |Return the coefficient of the specified basis element in a vector
coeff :: (Num k, Eq b) => b -> Vect k b -> k
coeff :: b -> Vect k b -> k
coeff b :: b
b v :: Vect k b
v = [k] -> k
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [k
k | (b' :: b
b',k :: k
k) <- Vect k b -> [(b, k)]
forall k b. Vect k b -> [(b, k)]
terms Vect k b
v, b
b' b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b]

-- |Remove the term for a specified basis element from a vector
removeTerm :: (Eq k, Num k, Ord b) => b -> Vect k b -> Vect k b
removeTerm :: b -> Vect k b -> Vect k b
removeTerm b :: b
b (V ts :: [(b, k)]
ts) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ ((b, k) -> Bool) -> [(b, k)] -> [(b, k)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/=b
b) (b -> Bool) -> ((b, k) -> b) -> (b, k) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, k) -> b
forall a b. (a, b) -> a
fst) [(b, k)]
ts
-- v <-> coeff b v *> return b

-- |The zero vector
zerov :: Vect k b
zerov :: Vect k b
zerov = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V []

-- |Addition of vectors
add :: (Eq k, Num k, Ord b) => Vect k b -> Vect k b -> Vect k b
add :: Vect k b -> Vect k b -> Vect k b
add (V ts :: [(b, k)]
ts) (V us :: [(b, k)]
us) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ [(b, k)] -> [(b, k)] -> [(b, k)]
forall a b.
(Ord a, Num b, Eq b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(b, k)]
ts [(b, k)]
us

-- |Addition of vectors (same as add)
(<+>) :: (Eq k, Num k, Ord b) => Vect k b -> Vect k b -> Vect k b
<+> :: Vect k b -> Vect k b -> Vect k b
(<+>) = Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
add

addmerge :: [(a, b)] -> [(a, b)] -> [(a, b)]
addmerge ((a :: a
a,x :: b
x):ts :: [(a, b)]
ts) ((b :: a
b,y :: b
y):us :: [(a, b)]
us) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
    LT -> (a
a,b
x) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(a, b)]
ts ((a
b,b
y)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
us)
    EQ -> if b
xb -> b -> b
forall a. Num a => a -> a -> a
+b
y b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(a, b)]
ts [(a, b)]
us else (a
a,b
xb -> b -> b
forall a. Num a => a -> a -> a
+b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(a, b)]
ts [(a, b)]
us
    GT -> (a
b,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
addmerge ((a
a,b
x)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ts) [(a, b)]
us
addmerge ts :: [(a, b)]
ts [] = [(a, b)]
ts
addmerge [] us :: [(a, b)]
us = [(a, b)]
us

-- |Sum of a list of vectors
sumv :: (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv :: [Vect k b] -> Vect k b
sumv = (Vect k b -> Vect k b -> Vect k b)
-> Vect k b -> [Vect k b] -> Vect k b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
(<+>) Vect k b
forall k b. Vect k b
zerov

-- |Negation of a vector
negatev :: (Eq k, Num k) => Vect k b -> Vect k b
negatev :: Vect k b -> Vect k b
negatev (V ts :: [(b, k)]
ts) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ ((b, k) -> (b, k)) -> [(b, k)] -> [(b, k)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b :: b
b,x :: k
x) -> (b
b,-k
x)) [(b, k)]
ts

-- |Subtraction of vectors
(<->) :: (Eq k, Num k, Ord b) => Vect k b -> Vect k b -> Vect k b
<-> :: Vect k b -> Vect k b -> Vect k b
(<->) u :: Vect k b
u v :: Vect k b
v = Vect k b
u Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
<+> Vect k b -> Vect k b
forall k b. (Eq k, Num k) => Vect k b -> Vect k b
negatev Vect k b
v

-- |Scalar multiplication (on the left)
smultL :: (Eq k, Num k) => k -> Vect k b -> Vect k b
smultL :: k -> Vect k b -> Vect k b
smultL 0 _ = Vect k b
forall k b. Vect k b
zerov -- V []
smultL k :: k
k (V ts :: [(b, k)]
ts) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b
ei,k
kk -> k -> k
forall a. Num a => a -> a -> a
*k
xi) | (ei :: b
ei,xi :: k
xi) <- [(b, k)]
ts]

-- |Same as smultL. Mnemonic is \"multiply through (from the left)\"
(*>) :: (Eq k, Num k) => k -> Vect k b -> Vect k b
*> :: k -> Vect k b -> Vect k b
(*>) = k -> Vect k b -> Vect k b
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
smultL

-- |Scalar multiplication on the right
smultR :: (Eq k, Num k) => Vect k b -> k -> Vect k b
smultR :: Vect k b -> k -> Vect k b
smultR _ 0 = Vect k b
forall k b. Vect k b
zerov -- V []
smultR (V ts :: [(b, k)]
ts) k :: k
k = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b
ei,k
xik -> k -> k
forall a. Num a => a -> a -> a
*k
k) | (ei :: b
ei,xi :: k
xi) <- [(b, k)]
ts]

-- |Same as smultR. Mnemonic is \"multiply through (from the right)\"
(<*) :: (Eq k, Num k) => Vect k b -> k -> Vect k b
<* :: Vect k b -> k -> Vect k b
(<*) = Vect k b -> k -> Vect k b
forall k b. (Eq k, Num k) => Vect k b -> k -> Vect k b
smultR

-- same as return
-- injection of basis elt into vector space
-- inject b = V [(b,1)]

-- same as fmap
-- liftFromBasis f (V ts) = V [(f b, x) | (b, x) <- ts]
-- if f is not order-preserving, then you need to call nf afterwards

-- |Convert an element of Vect k b into normal form. Normal form consists in having the basis elements in ascending order,
-- with no duplicates, and all coefficients non-zero
nf :: (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf :: Vect k b -> Vect k b
nf (V ts :: [(b, k)]
ts) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ [(b, k)] -> [(b, k)]
forall a a. (Ord a, Num a, Eq a) => [(a, a)] -> [(a, a)]
nf' ([(b, k)] -> [(b, k)]) -> [(b, k)] -> [(b, k)]
forall a b. (a -> b) -> a -> b
$ ((b, k) -> (b, k) -> Ordering) -> [(b, k)] -> [(b, k)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (b, k) -> (b, k) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
compareFst [(b, k)]
ts where
    nf' :: [(a, a)] -> [(a, a)]
nf' ((b1 :: a
b1,x1 :: a
x1):(b2 :: a
b2,x2 :: a
x2):ts :: [(a, a)]
ts) =
        case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
b1 a
b2 of
        LT -> if a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [(a, a)] -> [(a, a)]
nf' ((a
b2,a
x2)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts) else (a
b1,a
x1) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)]
nf' ((a
b2,a
x2)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts)
        EQ -> if a
x1a -> a -> a
forall a. Num a => a -> a -> a
+a
x2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [(a, a)] -> [(a, a)]
nf' [(a, a)]
ts else [(a, a)] -> [(a, a)]
nf' ((a
b1,a
x1a -> a -> a
forall a. Num a => a -> a -> a
+a
x2)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts)
        GT -> String -> [(a, a)]
forall a. HasCallStack => String -> a
error "nf': not pre-sorted"
    nf' [(b :: a
b,x :: a
x)] = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else [(a
b,a
x)]
    nf' [] = []
    compareFst :: (a, b) -> (a, b) -> Ordering
compareFst (b1 :: a
b1,x1 :: b
x1) (b2 :: a
b2,x2 :: b
x2) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
b1 a
b2
    -- compareFst = curry ( uncurry compare . (fst *** fst) )


-- |Given a field k, (Vect k) is a functor, the \"free k-vector space\" functor.
--
-- In the mathematical sense, this can be regarded as a functor from the category Set (of sets) to the category k-Vect
-- (of k-vector spaces). In Haskell, instead of Set we have Hask, the category of Haskell types. However, for our purposes
-- it is helpful to identify Hask with Set, by identifying a Haskell type with its set of inhabitants.
--
-- The type constructor (Vect k) gives the action of the functor on objects in the category,
-- taking a set (type) to a free k-vector space. fmap gives the action of the functor on arrows in the category,
-- taking a function between sets (types) to a linear map between vector spaces.
--
-- Note that if f is not order-preserving, then (fmap f) is not guaranteed to return results in normal form,
-- so it may be preferable to use (nf . fmap f).
instance Functor (Vect k) where
    -- lift a function on the basis to a function on the vector space
    fmap :: (a -> b) -> Vect k a -> Vect k b
fmap f :: a -> b
f (V ts :: [(a, k)]
ts) = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(a -> b
f a
b, k
x) | (b :: a
b,x :: k
x) <- [(a, k)]
ts]
-- Note that if f is not order-preserving, then we need to call "nf" afterwards

-- From GHC 7.10, Monad has Applicative as a superclass, so we must define an instance.
-- It doesn't particularly make sense for Vect k.
-- (Although given Vect k b, we could represent the dual space as Vect k (b -> ()),
-- and then have a use for <*>.)
instance Num k => Applicative (Vect k) where
    pure :: a -> Vect k a
pure = a -> Vect k a
forall (m :: * -> *) a. Monad m => a -> m a
return
    -- pure b = V [(b,1)]
    <*> :: Vect k (a -> b) -> Vect k a -> Vect k b
(<*>) = Vect k (a -> b) -> Vect k a -> Vect k b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    -- V fs <*> V xs = V [(f x, a*b) | (f,a) <- fs, (x,b) <- xs]

-- |Given a field k, the type constructor (Vect k) is a monad, the \"free k-vector space monad\".
--
-- In order to understand this, it is probably easiest to think of a free k-vector space as a kind of container,
-- a bit like a list, except that order doesn't matter, and you're allowed arbitrary (even negative or fractional)
-- quantities of the basis elements in the container.
--
-- According to this way of thinking, return is the function that puts a basis element into the vector space (container).
--
-- Given a function f from the basis of one vector space to another vector space (a -> Vect k b),
-- bind (>>=) lifts it to a function (>>= f) from the first vector space to the second (Vect k a -> Vect k b).
--
-- Note that in general (>>= f) applied to a vector will not return a result in normal form,
-- so it is usually preferable to use (linear f) instead.
instance Num k => Monad (Vect k) where
    return :: a -> Vect k a
return a :: a
a = [(a, k)] -> Vect k a
forall k b. [(b, k)] -> Vect k b
V [(a
a,1)]
    -- V ts >>= f = V $ concat [ [(b,y*x) | let V us = f a, (b,y) <- us] | (a,x) <- ts]
    V ts :: [(a, k)]
ts >>= :: Vect k a -> (a -> Vect k b) -> Vect k b
>>= f :: a -> Vect k b
f = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ [ (b
b,k
yk -> k -> k
forall a. Num a => a -> a -> a
*k
x) | (a :: a
a,x :: k
x) <- [(a, k)]
ts, let V us :: [(b, k)]
us = a -> Vect k b
f a
a, (b :: b
b,y :: k
y) <- [(b, k)]
us]
    -- Note that as we can't assume Ord a in the Monad instance, we need to call "nf" afterwards

-- |A linear map between vector spaces A and B can be defined by giving its action on the basis elements of A.
-- The action on all elements of A then follows by linearity.
--
-- If we have A = Vect k a, B = Vect k b, and f :: a -> Vect k b is a function from the basis elements of A into B,
-- then @linear f@ is the linear map that this defines by linearity.
linear :: (Eq k, Num k, Ord b) => (a -> Vect k b) -> Vect k a -> Vect k b
linear :: (a -> Vect k b) -> Vect k a -> Vect k b
linear f :: a -> Vect k b
f v :: Vect k a
v = Vect k b -> Vect k b
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k b -> Vect k b) -> Vect k b -> Vect k b
forall a b. (a -> b) -> a -> b
$ Vect k a
v Vect k a -> (a -> Vect k b) -> Vect k b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Vect k b
f

newtype EBasis = E Int deriving (EBasis -> EBasis -> Bool
(EBasis -> EBasis -> Bool)
-> (EBasis -> EBasis -> Bool) -> Eq EBasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EBasis -> EBasis -> Bool
$c/= :: EBasis -> EBasis -> Bool
== :: EBasis -> EBasis -> Bool
$c== :: EBasis -> EBasis -> Bool
Eq,Eq EBasis
Eq EBasis =>
(EBasis -> EBasis -> Ordering)
-> (EBasis -> EBasis -> Bool)
-> (EBasis -> EBasis -> Bool)
-> (EBasis -> EBasis -> Bool)
-> (EBasis -> EBasis -> Bool)
-> (EBasis -> EBasis -> EBasis)
-> (EBasis -> EBasis -> EBasis)
-> Ord EBasis
EBasis -> EBasis -> Bool
EBasis -> EBasis -> Ordering
EBasis -> EBasis -> EBasis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EBasis -> EBasis -> EBasis
$cmin :: EBasis -> EBasis -> EBasis
max :: EBasis -> EBasis -> EBasis
$cmax :: EBasis -> EBasis -> EBasis
>= :: EBasis -> EBasis -> Bool
$c>= :: EBasis -> EBasis -> Bool
> :: EBasis -> EBasis -> Bool
$c> :: EBasis -> EBasis -> Bool
<= :: EBasis -> EBasis -> Bool
$c<= :: EBasis -> EBasis -> Bool
< :: EBasis -> EBasis -> Bool
$c< :: EBasis -> EBasis -> Bool
compare :: EBasis -> EBasis -> Ordering
$ccompare :: EBasis -> EBasis -> Ordering
$cp1Ord :: Eq EBasis
Ord)

instance Show EBasis where show :: EBasis -> String
show (E i :: Int
i) = "e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

e :: Int -> m EBasis
e i :: Int
i = EBasis -> m EBasis
forall (m :: * -> *) a. Monad m => a -> m a
return (EBasis -> m EBasis) -> EBasis -> m EBasis
forall a b. (a -> b) -> a -> b
$ Int -> EBasis
E Int
i
e1 :: m EBasis
e1 = Int -> m EBasis
forall (m :: * -> *). Monad m => Int -> m EBasis
e 1
e2 :: m EBasis
e2 = Int -> m EBasis
forall (m :: * -> *). Monad m => Int -> m EBasis
e 2
e3 :: m EBasis
e3 = Int -> m EBasis
forall (m :: * -> *). Monad m => Int -> m EBasis
e 3

-- dual (E i) = E (-i)


-- |Trivial k is the field k considered as a k-vector space. In maths, we would not normally make a distinction here,
-- but in the code, we need this if we want to be able to put k as one side of a tensor product.
type Trivial k = Vect k ()

-- |Wrap an element of the field k to an element of the trivial k-vector space
wrap :: (Eq k, Num k) => k -> Vect k ()
wrap :: k -> Vect k ()
wrap 0 = Vect k ()
forall k b. Vect k b
zerov
wrap x :: k
x = [((), k)] -> Vect k ()
forall k b. [(b, k)] -> Vect k b
V [( (),k
x)]

-- |Unwrap an element of the trivial k-vector space to an element of the field k
unwrap :: Num k => Vect k () -> k
unwrap :: Vect k () -> k
unwrap (V []) = 0
unwrap (V [( (),x :: k
x)]) = k
x

-- |Given a finite vector space basis b, Dual b can be used to represent a basis for the dual vector space.
-- The intention is that for a given individual basis element b_i, (Dual b_i) represents the indicator function for b_i,
-- which takes b_i to 1 and all other basis elements to 0.
--
-- (Note that if the basis b is infinite, then Dual b may only represent a sub-basis of the dual vector space.)
newtype Dual b = Dual b deriving (Dual b -> Dual b -> Bool
(Dual b -> Dual b -> Bool)
-> (Dual b -> Dual b -> Bool) -> Eq (Dual b)
forall b. Eq b => Dual b -> Dual b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dual b -> Dual b -> Bool
$c/= :: forall b. Eq b => Dual b -> Dual b -> Bool
== :: Dual b -> Dual b -> Bool
$c== :: forall b. Eq b => Dual b -> Dual b -> Bool
Eq,Eq (Dual b)
Eq (Dual b) =>
(Dual b -> Dual b -> Ordering)
-> (Dual b -> Dual b -> Bool)
-> (Dual b -> Dual b -> Bool)
-> (Dual b -> Dual b -> Bool)
-> (Dual b -> Dual b -> Bool)
-> (Dual b -> Dual b -> Dual b)
-> (Dual b -> Dual b -> Dual b)
-> Ord (Dual b)
Dual b -> Dual b -> Bool
Dual b -> Dual b -> Ordering
Dual b -> Dual b -> Dual b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b. Ord b => Eq (Dual b)
forall b. Ord b => Dual b -> Dual b -> Bool
forall b. Ord b => Dual b -> Dual b -> Ordering
forall b. Ord b => Dual b -> Dual b -> Dual b
min :: Dual b -> Dual b -> Dual b
$cmin :: forall b. Ord b => Dual b -> Dual b -> Dual b
max :: Dual b -> Dual b -> Dual b
$cmax :: forall b. Ord b => Dual b -> Dual b -> Dual b
>= :: Dual b -> Dual b -> Bool
$c>= :: forall b. Ord b => Dual b -> Dual b -> Bool
> :: Dual b -> Dual b -> Bool
$c> :: forall b. Ord b => Dual b -> Dual b -> Bool
<= :: Dual b -> Dual b -> Bool
$c<= :: forall b. Ord b => Dual b -> Dual b -> Bool
< :: Dual b -> Dual b -> Bool
$c< :: forall b. Ord b => Dual b -> Dual b -> Bool
compare :: Dual b -> Dual b -> Ordering
$ccompare :: forall b. Ord b => Dual b -> Dual b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (Dual b)
Ord)

instance Show basis => Show (Dual basis) where
    show :: Dual basis -> String
show (Dual b :: basis
b) = basis -> String
forall a. Show a => a -> String
show basis
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"


e' :: Int -> m (Dual EBasis)
e' i :: Int
i = Dual EBasis -> m (Dual EBasis)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dual EBasis -> m (Dual EBasis)) -> Dual EBasis -> m (Dual EBasis)
forall a b. (a -> b) -> a -> b
$ EBasis -> Dual EBasis
forall b. b -> Dual b
Dual (EBasis -> Dual EBasis) -> EBasis -> Dual EBasis
forall a b. (a -> b) -> a -> b
$ Int -> EBasis
E Int
i
e1' :: m (Dual EBasis)
e1' = Int -> m (Dual EBasis)
forall (m :: * -> *). Monad m => Int -> m (Dual EBasis)
e' 1
e2' :: m (Dual EBasis)
e2' = Int -> m (Dual EBasis)
forall (m :: * -> *). Monad m => Int -> m (Dual EBasis)
e' 2
e3' :: m (Dual EBasis)
e3' = Int -> m (Dual EBasis)
forall (m :: * -> *). Monad m => Int -> m (Dual EBasis)
e' 3

dual :: Vect k b -> Vect k (Dual b)
dual :: Vect k b -> Vect k (Dual b)
dual = (b -> Dual b) -> Vect k b -> Vect k (Dual b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Dual b
forall b. b -> Dual b
Dual


(f :: t -> Vect k b
f <<+>> :: (t -> Vect k b) -> (t -> Vect k b) -> t -> Vect k b
<<+>> g :: t -> Vect k b
g) v :: t
v = t -> Vect k b
f t
v Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
<+> t -> Vect k b
g t
v

(f :: t -> Vect k b
f <<->> :: (t -> Vect k b) -> (t -> Vect k b) -> t -> Vect k b
<<->> g :: t -> Vect k b
g) v :: t
v = t -> Vect k b
f t
v Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
<-> t -> Vect k b
g t
v

zerof :: p -> Vect k b
zerof v :: p
v = Vect k b
forall k b. Vect k b
zerov

sumf :: t (t -> Vect k b) -> t -> Vect k b
sumf fs :: t (t -> Vect k b)
fs = ((t -> Vect k b) -> (t -> Vect k b) -> t -> Vect k b)
-> (t -> Vect k b) -> t (t -> Vect k b) -> t -> Vect k b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (t -> Vect k b) -> (t -> Vect k b) -> t -> Vect k b
forall k b t.
(Num k, Ord b, Eq k) =>
(t -> Vect k b) -> (t -> Vect k b) -> t -> Vect k b
(<<+>>) t -> Vect k b
forall p k b. p -> Vect k b
zerof t (t -> Vect k b)
fs


-- Lens
coeffLens :: (Ord b, Eq k, Num k, Functor f) => b -> (k -> f k) -> (Vect k b -> f (Vect k b))
coeffLens :: b -> (k -> f k) -> Vect k b -> f (Vect k b)
coeffLens b :: b
b = (Vect k b -> k)
-> (Vect k b -> k -> Vect k b)
-> (k -> f k)
-> Vect k b
-> f (Vect k b)
forall (f :: * -> *) t t a b.
Functor f =>
(t -> t) -> (t -> a -> b) -> (t -> f a) -> t -> f b
lens (b -> Vect k b -> k
forall k b. (Num k, Eq b) => b -> Vect k b -> k
coeff b
b) (b -> Vect k b -> k -> Vect k b
forall k b. (Num k, Ord b, Eq k) => b -> Vect k b -> k -> Vect k b
setter b
b)
    where setter :: b -> Vect k b -> k -> Vect k b
setter b :: b
b = \(V ts :: [(b, k)]
ts) k :: k
k -> (k
k k -> Vect k b -> Vect k b
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> b -> Vect k b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b) Vect k b -> Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b) =>
Vect k b -> Vect k b -> Vect k b
<+> ([(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ ((b, k) -> Bool) -> [(b, k)] -> [(b, k)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/=b
b) (b -> Bool) -> ((b, k) -> b) -> (b, k) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, k) -> b
forall a b. (a, b) -> a
fst) [(b, k)]
ts)
          lens :: (t -> t) -> (t -> a -> b) -> (t -> f a) -> t -> f b
lens getter :: t -> t
getter setter :: t -> a -> b
setter f :: t -> f a
f a :: t
a = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> a -> b
setter t
a) (t -> f a
f (t -> t
getter t
a))
-- Can be used with lens-family, for example
-- e1 ^. coeffLens (E 2) --> 0
-- e1 & coeffLens (E 2) .~ 2 --> e1+2e2
-- e1 & coeffLens (E 1) %~ (+2) --> 3e1