```-- 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 (T One b) = return b
m (T b One) = return b
m (T I I) = unit (-1)
m (T J J) = unit (-1)
m (T K K) = unit (-1)
m (T I J) = return K
m (T J I) = -1 *> return K
m (T J K) = return I
m (T K J) = -1 *> return I
m (T K I) = return J
m (T 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 (T m m) else return (T m One) <+> return (T One m)
```