module Math.Algebras.Quaternions where
import Math.Algebra.Field.Base
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
import Math.Algebras.Structures
data HBasis = One | I | J | K deriving (Eq,Ord)
type Quaternion k = Vect k HBasis
instance Show HBasis where
show One = "1"
show I = "i"
show J = "j"
show K = "k"
instance (Num k) => Algebra k HBasis where
unit x = x *> return One
mult = linear mult'
where mult' (One,b) = return b
mult' (b,One) = return b
mult' (I,I) = unit (1)
mult' (J,J) = unit (1)
mult' (K,K) = unit (1)
mult' (I,J) = return K
mult' (J,I) = 1 *> return K
mult' (J,K) = return I
mult' (K,J) = 1 *> return I
mult' (K,I) = return J
mult' (I,K) = 1 *> return J
i,j,k :: Num k => Quaternion k
i = return I
j = return J
k = return K
one',i',j',k' :: Num k => Vect k (Dual HBasis)
one' = return (Dual One)
i' = return (Dual I)
j' = return (Dual J)
k' = return (Dual K)
instance Num k => Coalgebra k (Dual HBasis) where
counit = unwrap . linear counit'
where counit' (Dual One) = return ()
counit' _ = zero
comult = linear comult'
where comult' (Dual One) = return (Dual One, Dual One) <+>
(1) *> ( return (Dual I, Dual I) <+> return (Dual J, Dual J) <+> return (Dual K, Dual K) )
comult' (Dual I) = return (Dual One, Dual I) <+> return (Dual I, Dual One) <+>
return (Dual J, Dual K) <+> (1) *> return (Dual K, Dual J)
comult' (Dual J) = return (Dual One, Dual J) <+> return (Dual J, Dual One) <+>
return (Dual K, Dual I) <+> (1) *> return (Dual I, Dual K)
comult' (Dual K) = return (Dual One, Dual K) <+> return (Dual K, Dual One) <+>
return (Dual I, Dual J) <+> (1) *> return (Dual J, Dual I)