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

{-# 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)