{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, NoMonomorphismRestriction #-}

module Math.Algebras.Quaternions where

import Math.Algebra.Field.Base
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
import Math.Algebras.Structures

-- QUATERNIONS

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 0 = zero -- V []
unit x = V [(One,x)]
-- mult x = nf (x >>= m)
mult = linear m
where m (One,b) = return b
m (b,One) = return b
m (I,I) = unit (-1)
m (J,J) = unit (-1)
m (K,K) = unit (-1)
m (I,J) = return K
m (J,I) = -1 *> return K
m (J,K) = return I
m (K,J) = -1 *> return I
m (K,I) = return J
m (I,K) = -1 *> return J

i,j,k :: Num k => Quaternion k
i = return I
j = return J
k = return K

{-
-- Set coalgebra instance
instance Num k => Coalgebra k HBasis where
counit (V ts) = sum [x | (m,x) <- ts] -- trace
comult = fmap (\m -> T m m)           -- diagonal
-}

instance Num k => Coalgebra k HBasis where
counit (V ts) = sum [x | (One,x) <- ts]
comult = linear cm
where cm m = if m == One then return (m,m) else return (m,One) <+> return (One,m)