diff --git a/Numeric/Additive/Group.hs b/Numeric/Additive/Group.hs
--- a/Numeric/Additive/Group.hs
+++ b/Numeric/Additive/Group.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeOperators #-}
 module Numeric.Additive.Group
   ( -- * Additive Groups
     Group(..)
@@ -6,7 +6,9 @@
 
 import Data.Int
 import Data.Word
-import Prelude hiding ((*), (+), (-), negate, subtract)
+import Data.Key
+import Data.Functor.Representable.Trie
+import Prelude hiding ((*), (+), (-), negate, subtract,zipWith)
 import qualified Prelude
 import Numeric.Additive.Class
 import Numeric.Algebra.Class
@@ -42,6 +44,12 @@
   negate f x = negate (f x)
   subtract f g x = subtract (f x) (g x)
   times n f e = times n (f e)
+
+instance (HasTrie e, Group r) => Group (e :->: r) where
+  (-) = zipWith (-)
+  negate = fmap negate
+  subtract = zipWith subtract
+  times = fmap . times
 
 instance Group Integer where
   (-) = (Prelude.-)
diff --git a/Numeric/Algebra.hs b/Numeric/Algebra.hs
--- a/Numeric/Algebra.hs
+++ b/Numeric/Algebra.hs
@@ -52,6 +52,9 @@
   , Rig(..)
   -- * Rings
   , Ring(..)
+  -- ** Division Rings
+  , DivisionRing
+  , Field
 
   -- * Modules
   , LeftModule(..)
@@ -160,3 +163,5 @@
 import Numeric.Rig.Ordered
 import Numeric.Rng.Class
 import Numeric.Ring.Class
+import Numeric.Ring.Division
+import Numeric.Field.Class
diff --git a/Numeric/Algebra/Complex.hs b/Numeric/Algebra/Complex.hs
--- a/Numeric/Algebra/Complex.hs
+++ b/Numeric/Algebra/Complex.hs
@@ -1,8 +1,17 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
 module Numeric.Algebra.Complex
-  ( Complicated(..)
+  ( Distinguished(..)
+  , Complicated(..)
   , ComplexBasis(..)
   , Complex(..)
+  , realPart
+  , imagPart
+  , uncomplicate
   ) where
 
 import Control.Applicative
@@ -13,40 +22,53 @@
 import Data.Functor.Representable
 import Data.Functor.Representable.Trie
 import Data.Foldable
-import Data.Ix
+import Data.Ix hiding (index)
 import Data.Key
 import Data.Monoid
 import Data.Semigroup.Traversable
 import Data.Semigroup.Foldable
 import Data.Traversable
 import Numeric.Algebra
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
 
 -- complex basis
 data ComplexBasis = E | I deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
 data Complex a = Complex a a deriving (Eq,Show,Read,Data,Typeable)
 
-class Complicated r where
-  e :: r
-  i :: r
+realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
+realPart f = index f E 
 
-instance Complicated ComplexBasis where
+imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
+imagPart f = index f I
+
+instance Distinguished ComplexBasis where
   e = E
+  
+instance Complicated ComplexBasis where
   i = I
 
-instance Rig r => Complicated (Complex r) where
+instance Rig r => Distinguished (Complex r) where
   e = Complex one zero
+
+instance Rig r => Complicated (Complex r) where
   i = Complex zero one
-  
-instance Rig r => Complicated (ComplexBasis -> r) where
+
+instance Rig r => Distinguished (ComplexBasis -> r) where
   e E = one
   e _ = zero
+  
+instance Rig r => Complicated (ComplexBasis -> r) where
   i I = one
   i _ = zero 
 
-instance Complicated a => Complicated (Covector r a) where
-  e = return e
-  i = return i
+instance Rig r => Distinguished (ComplexBasis :->: r) where
+  e = Trie e
+  
+instance Rig r => Complicated (ComplexBasis :->: r) where
+  i = Trie i
 
 type instance Key Complex = ComplexBasis
 
@@ -166,23 +188,23 @@
   unit x E = x
   unit _ _ = zero
 
+-- the trivial coalgebra
 instance Rng k => Coalgebra k ComplexBasis where
-  comult f = f' where 
-    fe = f E
-    fi = f I
-    f' E E = fe
-    f' E I = fi
-    f' I E = fi
-    f' I I = negate fe
+  comult f E E = f E
+  comult f I I = f I
+  comult _ _ _ = zero
 
 instance Rng k => CounitalCoalgebra k ComplexBasis where
-  counit f = f E
+  counit f = f E + f I
 
 instance Rng k => Bialgebra k ComplexBasis 
 
 instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where
-  inv f E = f E
-  inv f b = negate (f b)
+  inv f = f' where
+    afe = adjoint (f E)
+    nfi = negate (f I)
+    f' E = afe
+    f' I = nfi
 
 instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where
   coinv = inv
@@ -213,3 +235,18 @@
   adjoint (Complex a b) = Complex (adjoint a) (negate b)
 
 instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Complex r) where
+  quadrance n = realPart $ adjoint n * n
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Complex r) where
+  recip q@(Complex a b) = Complex (qq \\ a) (qq \\ b)
+    where qq = quadrance q
+
+-- | half of the Cayley-Dickson quaternion isomorphism 
+uncomplicate :: Hamiltonian q => ComplexBasis -> ComplexBasis -> q
+uncomplicate E E = e
+uncomplicate I E = i
+uncomplicate E I = j
+uncomplicate I I = k
+
diff --git a/Numeric/Algebra/Complex/Class.hs b/Numeric/Algebra/Complex/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Complex/Class.hs
@@ -0,0 +1,13 @@
+module Numeric.Algebra.Complex.Class
+  ( Complicated(..)
+  ) where
+
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Covector
+import Prelude (return)
+
+class Distinguished r => Complicated r where
+  i :: r
+
+instance Complicated a => Complicated (Covector r a) where
+  i = return i
diff --git a/Numeric/Algebra/Distinguished/Class.hs b/Numeric/Algebra/Distinguished/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Distinguished/Class.hs
@@ -0,0 +1,12 @@
+module Numeric.Algebra.Distinguished.Class
+  ( Distinguished(..)
+  ) where
+
+import Numeric.Covector
+
+-- a basis with a distinguished point
+class Distinguished t where
+  e :: t
+
+instance Distinguished a => Distinguished (Covector r a) where
+  e = return e
diff --git a/Numeric/Algebra/Dual.hs b/Numeric/Algebra/Dual.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Dual.hs
@@ -0,0 +1,224 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Algebra.Dual
+  ( Distinguished(..)
+  , Infinitesimal(..)
+  , DualBasis(..)
+  , Dual(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key hiding (Dual)
+import Data.Monoid hiding (Dual)
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Dual.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
+
+-- | dual number basis, D^2 = 0. D /= 0.
+data DualBasis = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Dual a = Dual a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished DualBasis where
+  e = E
+
+instance Infinitesimal DualBasis where
+  d = D
+
+instance Rig r => Distinguished (Dual r) where
+  e = Dual one zero
+
+instance Rig r => Infinitesimal (Dual r) where
+  d = Dual zero one
+  
+instance Rig r => Distinguished (DualBasis -> r) where
+  e E = one
+  e _ = zero
+
+instance Rig r => Infinitesimal (DualBasis -> r) where
+  d D = one
+  d _       = zero 
+
+type instance Key Dual = DualBasis
+
+instance Representable Dual where
+  tabulate f = Dual (f E) (f D)
+
+instance Indexable Dual where
+  index (Dual a _ ) E = a
+  index (Dual _ b ) D = b
+
+instance Lookup Dual where
+  lookup = lookupDefault
+
+instance Adjustable Dual where
+  adjust f E (Dual a b) = Dual (f a) b
+  adjust f D (Dual a b) = Dual a (f b)
+
+instance Distributive Dual where
+  distribute = distributeRep 
+
+instance Functor Dual where
+  fmap f (Dual a b) = Dual (f a) (f b)
+
+instance Zip Dual where
+  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Dual where
+  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)
+
+instance Keyed Dual where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Dual where
+  (<.>) = apRep
+
+instance Applicative Dual where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Dual where
+  (>>-) = bindRep
+
+instance Monad Dual where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader DualBasis Dual where
+  ask = askRep
+  local = localRep
+
+instance Foldable Dual where
+  foldMap f (Dual a b) = f a `mappend` f b
+
+instance FoldableWithKey Dual where
+  foldMapWithKey f (Dual a b) = f E a `mappend` f D b
+
+instance Traversable Dual where
+  traverse f (Dual a b) = Dual <$> f a <*> f b
+
+instance TraversableWithKey Dual where
+  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b
+
+instance Foldable1 Dual where
+  foldMap1 f (Dual a b) = f a <> f b
+
+instance FoldableWithKey1 Dual where
+  foldMapWithKey1 f (Dual a b) = f E a <> f D b
+
+instance Traversable1 Dual where
+  traverse1 f (Dual a b) = Dual <$> f a <.> f b
+
+instance TraversableWithKey1 Dual where
+  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b
+
+instance HasTrie DualBasis where
+  type BaseTrie DualBasis = Dual
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Dual r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Dual s) where
+  r .* Dual a b = Dual (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Dual s) where
+  Dual a b *. r = Dual (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Dual r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Dual r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Dual r)
+
+instance Idempotent r => Idempotent (Dual r)
+
+instance Partitionable r => Partitionable (Dual r) where
+  partitionWith f (Dual a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Dual a1 b1) (Dual a2 b2)) b) a
+
+instance Rng k => Algebra k DualBasis where
+  mult f = f' where
+    fe = f E E
+    fd = f E D + f D E
+    f' E = fe
+    f' D = fd
+
+instance Rng k => UnitalAlgebra k DualBasis where
+  unit x E = x
+  unit _ _ = zero
+
+-- the trivial coalgebra
+instance Rng k => Coalgebra k DualBasis where
+  comult f E E = f E
+  comult f D D = f D
+  comult _ _ _ = zero
+
+instance Rng k => CounitalCoalgebra k DualBasis where
+  counit f = f E + f D
+
+instance Rng k => Bialgebra k DualBasis 
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis where
+  inv f = f' where
+    afe = adjoint (f E)
+    nfd = negate (f D)
+    f' E = afe
+    f' D = nfd
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis where
+  coinv = inv
+
+instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis where
+  antipode = inv
+
+instance (Commutative r, Rng r) => Multiplicative (Dual r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng r) => Commutative (Dual r)
+
+instance (Commutative r, Rng r) => Semiring (Dual r)
+
+instance (Commutative r, Ring r) => Unital (Dual r) where
+  one = oneRep
+
+instance (Commutative r, Ring r) => Rig (Dual r) where
+  fromNatural n = Dual (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Dual r) where
+  fromInteger n = Dual (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Dual r) (Dual r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Dual r) (Dual r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual r) where
+  adjoint (Dual a b) = Dual (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual r)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual r) where
+  quadrance n = case adjoint n * n of
+    Dual a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual r) where
+  recip q@(Dual a b) = Dual (qq \\ a) (qq \\ b)
+    where qq = quadrance q
diff --git a/Numeric/Algebra/Dual/Class.hs b/Numeric/Algebra/Dual/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Dual/Class.hs
@@ -0,0 +1,12 @@
+module Numeric.Algebra.Dual.Class
+  ( Infinitesimal(..)
+  ) where
+
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Covector
+
+class Distinguished t => Infinitesimal t where
+  d :: t
+
+instance Infinitesimal a => Infinitesimal (Covector r a) where
+  d = return d
diff --git a/Numeric/Algebra/Geometric.hs b/Numeric/Algebra/Geometric.hs
deleted file mode 100644
--- a/Numeric/Algebra/Geometric.hs
+++ /dev/null
@@ -1,215 +0,0 @@
-{-# LANGUAGE 
-    MultiParamTypeClasses, 
-    GeneralizedNewtypeDeriving, 
-    BangPatterns,
-    TypeOperators,
-    DeriveDataTypeable,
-    FlexibleInstances,
-    TypeFamilies,
-    UndecidableInstances,
-    ScopedTypeVariables #-}
-
-module Numeric.Algebra.Geometric
-  ( 
-  -- * Geometric algebra primitives
-    Blade(..)
-  , Multivector
-  , Comultivector
-  -- * Operations over an eigenbasis
-  , Eigenbasis(..)
-  , Eigenmetric(..)
-  -- * Grade
-  , grade
-  , filterGrade
-  -- * Inversions
-  , reverse
-  , gradeInversion
-  , cliffordConjugate
-  -- * Products
-  , geometric
-  , outer
-  -- * Inner products
-  , contractL
-  , contractR
-  , hestenes
-  , dot
-  , liftProduct
-  ) where
-
-import Control.Monad (mfilter)
-import Data.Bits
-import Data.Functor.Representable.Trie
-import Data.Word
-import Data.Data
-import Data.Ix
-import Data.Array.Unboxed
-import Numeric.Algebra
-import Prelude hiding ((-),(*),(+),negate,reverse)
-
--- a basis vector for a simple geometric algebra with the euclidean inner product
-newtype Blade m = Blade { runBlade :: Word64 } deriving 
-  ( Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral
-  , Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal
-  , Multiplicative,Unital,Commutative
-  , Semiring,Rig
-  , DecidableZero,DecidableAssociates,DecidableUnits
-  )
-
-instance HasTrie (Blade m) where
-  type BaseTrie (Blade m) = BaseTrie Word64
-  embedKey = embedKey . runBlade
-  projectKey = Blade . projectKey
-
--- A metric space over an eigenbasis
-class Eigenbasis m where
-  euclidean     :: proxy m -> Bool
-  antiEuclidean :: proxy m -> Bool
-  v             :: m -> Blade m
-  e             :: Int -> m
-
--- assuming n /= 0, find the index of the least significant set bit in a basis blade
-lsb :: Blade m -> Int
-lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58
-  where 
-    -- a 64 bit deBruijn multiplication table
-    ix :: UArray (Blade m) Word8
-    ix = listArray (0, 63) 
-      [ 63,  0, 58,  1, 59, 47, 53,  2
-      , 60, 39, 48, 27, 54, 33, 42,  3
-      , 61, 51, 37, 40, 49, 18, 28, 20
-      , 55, 30, 34, 11, 43, 14, 22,  4
-      , 62, 57, 46, 52, 38, 26, 32, 41
-      , 50, 36, 17, 19, 29, 10, 13, 21
-      , 56, 45, 25, 31, 35, 16,  9, 12
-      , 44, 24, 15,  8, 23,  7,  6,  5
-      ]
-
-class (Ring r, Eigenbasis m) => Eigenmetric r m where
-  metric :: m -> r
-
-type Comultivector r m = Covector r (Blade m)
-
-type Multivector r m = Blade m :->: r
-
--- Euclidean basis, we can work with basis vectors for euclidean spaces of up to 64 dimensions without 
--- expanding the representation of our basis vectors
-newtype Euclidean = Euclidean Int deriving 
-  ( Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral
-  , Data,Typeable
-  , Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group
-  , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative
-  , Semiring,Rig,Ring
-  )
-
-instance HasTrie Euclidean where
-  type BaseTrie Euclidean = BaseTrie Int
-  embedKey (Euclidean i) = embedKey i
-  projectKey = Euclidean . projectKey
-
-instance Eigenbasis Euclidean where
-  euclidean _ = True
-  antiEuclidean _ = False
-  v n = shiftL 1 (fromIntegral n)
-  e = fromIntegral
-
-instance Ring r => Eigenmetric r Euclidean where
-  metric _ = one
-
-grade :: Blade m -> Int
-grade = fromIntegral . count 5 . count 4 . count 3 . count 2 . count 1 . count 0 where 
-  count c x = (x .&. mask) + (shiftR x p .&. mask) where 
-    p = shiftL 1 c
-    mask = (-1) `div` (shiftL 1 p + 1)
-
-m1powTimes :: (Bits n, Group r) => n -> r -> r
-m1powTimes n r 
-  | (n .&. 1) == 0 = r
-  | otherwise      = negate r
-
-reorder :: Group r => Blade m -> Blade m -> r -> r
-reorder a0 b = m1powTimes $ go 0 (shiftR a0 1)
-  where
-    go !acc 0 = acc
-    go acc a = go (acc + grade (a .&. b)) (shiftR a 1)
-
--- <A>_k
-filterGrade :: Monoidal r => Blade m -> Int -> Covector r (Blade m)
-filterGrade b k | grade b == k = zero
-                | otherwise    = return b
-
-instance Eigenmetric r m => Coalgebra r (Blade m) where
-  comult f n m = scale (n .&. m) $ reorder n m $ f $ xor n m where
-    scale b
-      | euclidean n = id
-      | otherwise   = (go one b *)
-    go :: Eigenmetric r m => r -> Blade m -> r
-    go acc 0 = acc
-    go acc n' | b <- lsb n'
-              , m' <- metric (e b :: m)
-              = go (acc*m') (clearBit n' b)
-
-instance Eigenmetric r m => CounitalCoalgebra r (Blade m) where
-  counit f = f (Blade zero)
-
--- instance Group r => InvertibleModule r Blade where
-  
--- reversion (A~) is an involution for the outer product
-reverse :: Group r => Blade m -> Comultivector r m
-reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where
-  g = grade b
-
-cliffordConjugate :: Group r => Blade m -> Comultivector r m
-cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where
-  g = grade b
-
--- A^
-gradeInversion :: Group r => Blade m -> Comultivector r m
-gradeInversion b = grade b `m1powTimes` return b
-
-geometric :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m  
-geometric = multM
-
-outer :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m
-outer m n | m .&. n == 0 = geometric m n 
-          | otherwise    = zero
-
--- A _| B
--- grade (A _| B) = grade B - grade A
-contractL :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m 
-contractL a b 
-  | ga Prelude.> gb   = zero
-  | otherwise = mfilter (\r -> grade r == gb - ga) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
--- A |_ B
--- grade (A |_ B) = grade A - grade B
-contractR :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m
-contractR a b 
-  | ga Prelude.< gb   = zero
-  | otherwise = mfilter (\r -> grade r == ga - gb) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
--- the modified Hestenes' product
-dot :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m
-dot a b = mfilter (\r -> grade r == abs(grade a - grade b)) (geometric a b)
-
--- Hestenes' inner product
--- if 0 /= grade a <= grade b then 
--- dot a b = hestenes a b = leftContract a b
-hestenes :: Eigenmetric r m => Blade m -> Blade m -> Comultivector r m
-hestenes a b
-  | ga == 0 || gb == 0 = zero
-  | otherwise = mfilter (\r -> grade r == abs(ga - gb)) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
-liftProduct :: (Blade m -> Blade m -> Comultivector r m) -> Comultivector r m -> Comultivector r m -> Comultivector r m
-liftProduct f ma mb = do
-  a <- ma
-  b <- mb
-  f a b
diff --git a/Numeric/Algebra/Hyperbolic.hs b/Numeric/Algebra/Hyperbolic.hs
--- a/Numeric/Algebra/Hyperbolic.hs
+++ b/Numeric/Algebra/Hyperbolic.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Algebra.Hyperbolic 
+module Numeric.Algebra.Hyperbolic
   ( Hyperbolic(..)
-  , HyperBasis(..)
-  , Hyper(..)
+  , HyperBasis'(..)
+  , Hyper'(..)
   ) where
 
 import Control.Applicative
@@ -20,186 +20,203 @@
 import Data.Semigroup.Foldable
 import Data.Traversable
 import Numeric.Algebra
+import Numeric.Coalgebra.Hyperbolic.Class
 import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
 
--- complex basis
-data HyperBasis = S | C deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)
-
-class Hyperbolic r where
-  s :: r
-  c :: r
+-- the dual hyperbolic basis
+data HyperBasis' = Cosh' | Sinh' deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Hyper' a = Hyper' a a deriving (Eq,Show,Read,Data,Typeable)
 
-instance Hyperbolic HyperBasis where
-  s = S
-  c = C
+instance Hyperbolic HyperBasis' where
+  cosh = Cosh'
+  sinh = Sinh'
 
-instance Rig r => Hyperbolic (Hyper r) where
-  s = Hyper one zero
-  c = Hyper zero one
+instance Rig r => Hyperbolic (Hyper' r) where
+  cosh = Hyper' one zero
+  sinh = Hyper' zero one
   
-instance Rig r => Hyperbolic (HyperBasis -> r) where
-  s S = one
-  s C = zero
-  c S = zero
-  c C = one
-
-instance Hyperbolic a => Hyperbolic (Covector r a) where
-  s = return s
-  c = return c
+instance Rig r => Hyperbolic (HyperBasis' -> r) where
+  cosh Sinh' = zero
+  cosh Cosh' = one
+  sinh Sinh' = one
+  sinh Cosh' = zero
 
-type instance Key Hyper = HyperBasis
+type instance Key Hyper' = HyperBasis'
 
-instance Representable Hyper where
-  tabulate f = Hyper (f S) (f C)
+instance Representable Hyper' where
+  tabulate f = Hyper' (f Cosh') (f Sinh')
 
-instance Indexable Hyper where
-  index (Hyper a _ ) S = a
-  index (Hyper _ b ) C = b
+instance Indexable Hyper' where
+  index (Hyper' a _ ) Cosh' = a
+  index (Hyper' _ b ) Sinh' = b
 
-instance Lookup Hyper where
+instance Lookup Hyper' where
   lookup = lookupDefault
 
-instance Adjustable Hyper where
-  adjust f S (Hyper a b) = Hyper (f a) b
-  adjust f C (Hyper a b) = Hyper a (f b)
+instance Adjustable Hyper' where
+  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b
+  adjust f Sinh' (Hyper' a b) = Hyper' a (f b)
 
-instance Distributive Hyper where
+instance Distributive Hyper' where
   distribute = distributeRep 
 
-instance Functor Hyper where
-  fmap f (Hyper a b) = Hyper (f a) (f b)
+instance Functor Hyper' where
+  fmap f (Hyper' a b) = Hyper' (f a) (f b)
 
-instance Zip Hyper where
-  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)
+instance Zip Hyper' where
+  zipWith f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f a1 a2) (f b1 b2)
 
-instance ZipWithKey Hyper where
-  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f S a1 a2) (f C b1 b2)
+instance ZipWithKey Hyper' where
+  zipWithKey f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f Cosh' a1 a2) (f Sinh' b1 b2)
 
-instance Keyed Hyper where
+instance Keyed Hyper' where
   mapWithKey = mapWithKeyRep
 
-instance Apply Hyper where
+instance Apply Hyper' where
   (<.>) = apRep
 
-instance Applicative Hyper where
+instance Applicative Hyper' where
   pure = pureRep
   (<*>) = apRep 
 
-instance Bind Hyper where
+instance Bind Hyper' where
   (>>-) = bindRep
 
-instance Monad Hyper where
+instance Monad Hyper' where
   return = pureRep
   (>>=) = bindRep
 
-instance MonadReader HyperBasis Hyper where
+instance MonadReader HyperBasis' Hyper' where
   ask = askRep
   local = localRep
 
-instance Foldable Hyper where
-  foldMap f (Hyper a b) = f a `mappend` f b
+instance Foldable Hyper' where
+  foldMap f (Hyper' a b) = f a `mappend` f b
 
-instance FoldableWithKey Hyper where
-  foldMapWithKey f (Hyper a b) = f S a `mappend` f C b
+instance FoldableWithKey Hyper' where
+  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' b
 
-instance Traversable Hyper where
-  traverse f (Hyper a b) = Hyper <$> f a <*> f b
+instance Traversable Hyper' where
+  traverse f (Hyper' a b) = Hyper' <$> f a <*> f b
 
-instance TraversableWithKey Hyper where
-  traverseWithKey f (Hyper a b) = Hyper <$> f S a <*> f C b
+instance TraversableWithKey Hyper' where
+  traverseWithKey f (Hyper' a b) = Hyper' <$> f Cosh' a <*> f Sinh' b
 
-instance Foldable1 Hyper where
-  foldMap1 f (Hyper a b) = f a <> f b
+instance Foldable1 Hyper' where
+  foldMap1 f (Hyper' a b) = f a <> f b
 
-instance FoldableWithKey1 Hyper where
-  foldMapWithKey1 f (Hyper a b) = f S a <> f C b
+instance FoldableWithKey1 Hyper' where
+  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' b
 
-instance Traversable1 Hyper where
-  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b
+instance Traversable1 Hyper' where
+  traverse1 f (Hyper' a b) = Hyper' <$> f a <.> f b
 
-instance TraversableWithKey1 Hyper where
-  traverseWithKey1 f (Hyper a b) = Hyper <$> f S a <.> f C b
+instance TraversableWithKey1 Hyper' where
+  traverseWithKey1 f (Hyper' a b) = Hyper' <$> f Cosh' a <.> f Sinh' b
 
-instance HasTrie HyperBasis where
-  type BaseTrie HyperBasis = Hyper
+instance HasTrie HyperBasis' where
+  type BaseTrie HyperBasis' = Hyper'
   embedKey = id
   projectKey = id
 
-instance Additive r => Additive (Hyper r) where
+instance Additive r => Additive (Hyper' r) where
   (+) = addRep 
   replicate1p = replicate1pRep
 
-instance LeftModule r s => LeftModule r (Hyper s) where
-  r .* Hyper a b = Hyper (r .* a) (r .* b)
+instance LeftModule r s => LeftModule r (Hyper' s) where
+  r .* Hyper' a b = Hyper' (r .* a) (r .* b)
 
-instance RightModule r s => RightModule r (Hyper s) where
-  Hyper a b *. r = Hyper (a *. r) (b *. r)
+instance RightModule r s => RightModule r (Hyper' s) where
+  Hyper' a b *. r = Hyper' (a *. r) (b *. r)
 
-instance Monoidal r => Monoidal (Hyper r) where
+instance Monoidal r => Monoidal (Hyper' r) where
   zero = zeroRep
   replicate = replicateRep
 
-instance Group r => Group (Hyper r) where
+instance Group r => Group (Hyper' r) where
   (-) = minusRep
   negate = negateRep
   subtract = subtractRep
   times = timesRep
 
-instance Abelian r => Abelian (Hyper r)
+instance Abelian r => Abelian (Hyper' r)
 
-instance Idempotent r => Idempotent (Hyper r)
+instance Idempotent r => Idempotent (Hyper' r)
 
-instance Partitionable r => Partitionable (Hyper r) where
-  partitionWith f (Hyper a b) = id =<<
+instance Partitionable r => Partitionable (Hyper' r) where
+  partitionWith f (Hyper' a b) = id =<<
     partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a
+    partitionWith (\b1 b2 -> f (Hyper' a1 b1) (Hyper' a2 b2)) b) a
 
--- the dual, hyperbolic trigonometric algebra
-instance (Commutative k, Semiring k) => Algebra k HyperBasis where
+-- the dual hyperbolic trigonometric algebra
+instance (Commutative k, Semiring k) => Algebra k HyperBasis' where
   mult f = f' where
-    fs = f S C + f C S
-    fc = f C C + f S S
-    f' S = fs
-    f' C = fc
+    fs = f Sinh' Cosh' + f Cosh' Sinh'
+    fc = f Cosh' Cosh' + f Sinh' Sinh'
+    f' Sinh' = fs
+    f' Cosh' = fc
 
-instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis where
-  unit _ S = zero
-  unit x C = x
+instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis' where
+  unit _ Sinh' = zero
+  unit x Cosh' = x
 
--- the actual hyperbolic trigonometric coalgebra
-instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where
+-- the diagonal coalgebra
+instance (Commutative k, Monoidal k, Semiring k) => Coalgebra k HyperBasis' where
   comult f = f' where
-     fs = f S
-     fc = f C
-     f' S S = fc
-     f' S C = fs 
-     f' C S = fs
-     f' C C = fc
+     fs = f Sinh'
+     fc = f Cosh'
+     f' Sinh' Sinh' = fs
+     f' Sinh' Cosh' = zero
+     f' Cosh' Sinh' = zero
+     f' Cosh' Cosh' = fc
 
-instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where
-  counit f = f C
+instance (Commutative k, Monoidal k, Semiring k) => CounitalCoalgebra k HyperBasis' where
+  counit f = f Cosh' + f Sinh'
 
-instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where
+instance (Commutative k, Monoidal k, Semiring k) => Bialgebra k HyperBasis'
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis' where
+  inv f = f' where
+    afc = adjoint (f Cosh')
+    nfs = negate (f Sinh')
+    f' Cosh' = afc
+    f' Sinh' = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis' where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis' where
+  antipode = inv
+
+instance (Commutative k, Semiring k) => Multiplicative (Hyper' k) where
   (*) = mulRep
 
-instance (Commutative k, Semiring k) => Commutative (Hyper k)
+instance (Commutative k, Semiring k) => Commutative (Hyper' k)
 
-instance (Commutative k, Semiring k) => Semiring (Hyper k)
+instance (Commutative k, Semiring k) => Semiring (Hyper' k)
 
-instance (Commutative k, Rig k) => Unital (Hyper k) where
-  one = Hyper zero one
+instance (Commutative k, Rig k) => Unital (Hyper' k) where
+  one = Hyper' one zero
 
-instance (Commutative r, Rig r) => Rig (Hyper r) where
-  fromNatural n = Hyper zero (fromNatural n)
+instance (Commutative r, Rig r) => Rig (Hyper' r) where
+  fromNatural n = Hyper' (fromNatural n) zero
 
-instance (Commutative r, Ring r) => Ring (Hyper r) where
-  fromInteger n = Hyper zero (fromInteger n)
+instance (Commutative r, Ring r) => Ring (Hyper' r) where
+  fromInteger n = Hyper' (fromInteger n) zero
 
-instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)
-instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)
+instance (Commutative r, Semiring r) => LeftModule (Hyper' r) (Hyper' r) where (.*) = (*)
+instance (Commutative r, Semiring r) => RightModule (Hyper' r) (Hyper' r) where (*.) = (*)
 
-instance (Commutative r, Semiring r, InvolutiveMultiplication r) => InvolutiveMultiplication (Hyper r) where
-  adjoint (Hyper a b) = Hyper (adjoint a) (adjoint b)
+instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveMultiplication (Hyper' r) where
+  adjoint (Hyper' a b) = Hyper' (adjoint a) (negate b)
 
-instance (Commutative r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
+instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveSemiring (Hyper' r)
+
+instance (Commutative r, InvolutiveSemiring r, Rng r) => Quadrance r (Hyper' r) where
+  quadrance n = case adjoint n * n of
+    Hyper' a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Hyper' r) where
+  recip q@(Hyper' a b) = Hyper' (qq \\ a) (qq \\ b)
+    where qq = quadrance q
+
diff --git a/Numeric/Algebra/Quaternion.hs b/Numeric/Algebra/Quaternion.hs
--- a/Numeric/Algebra/Quaternion.hs
+++ b/Numeric/Algebra/Quaternion.hs
@@ -1,16 +1,23 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances
+           , MultiParamTypeClasses
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
 module Numeric.Algebra.Quaternion 
-  ( Complicated(..)
+  ( Distinguished(..)
+  , Complicated(..)
   , Hamiltonian(..)
   , QuaternionBasis(..)
   , Quaternion(..)
   , complicate
-  , uncomplicate
+  , vectorPart
+  , scalarPart
   ) where
 
 import Control.Applicative
 import Control.Monad.Reader.Class
-import Data.Ix
+import Data.Ix hiding (index)
 import Data.Key
 import Data.Data
 import Data.Distributive
@@ -23,34 +30,47 @@
 import Data.Semigroup.Traversable
 import Data.Semigroup.Foldable
 import Numeric.Algebra
-import Numeric.Algebra.Complex (ComplexBasis, Complicated(..))
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
 import qualified Numeric.Algebra.Complex as Complex
 import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
 
-class Complicated t => Hamiltonian t where
-  j :: t
-  k :: t
+instance Distinguished QuaternionBasis where
+  e = E
 
 instance Complicated QuaternionBasis where
-  e = E
   i = I
 
 instance Hamiltonian QuaternionBasis where
   j = J
   k = K
 
-instance Rig r => Complicated (Quaternion r) where
+instance Rig r => Distinguished (Quaternion r) where
   e = Quaternion one zero zero zero
+
+instance Rig r => Complicated (Quaternion r) where
   i = Quaternion zero one zero zero
 
 instance Rig r => Hamiltonian (Quaternion r) where
   j = Quaternion zero zero one zero
   k = Quaternion one zero zero one 
 
-instance Rig r => Complicated (QuaternionBasis -> r) where
+instance Rig r => Distinguished (QuaternionBasis :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (QuaternionBasis :->: r) where
+  i = Trie i
+
+instance Rig r => Hamiltonian (QuaternionBasis :->: r) where
+  j = Trie j
+  k = Trie k
+
+instance Rig r => Distinguished (QuaternionBasis -> r) where
   e E = one 
   e _ = zero
 
+instance Rig r => Complicated (QuaternionBasis -> r) where
   i I = one
   i _ = zero
   
@@ -61,10 +81,6 @@
   k K = one
   k _ = zero
 
-instance Hamiltonian a => Hamiltonian (Covector r a) where
-  j = return j
-  k = return k
-
 -- quaternion basis
 data QuaternionBasis = E | I | J | K deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
 
@@ -197,6 +213,7 @@
                                (Quaternion a2 b2 c2 d2)
                   ) d) c) b) a
 
+-- | the quaternion algebra
 instance (TriviallyInvolutive r, Rng r) => Algebra r QuaternionBasis where
   mult f = f' where
     fe = f E E - (f I I + f J J + f K K)
@@ -212,12 +229,30 @@
   unit x E = x 
   unit _ _ = zero
 
+-- | the trivial diagonal coalgebra
 instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
   comult f = f' where
     fe = f E
     fi = f I
     fj = f J
     fk = f K
+    f' E E = fe
+    f' I I = fi
+    f' J J = fj
+    f' K K = fk
+    f' _ _ = zero
+
+instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
+  counit f = f E + f I + f J + f K
+
+{-
+-- dual quaternion comultiplication
+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
+  comult f = f' where
+    fe = f E
+    fi = f I
+    fj = f J
+    fk = f K
     fe' = negate fe
     fi' = negate fi
     fj' = negate fj
@@ -241,6 +276,7 @@
 
 instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
   counit f = f E
+-}
 
 instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis 
 
@@ -279,15 +315,21 @@
   adjoint (Quaternion a b c d) = Quaternion a (negate b) (negate c) (negate d)
 
 -- | Cayley-Dickson quaternion isomorphism (one way)
-complicate :: QuaternionBasis -> (ComplexBasis, ComplexBasis)
-complicate E = (Complex.E, Complex.E)
-complicate I = (Complex.I, Complex.E)
-complicate J = (Complex.E, Complex.I)
-complicate K = (Complex.I, Complex.I)
+complicate :: Complicated c => QuaternionBasis -> (c,c)
+complicate E = (e, e)
+complicate I = (i, e) 
+complicate J = (e, i)
+complicate K = (i, i)
 
--- | Cayley-Dickson quaternion isomorphism (the other half)
-uncomplicate :: ComplexBasis -> ComplexBasis -> QuaternionBasis
-uncomplicate Complex.E Complex.E = E
-uncomplicate Complex.I Complex.E = I
-uncomplicate Complex.E Complex.I = J
-uncomplicate Complex.I Complex.I = K
+scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r
+scalarPart f = index f E
+
+vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)
+vectorPart f = (index f I, index f J, index f K)
+
+instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where
+  quadrance n = scalarPart (adjoint n * n)
+
+instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion r) where
+  recip q@(Quaternion a b c d) = Quaternion (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
+    where qq = quadrance q
diff --git a/Numeric/Algebra/Quaternion/Class.hs b/Numeric/Algebra/Quaternion/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Quaternion/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Algebra.Quaternion.Class
+  ( Hamiltonian(..)
+  ) where
+
+import Numeric.Algebra.Complex.Class
+import Numeric.Covector
+
+class Complicated t => Hamiltonian t where
+  j :: t
+  k :: t
+
+instance Hamiltonian a => Hamiltonian (Covector r a) where
+  j = return j
+  k = return k
diff --git a/Numeric/Algebra/Trigonometric.hs b/Numeric/Algebra/Trigonometric.hs
deleted file mode 100644
--- a/Numeric/Algebra/Trigonometric.hs
+++ /dev/null
@@ -1,206 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Algebra.Trigonometric 
-  ( Trigonometric(..)
-  , TrigBasis(..)
-  , Trig(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Monoid
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Traversable
-import Numeric.Algebra
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
-
--- complex basis
-data TrigBasis = S | C deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)
-
-class Trigonometric r where
-  s :: r
-  c :: r
-
-instance Trigonometric TrigBasis where
-  s = S
-  c = C
-
-instance Rig r => Trigonometric (Trig r) where
-  s = Trig one zero
-  c = Trig zero one
-  
-instance Rig r => Trigonometric (TrigBasis -> r) where
-  s S = one
-  s C = zero
-  c S = zero
-  c C = one
-
-instance Trigonometric a => Trigonometric (Covector r a) where
-  s = return s
-  c = return c
-
-type instance Key Trig = TrigBasis
-
-instance Representable Trig where
-  tabulate f = Trig (f S) (f C)
-
-instance Indexable Trig where
-  index (Trig a _ ) S = a
-  index (Trig _ b ) C = b
-
-instance Lookup Trig where
-  lookup = lookupDefault
-
-instance Adjustable Trig where
-  adjust f S (Trig a b) = Trig (f a) b
-  adjust f C (Trig a b) = Trig a (f b)
-
-instance Distributive Trig where
-  distribute = distributeRep 
-
-instance Functor Trig where
-  fmap f (Trig a b) = Trig (f a) (f b)
-
-instance Zip Trig where
-  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Trig where
-  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f S a1 a2) (f C b1 b2)
-
-instance Keyed Trig where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Trig where
-  (<.>) = apRep
-
-instance Applicative Trig where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Trig where
-  (>>-) = bindRep
-
-instance Monad Trig where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader TrigBasis Trig where
-  ask = askRep
-  local = localRep
-
-instance Foldable Trig where
-  foldMap f (Trig a b) = f a `mappend` f b
-
-instance FoldableWithKey Trig where
-  foldMapWithKey f (Trig a b) = f S a `mappend` f C b
-
-instance Traversable Trig where
-  traverse f (Trig a b) = Trig <$> f a <*> f b
-
-instance TraversableWithKey Trig where
-  traverseWithKey f (Trig a b) = Trig <$> f S a <*> f C b
-
-instance Foldable1 Trig where
-  foldMap1 f (Trig a b) = f a <> f b
-
-instance FoldableWithKey1 Trig where
-  foldMapWithKey1 f (Trig a b) = f S a <> f C b
-
-instance Traversable1 Trig where
-  traverse1 f (Trig a b) = Trig <$> f a <.> f b
-
-instance TraversableWithKey1 Trig where
-  traverseWithKey1 f (Trig a b) = Trig <$> f S a <.> f C b
-
-instance HasTrie TrigBasis where
-  type BaseTrie TrigBasis = Trig
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Trig r) where
-  (+) = addRep 
-  replicate1p = replicate1pRep
-
-instance LeftModule r s => LeftModule r (Trig s) where
-  r .* Trig a b = Trig (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Trig s) where
-  Trig a b *. r = Trig (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Trig r) where
-  zero = zeroRep
-  replicate = replicateRep
-
-instance Group r => Group (Trig r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Trig r)
-
-instance Idempotent r => Idempotent (Trig r)
-
-instance Partitionable r => Partitionable (Trig r) where
-  partitionWith f (Trig a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a
-
--- the dual, trigonometric algebra
-instance (Commutative k, Rng k) => Algebra k TrigBasis where
-  mult f = f' where
-    fs = f S C + f C S
-    fc = f C C - f S S
-    f' S = fs
-    f' C = fc
-
-instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where
-  unit _ S = zero
-  unit x C = x
-
--- the actual trigonometric coalgebra
-instance (Commutative k, Rng k) => Coalgebra k TrigBasis where
-  comult f = f' where
-     fs = f S
-     fc = f C
-     fc' = negate fc
-     f' S S = fc'
-     f' S C = fs 
-     f' C S = fs
-     f' C C = fc
-
-instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where
-  counit f = f C
-
-instance (Commutative k, Rng k) => Multiplicative (Trig k) where
-  (*) = mulRep
-
-instance (Commutative k, Rng k) => Commutative (Trig k)
-
-instance (Commutative k, Rng k) => Semiring (Trig k)
-
-instance (Commutative k, Ring k) => Unital (Trig k) where
-  one = Trig zero one
-
-instance (Commutative r, Ring r) => Rig (Trig r) where
-  fromNatural n = Trig zero (fromNatural n)
-
-instance (Commutative r, Ring r) => Ring (Trig r) where
-  fromInteger n = Trig zero (fromInteger n)
-
-instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)
-instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)
-
-instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where
-  adjoint (Trig a b) = Trig (adjoint a) (adjoint b)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
diff --git a/Numeric/Coalgebra/Dual.hs b/Numeric/Coalgebra/Dual.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Dual.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Coalgebra.Dual
+  ( Distinguished(..)
+  , Infinitesimal(..)
+  , DualBasis'(..)
+  , Dual'(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Monoid
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Dual.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
+
+-- | dual number basis, D^2 = 0. D /= 0.
+data DualBasis' = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Dual' a = Dual' a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished DualBasis' where
+  e = E
+
+instance Infinitesimal DualBasis' where
+  d = D
+
+instance Rig r => Distinguished (Dual' r) where
+  e = Dual' one zero
+
+instance Rig r => Infinitesimal (Dual' r) where
+  d = Dual' zero one
+  
+instance Rig r => Distinguished (DualBasis' -> r) where
+  e E = one
+  e _ = zero
+
+instance Rig r => Infinitesimal (DualBasis' -> r) where
+  d D = one
+  d _       = zero 
+
+type instance Key Dual' = DualBasis'
+
+instance Representable Dual' where
+  tabulate f = Dual' (f E) (f D)
+
+instance Indexable Dual' where
+  index (Dual' a _ ) E = a
+  index (Dual' _ b ) D = b
+
+instance Lookup Dual' where
+  lookup = lookupDefault
+
+instance Adjustable Dual' where
+  adjust f E (Dual' a b) = Dual' (f a) b
+  adjust f D (Dual' a b) = Dual' a (f b)
+
+instance Distributive Dual' where
+  distribute = distributeRep 
+
+instance Functor Dual' where
+  fmap f (Dual' a b) = Dual' (f a) (f b)
+
+instance Zip Dual' where
+  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Dual' where
+  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)
+
+instance Keyed Dual' where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Dual' where
+  (<.>) = apRep
+
+instance Applicative Dual' where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Dual' where
+  (>>-) = bindRep
+
+instance Monad Dual' where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader DualBasis' Dual' where
+  ask = askRep
+  local = localRep
+
+instance Foldable Dual' where
+  foldMap f (Dual' a b) = f a `mappend` f b
+
+instance FoldableWithKey Dual' where
+  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b
+
+instance Traversable Dual' where
+  traverse f (Dual' a b) = Dual' <$> f a <*> f b
+
+instance TraversableWithKey Dual' where
+  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b
+
+instance Foldable1 Dual' where
+  foldMap1 f (Dual' a b) = f a <> f b
+
+instance FoldableWithKey1 Dual' where
+  foldMapWithKey1 f (Dual' a b) = f E a <> f D b
+
+instance Traversable1 Dual' where
+  traverse1 f (Dual' a b) = Dual' <$> f a <.> f b
+
+instance TraversableWithKey1 Dual' where
+  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b
+
+instance HasTrie DualBasis' where
+  type BaseTrie DualBasis' = Dual'
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Dual' r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Dual' s) where
+  r .* Dual' a b = Dual' (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Dual' s) where
+  Dual' a b *. r = Dual' (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Dual' r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Dual' r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Dual' r)
+
+instance Idempotent r => Idempotent (Dual' r)
+
+instance Partitionable r => Partitionable (Dual' r) where
+  partitionWith f (Dual' a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Dual' a1 b1) (Dual' a2 b2)) b) a
+
+instance Semiring k => Algebra k DualBasis' where
+  mult f = f' where
+    fe = f E E
+    fd = f D D
+    f' E = fe
+    f' D = fd
+
+instance Semiring k => UnitalAlgebra k DualBasis' where
+  unit = const
+
+-- the trivial coalgebra
+instance Rng k => Coalgebra k DualBasis' where
+  comult f = f' where
+     fe = f E
+     fd = f D
+     f' E E = fe
+     f' E D = fd
+     f' D E = fd
+     f' D D = zero
+
+instance Rng k => CounitalCoalgebra k DualBasis' where
+  counit f = f E
+
+instance Rng k => Bialgebra k DualBasis' 
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis' where
+  inv f = f' where
+    afe = adjoint (f E)
+    nfd = negate (f D)
+    f' E = afe
+    f' D = nfd
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis' where
+  coinv = inv
+
+instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis' where
+  antipode = inv
+
+instance (Commutative r, Rng r) => Multiplicative (Dual' r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng r) => Commutative (Dual' r)
+
+instance (Commutative r, Rng r) => Semiring (Dual' r)
+
+instance (Commutative r, Ring r) => Unital (Dual' r) where
+  one = oneRep
+
+instance (Commutative r, Ring r) => Rig (Dual' r) where
+  fromNatural n = Dual' (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Dual' r) where
+  fromInteger n = Dual' (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Dual' r) (Dual' r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Dual' r) (Dual' r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual' r) where
+  adjoint (Dual' a b) = Dual' (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual' r)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual' r) where
+  quadrance n = case adjoint n * n of
+    Dual' a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual' r) where
+  recip q@(Dual' a b) = Dual' (qq \\ a) (qq \\ b)
+    where qq = quadrance q
diff --git a/Numeric/Coalgebra/Geometric.hs b/Numeric/Coalgebra/Geometric.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Geometric.hs
@@ -0,0 +1,212 @@
+{-# LANGUAGE 
+    MultiParamTypeClasses, 
+    GeneralizedNewtypeDeriving, 
+    BangPatterns,
+    TypeOperators,
+    DeriveDataTypeable,
+    FlexibleInstances,
+    TypeFamilies,
+    UndecidableInstances,
+    ScopedTypeVariables #-}
+
+module Numeric.Coalgebra.Geometric
+  ( 
+  -- * Geometric coalgebra primitives
+    BasisCoblade(..)
+  , Comultivector
+  -- * Operations over an eigenbasis
+  , Eigenbasis(..)
+  , Eigenmetric(..)
+  -- * Grade
+  , grade
+  , filterGrade
+  -- * Inversions
+  , reverse
+  , gradeInversion
+  , cliffordConjugate
+  -- * Products
+  , geometric
+  , outer
+  -- * Inner products
+  , contractL
+  , contractR
+  , hestenes
+  , dot
+  , liftProduct
+  ) where
+
+import Control.Monad (mfilter)
+import Data.Bits
+import Data.Functor.Representable.Trie
+import Data.Word
+import Data.Data
+import Data.Ix
+import Data.Array.Unboxed
+import Numeric.Algebra
+import Prelude hiding ((-),(*),(+),negate,reverse)
+
+-- a basis vector for a simple geometric coalgebra with the Euclidean inner product
+newtype BasisCoblade m = BasisCoblade { runBasisCoblade :: Word64 } deriving 
+  ( Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral
+  , Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal
+  , Multiplicative,Unital,Commutative
+  , Semiring,Rig
+  , DecidableZero,DecidableAssociates,DecidableUnits
+  )
+
+instance HasTrie (BasisCoblade m) where
+  type BaseTrie (BasisCoblade m) = BaseTrie Word64
+  embedKey = embedKey . runBasisCoblade
+  projectKey = BasisCoblade . projectKey
+
+-- A metric space over an eigenbasis
+class Eigenbasis m where
+  euclidean     :: proxy m -> Bool
+  antiEuclidean :: proxy m -> Bool
+  v             :: m -> BasisCoblade m
+  e             :: Int -> m
+
+-- assuming n /= 0, find the index of the least significant set bit in a basis blade
+lsb :: BasisCoblade m -> Int
+lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58
+  where 
+    -- a 64 bit deBruijn multiplication table
+    ix :: UArray (BasisCoblade m) Word8
+    ix = listArray (0, 63) 
+      [ 63,  0, 58,  1, 59, 47, 53,  2
+      , 60, 39, 48, 27, 54, 33, 42,  3
+      , 61, 51, 37, 40, 49, 18, 28, 20
+      , 55, 30, 34, 11, 43, 14, 22,  4
+      , 62, 57, 46, 52, 38, 26, 32, 41
+      , 50, 36, 17, 19, 29, 10, 13, 21
+      , 56, 45, 25, 31, 35, 16,  9, 12
+      , 44, 24, 15,  8, 23,  7,  6,  5
+      ]
+
+class (Ring r, Eigenbasis m) => Eigenmetric r m where
+  metric :: m -> r
+
+type Comultivector r m = Covector r (BasisCoblade m)
+
+-- Euclidean basis, we can work with basis vectors for euclidean spaces of up to 64 dimensions without 
+-- expanding the representation of our basis vectors
+newtype Euclidean = Euclidean Int deriving 
+  ( Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral
+  , Data,Typeable
+  , Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group
+  , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative
+  , Semiring,Rig,Ring
+  )
+
+instance HasTrie Euclidean where
+  type BaseTrie Euclidean = BaseTrie Int
+  embedKey (Euclidean i) = embedKey i
+  projectKey = Euclidean . projectKey
+
+instance Eigenbasis Euclidean where
+  euclidean _ = True
+  antiEuclidean _ = False
+  v n = shiftL 1 (fromIntegral n)
+  e = fromIntegral
+
+instance Ring r => Eigenmetric r Euclidean where
+  metric _ = one
+
+grade :: BasisCoblade m -> Int
+grade = fromIntegral . count 5 . count 4 . count 3 . count 2 . count 1 . count 0 where 
+  count c x = (x .&. mask) + (shiftR x p .&. mask) where 
+    p = shiftL 1 c
+    mask = (-1) `div` (shiftL 1 p + 1)
+
+m1powTimes :: (Bits n, Group r) => n -> r -> r
+m1powTimes n r 
+  | (n .&. 1) == 0 = r
+  | otherwise      = negate r
+
+reorder :: Group r => BasisCoblade m -> BasisCoblade m -> r -> r
+reorder a0 b = m1powTimes $ go 0 (shiftR a0 1)
+  where
+    go !acc 0 = acc
+    go acc a = go (acc + grade (a .&. b)) (shiftR a 1)
+
+-- <A>_k
+filterGrade :: Monoidal r => BasisCoblade m -> Int -> Comultivector r m
+filterGrade b k | grade b == k = zero
+                | otherwise    = return b
+
+instance Eigenmetric r m => Coalgebra r (BasisCoblade m) where
+  comult f n m = scale (n .&. m) $ reorder n m $ f $ xor n m where
+    scale b
+      | euclidean n = id
+      | otherwise   = (go one b *)
+    go :: Eigenmetric r m => r -> BasisCoblade m -> r
+    go acc 0 = acc
+    go acc n' | b <- lsb n'
+              , m' <- metric (e b :: m)
+              = go (acc*m') (clearBit n' b)
+
+instance Eigenmetric r m => CounitalCoalgebra r (BasisCoblade m) where
+  counit f = f (BasisCoblade zero)
+
+-- instance Group r => InvertibleModule r BasisCoblade where
+  
+-- reversion (A~) is an involution for the outer product
+reverse :: Group r => BasisCoblade m -> Comultivector r m
+reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where
+  g = grade b
+
+cliffordConjugate :: Group r => BasisCoblade m -> Comultivector r m
+cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where
+  g = grade b
+
+-- A^
+gradeInversion :: Group r => BasisCoblade m -> Comultivector r m
+gradeInversion b = grade b `m1powTimes` return b
+
+geometric :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m  
+geometric = multM
+
+outer :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+outer m n | m .&. n == 0 = geometric m n 
+          | otherwise    = zero
+
+-- A _| B
+-- grade (A _| B) = grade B - grade A
+contractL :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m 
+contractL a b 
+  | ga Prelude.> gb   = zero
+  | otherwise = mfilter (\r -> grade r == gb - ga) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+-- A |_ B
+-- grade (A |_ B) = grade A - grade B
+contractR :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+contractR a b 
+  | ga Prelude.< gb   = zero
+  | otherwise = mfilter (\r -> grade r == ga - gb) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+-- the modified Hestenes' product
+dot :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+dot a b = mfilter (\r -> grade r == abs(grade a - grade b)) (geometric a b)
+
+-- Hestenes' inner product
+-- if 0 /= grade a <= grade b then 
+-- dot a b = hestenes a b = leftContract a b
+hestenes :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+hestenes a b
+  | ga == 0 || gb == 0 = zero
+  | otherwise = mfilter (\r -> grade r == abs(ga - gb)) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+liftProduct :: (BasisCoblade m -> BasisCoblade m -> Comultivector r m) -> Comultivector r m -> Comultivector r m -> Comultivector r m
+liftProduct f ma mb = do
+  a <- ma
+  b <- mb
+  f a b
diff --git a/Numeric/Coalgebra/Hyperbolic.hs b/Numeric/Coalgebra/Hyperbolic.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Hyperbolic.hs
@@ -0,0 +1,212 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Coalgebra.Hyperbolic 
+  ( Hyperbolic(..)
+  , HyperBasis(..)
+  , Hyper(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Monoid
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Coalgebra.Hyperbolic.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, cosh, sinh)
+
+-- complex basis
+data HyperBasis = Cosh | Sinh deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Hyperbolic HyperBasis where
+  cosh = Cosh
+  sinh = Sinh
+
+instance Rig r => Hyperbolic (Hyper r) where
+  cosh = Hyper one zero
+  sinh = Hyper zero one
+  
+instance Rig r => Hyperbolic (HyperBasis -> r) where
+  cosh Sinh = zero
+  cosh Cosh = one
+  sinh Sinh = one
+  sinh Cosh = zero
+
+type instance Key Hyper = HyperBasis
+
+instance Representable Hyper where
+  tabulate f = Hyper (f Cosh) (f Sinh)
+
+instance Indexable Hyper where
+  index (Hyper a _ ) Cosh = a
+  index (Hyper _ b ) Sinh = b
+
+instance Lookup Hyper where
+  lookup = lookupDefault
+
+instance Adjustable Hyper where
+  adjust f Cosh (Hyper a b) = Hyper (f a) b
+  adjust f Sinh (Hyper a b) = Hyper a (f b)
+
+instance Distributive Hyper where
+  distribute = distributeRep 
+
+instance Functor Hyper where
+  fmap f (Hyper a b) = Hyper (f a) (f b)
+
+instance Zip Hyper where
+  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Hyper where
+  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f Cosh a1 a2) (f Sinh b1 b2)
+
+instance Keyed Hyper where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Hyper where
+  (<.>) = apRep
+
+instance Applicative Hyper where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Hyper where
+  (>>-) = bindRep
+
+instance Monad Hyper where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader HyperBasis Hyper where
+  ask = askRep
+  local = localRep
+
+instance Foldable Hyper where
+  foldMap f (Hyper a b) = f a `mappend` f b
+
+instance FoldableWithKey Hyper where
+  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh b
+
+instance Traversable Hyper where
+  traverse f (Hyper a b) = Hyper <$> f a <*> f b
+
+instance TraversableWithKey Hyper where
+  traverseWithKey f (Hyper a b) = Hyper <$> f Cosh a <*> f Sinh b
+
+instance Foldable1 Hyper where
+  foldMap1 f (Hyper a b) = f a <> f b
+
+instance FoldableWithKey1 Hyper where
+  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh b
+
+instance Traversable1 Hyper where
+  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b
+
+instance TraversableWithKey1 Hyper where
+  traverseWithKey1 f (Hyper a b) = Hyper <$> f Cosh a <.> f Sinh b
+
+instance HasTrie HyperBasis where
+  type BaseTrie HyperBasis = Hyper
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Hyper r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Hyper s) where
+  r .* Hyper a b = Hyper (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Hyper s) where
+  Hyper a b *. r = Hyper (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Hyper r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Hyper r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Hyper r)
+
+instance Idempotent r => Idempotent (Hyper r)
+
+instance Partitionable r => Partitionable (Hyper r) where
+  partitionWith f (Hyper a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a
+
+-- | the trivial diagonal algebra
+instance Semiring k => Algebra k HyperBasis where
+  mult f = f' where
+    fs = f Sinh Sinh
+    fc = f Cosh Cosh
+    f' Sinh = fs
+    f' Cosh = fc
+
+instance Semiring k => UnitalAlgebra k HyperBasis where
+  unit = const
+
+-- | the hyperbolic trigonometric coalgebra
+instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where
+  comult f = f' where
+     fs = f Sinh
+     fc = f Cosh
+     f' Sinh Sinh = fc
+     f' Sinh Cosh = fs 
+     f' Cosh Sinh = fs
+     f' Cosh Cosh = fc
+
+instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where
+  counit f = f Cosh
+
+instance (Commutative k, Semiring k) => Bialgebra k HyperBasis
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis where
+  inv f = f' where
+    afc = adjoint (f Cosh)
+    nfs = negate (f Sinh)
+    f' Cosh = afc
+    f' Sinh = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis where
+  antipode = inv
+
+instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where
+  (*) = mulRep
+
+instance (Commutative k, Semiring k) => Commutative (Hyper k)
+
+instance (Commutative k, Semiring k) => Semiring (Hyper k)
+
+instance (Commutative k, Rig k) => Unital (Hyper k) where
+  one = Hyper one zero
+
+instance (Commutative r, Rig r) => Rig (Hyper r) where
+  fromNatural n = Hyper (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Hyper r) where
+  fromInteger n = Hyper (fromInteger n) zero
+
+instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)
+instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)
+
+instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveMultiplication (Hyper r) where
+  adjoint (Hyper a b) = Hyper (adjoint a) (negate b)
+
+instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
diff --git a/Numeric/Coalgebra/Hyperbolic/Class.hs b/Numeric/Coalgebra/Hyperbolic/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Hyperbolic/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Coalgebra.Hyperbolic.Class
+  ( Hyperbolic(..)
+  ) where
+
+import Prelude (return)
+import Numeric.Covector
+
+class Hyperbolic r where
+  cosh :: r
+  sinh :: r
+
+instance Hyperbolic a => Hyperbolic (Covector r a) where
+  cosh = return cosh
+  sinh = return sinh
diff --git a/Numeric/Coalgebra/Quaternion.hs b/Numeric/Coalgebra/Quaternion.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Quaternion.hs
@@ -0,0 +1,317 @@
+{-# LANGUAGE FlexibleInstances
+           , MultiParamTypeClasses
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Coalgebra.Quaternion
+  ( Distinguished(..)
+  , Complicated(..)
+  , Hamiltonian(..)
+  , QuaternionBasis'(..)
+  , Quaternion'(..)
+  , complicate'
+  , vectorPart'
+  , scalarPart'
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Ix hiding (index)
+import Data.Key
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Traversable
+import Data.Monoid
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
+import qualified Numeric.Algebra.Complex as Complex
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+
+instance Distinguished QuaternionBasis' where
+  e = E'
+
+instance Complicated QuaternionBasis' where
+  i = I'
+
+instance Hamiltonian QuaternionBasis' where
+  j = J'
+  k = K'
+
+instance Rig r => Distinguished (Quaternion' r) where
+  e = Quaternion' one zero zero zero
+
+instance Rig r => Complicated (Quaternion' r) where
+  i = Quaternion' zero one zero zero
+
+instance Rig r => Hamiltonian (Quaternion' r) where
+  j = Quaternion' zero zero one zero
+  k = Quaternion' one zero zero one 
+
+instance Rig r => Distinguished (QuaternionBasis' :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (QuaternionBasis' :->: r) where
+  i = Trie i
+
+instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where
+  j = Trie j
+  k = Trie k
+
+instance Rig r => Distinguished (QuaternionBasis' -> r) where
+  e E' = one 
+  e _ = zero
+
+instance Rig r => Complicated (QuaternionBasis' -> r) where
+  i I' = one
+  i _ = zero
+  
+instance Rig r => Hamiltonian (QuaternionBasis' -> r) where
+  j J' = one
+  j _ = zero
+
+  k K' = one
+  k _ = zero
+
+-- quaternion basis
+data QuaternionBasis' = E' | I' | J' | K' deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
+
+data Quaternion' a = Quaternion' a a a a deriving (Eq,Show,Read,Data,Typeable)
+
+type instance Key Quaternion' = QuaternionBasis'
+
+instance Representable Quaternion' where
+  tabulate f = Quaternion' (f E') (f I') (f J') (f K')
+
+instance Indexable Quaternion' where
+  index (Quaternion' a _ _ _) E' = a
+  index (Quaternion' _ b _ _) I' = b
+  index (Quaternion' _ _ c _) J' = c
+  index (Quaternion' _ _ _ d) K' = d
+
+instance Lookup Quaternion' where
+  lookup = lookupDefault
+
+instance Adjustable Quaternion' where
+  adjust f E' (Quaternion' a b c d) = Quaternion' (f a) b c d
+  adjust f I' (Quaternion' a b c d) = Quaternion' a (f b) c d
+  adjust f J' (Quaternion' a b c d) = Quaternion' a b (f c) d
+  adjust f K' (Quaternion' a b c d) = Quaternion' a b c (f d)
+
+instance Distributive Quaternion' where
+  distribute = distributeRep 
+
+instance Functor Quaternion' where
+  fmap = fmapRep
+
+instance Zip Quaternion' where
+  zipWith f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) = 
+    Quaternion' (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)
+
+instance ZipWithKey Quaternion' where
+  zipWithKey f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) = 
+    Quaternion' (f E' a1 a2) (f I' b1 b2) (f J' c1 c2) (f K' d1 d2)
+
+instance Keyed Quaternion' where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Quaternion' where
+  (<.>) = apRep
+
+instance Applicative Quaternion' where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Quaternion' where
+  (>>-) = bindRep
+
+instance Monad Quaternion' where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader QuaternionBasis' Quaternion' where
+  ask = askRep
+  local = localRep
+
+instance Foldable Quaternion' where
+  foldMap f (Quaternion' a b c d) = 
+    f a `mappend` f b `mappend` f c `mappend` f d
+
+instance FoldableWithKey Quaternion' where
+  foldMapWithKey f (Quaternion' a b c d) = 
+    f E' a `mappend` f I' b `mappend` f J' c `mappend` f K' d
+
+instance Traversable Quaternion' where
+  traverse f (Quaternion' a b c d) = 
+    Quaternion' <$> f a <*> f b <*> f c <*> f d
+
+instance TraversableWithKey Quaternion' where
+  traverseWithKey f (Quaternion' a b c d) = 
+    Quaternion' <$> f E' a <*> f I' b <*> f J' c <*> f K' d
+
+instance Foldable1 Quaternion' where
+  foldMap1 f (Quaternion' a b c d) = 
+    f a <> f b <> f c <> f d
+
+instance FoldableWithKey1 Quaternion' where
+  foldMapWithKey1 f (Quaternion' a b c d) = 
+    f E' a <> f I' b <> f J' c <> f K' d
+
+instance Traversable1 Quaternion' where
+  traverse1 f (Quaternion' a b c d) = 
+    Quaternion' <$> f a <.> f b <.> f c <.> f d
+
+instance TraversableWithKey1 Quaternion' where
+  traverseWithKey1 f (Quaternion' a b c d) = 
+    Quaternion' <$> f E' a <.> f I' b <.> f J' c <.> f K' d
+
+instance HasTrie QuaternionBasis' where
+  type BaseTrie QuaternionBasis' = Quaternion'
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Quaternion' r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Quaternion' s) where
+  r .* Quaternion' a b c d =
+    Quaternion' (r .* a) (r .* b) (r .* c) (r .* d)
+
+instance RightModule r s => RightModule r (Quaternion' s) where
+  Quaternion' a b c d *. r =
+    Quaternion' (a *. r) (b *. r) (c *. r) (d *. r)
+
+instance Monoidal r => Monoidal (Quaternion' r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Quaternion' r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Quaternion' r)
+
+instance Idempotent r => Idempotent (Quaternion' r)
+
+instance Partitionable r => Partitionable (Quaternion' r) where
+  partitionWith f (Quaternion' a b c d) = id =<<
+    partitionWith (\a1 a2 -> id =<< 
+    partitionWith (\b1 b2 -> id =<< 
+    partitionWith (\c1 c2 -> 
+    partitionWith (\d1 d2 -> f (Quaternion' a1 b1 c1 d1) 
+                               (Quaternion' a2 b2 c2 d2)
+                  ) d) c) b) a
+
+-- | the trivial diagonal algebra
+instance (TriviallyInvolutive r, Semiring r) => Algebra r QuaternionBasis' where
+  mult f = f' where
+    fe = f E' E'
+    fi = f I' I'
+    fj = f J' J'
+    fk = f K' K'
+    f' E' = fe
+    f' I' = fi
+    f' J' = fj
+    f' K' = fk
+             
+instance (TriviallyInvolutive r, Semiring r) => UnitalAlgebra r QuaternionBasis' where
+  unit = const
+
+
+-- | dual quaternion comultiplication
+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis' where
+  comult f = f' where
+    fe = f E'
+    fi = f I'
+    fj = f J'
+    fk = f K'
+    fe' = negate fe
+    fi' = negate fi
+    fj' = negate fj
+    fk' = negate fk
+    f' E' E' = fe
+    f' E' I' = fi
+    f' E' J' = fj
+    f' E' K' = fk
+    f' I' E' = fi
+    f' I' I' = fe'
+    f' I' J' = fk
+    f' I' K' = fj'
+    f' J' E' = fj
+    f' J' I' = fk'
+    f' J' J' = fe'
+    f' J' K' = fi
+    f' K' E' = fk
+    f' K' I' = fj
+    f' K' J' = fi'
+    f' K' K' = fe'
+
+instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis' where
+  counit f = f E'
+
+instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis' 
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis' where
+  inv f E' = f E'
+  inv f b = negate (f b)
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis' where
+  coinv = inv
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis' where
+  antipode = inv
+
+instance (TriviallyInvolutive r, Semiring r) => Multiplicative (Quaternion' r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Semiring r) => Semiring (Quaternion' r)
+
+instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion' r) where
+  one = oneRep
+
+instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion' r) where
+  fromNatural n = Quaternion' (fromNatural n) zero zero zero
+
+instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion' r) where
+  fromInteger n = Quaternion' (fromInteger n) zero zero zero
+
+instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion' r) (Quaternion' r) where 
+  (.*) = (*)
+instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion' r) (Quaternion' r) where 
+  (*.) = (*)
+
+instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion' r) where
+  -- without trivial involution, multiplication fails associativity, and we'd need to 
+  -- support weaker multiplicative properties like Alternative and PowerAssociative
+  adjoint (Quaternion' a b c d) = Quaternion' a (negate b) (negate c) (negate d)
+
+-- | Cayley-Dickson quaternion isomorphism (one way)
+complicate' :: Complicated c => QuaternionBasis' -> (c , c)
+complicate' E' = (e, e)
+complicate' I' = (i, e)
+complicate' J' = (e, i)
+complicate' K' = (i, i)
+
+scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r
+scalarPart' f = index f E'
+
+vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)
+vectorPart' f = (index f I', index f J', index f K')
+
+instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where
+  quadrance n = scalarPart' (adjoint n * n)
+
+instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion' r) where
+  recip q@(Quaternion' a b c d) = Quaternion' (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
+    where qq = quadrance q
diff --git a/Numeric/Coalgebra/Trigonometric.hs b/Numeric/Coalgebra/Trigonometric.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Trigonometric.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Coalgebra.Trigonometric 
+  ( Trigonometric(..)
+  , TrigBasis(..)
+  , Trig(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Monoid
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Coalgebra.Trigonometric.Class
+
+-- the dual complex basis
+data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished TrigBasis where
+  e = Cos
+
+instance Complicated TrigBasis where
+  i = Sin
+
+instance Trigonometric TrigBasis where
+  cos = Cos
+  sin = Sin
+
+instance Rig r => Distinguished (Trig r) where
+  e = Trig one zero
+
+instance Rig r => Complicated (Trig r) where
+  i = Trig zero one
+
+instance Rig r => Trigonometric (Trig r) where
+  cos = Trig one zero
+  sin = Trig zero one
+
+instance Rig r => Distinguished (TrigBasis -> r) where
+  e = cos
+
+instance Rig r => Complicated (TrigBasis -> r) where
+  i = sin
+  
+instance Rig r => Trigonometric (TrigBasis -> r) where
+  cos Sin = zero
+  cos Cos = one
+
+  sin Sin = one
+  sin Cos = zero
+
+instance Rig r => Trigonometric (TrigBasis :->: r) where
+  cos = Trie cos
+  sin = Trie sin
+
+instance Rig r => Distinguished (TrigBasis :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (TrigBasis :->: r) where
+  i = Trie i
+  
+type instance Key Trig = TrigBasis
+
+instance Representable Trig where
+  tabulate f = Trig (f Cos) (f Sin)
+
+instance Indexable Trig where
+  index (Trig a _ ) Cos = a
+  index (Trig _ b ) Sin = b
+
+instance Lookup Trig where
+  lookup = lookupDefault
+
+instance Adjustable Trig where
+  adjust f Cos (Trig a b) = Trig (f a) b
+  adjust f Sin (Trig a b) = Trig a (f b)
+
+instance Distributive Trig where
+  distribute = distributeRep 
+
+instance Functor Trig where
+  fmap f (Trig a b) = Trig (f a) (f b)
+
+instance Zip Trig where
+  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Trig where
+  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f Cos a1 a2) (f Sin b1 b2)
+
+instance Keyed Trig where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Trig where
+  (<.>) = apRep
+
+instance Applicative Trig where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Trig where
+  (>>-) = bindRep
+
+instance Monad Trig where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader TrigBasis Trig where
+  ask = askRep
+  local = localRep
+
+instance Foldable Trig where
+  foldMap f (Trig a b) = f a `mappend` f b
+
+instance FoldableWithKey Trig where
+  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin b
+
+instance Traversable Trig where
+  traverse f (Trig a b) = Trig <$> f a <*> f b
+
+instance TraversableWithKey Trig where
+  traverseWithKey f (Trig a b) = Trig <$> f Cos a <*> f Sin b
+
+instance Foldable1 Trig where
+  foldMap1 f (Trig a b) = f a <> f b
+
+instance FoldableWithKey1 Trig where
+  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin b
+
+instance Traversable1 Trig where
+  traverse1 f (Trig a b) = Trig <$> f a <.> f b
+
+instance TraversableWithKey1 Trig where
+  traverseWithKey1 f (Trig a b) = Trig <$> f Cos a <.> f Sin b
+
+instance HasTrie TrigBasis where
+  type BaseTrie TrigBasis = Trig
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Trig r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Trig s) where
+  r .* Trig a b = Trig (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Trig s) where
+  Trig a b *. r = Trig (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Trig r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Trig r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Trig r)
+
+instance Idempotent r => Idempotent (Trig r)
+
+instance Partitionable r => Partitionable (Trig r) where
+  partitionWith f (Trig a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a
+
+-- the diagonal algebra
+instance (Commutative k, Rng k) => Algebra k TrigBasis where
+  mult f = f' where
+    fc = f Cos Cos
+    fs = f Sin Sin
+    f' Cos = fc
+    f' Sin = fs
+
+-- 
+instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where
+  unit = const
+
+-- The trigonometric coalgebra
+instance (Commutative k, Rng k) => Coalgebra k TrigBasis where
+  comult f = f' where
+     fs = f Sin
+     fc = f Cos
+     fc' = negate fc
+     f' Sin Sin = fc'
+     f' Sin Cos = fs 
+     f' Cos Sin = fs
+     f' Cos Cos = fc
+
+instance (Commutative k, Rng k) => Bialgebra k TrigBasis
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where
+  inv f = f' where
+    afc = adjoint (f Cos)
+    nfs = negate (f Sin)
+    f' Cos = afc
+    f' Sin = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where
+  antipode = inv
+
+instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where
+  counit f = f Cos
+
+instance (Commutative k, Rng k) => Multiplicative (Trig k) where
+  (*) = mulRep
+
+instance (Commutative k, Rng k) => Commutative (Trig k)
+
+instance (Commutative k, Rng k) => Semiring (Trig k)
+
+instance (Commutative k, Ring k) => Unital (Trig k) where
+  one = Trig one zero
+
+instance (Commutative r, Ring r) => Rig (Trig r) where
+  fromNatural n = Trig (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Trig r) where
+  fromInteger n = Trig (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where
+  adjoint (Trig a b) = Trig (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
diff --git a/Numeric/Coalgebra/Trigonometric/Class.hs b/Numeric/Coalgebra/Trigonometric/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Coalgebra/Trigonometric/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Coalgebra.Trigonometric.Class
+  ( Trigonometric(..)
+  ) where
+
+import Prelude (return)
+import Numeric.Covector
+
+class Trigonometric r where
+  cos :: r
+  sin :: r
+
+instance Trigonometric a => Trigonometric (Covector r a) where
+  cos = return cos
+  sin = return sin
diff --git a/Numeric/Field/Class.hs b/Numeric/Field/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Field/Class.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Field.Class 
+  ( Field
+  ) where
+
+import Numeric.Ring.Division
+import Numeric.Algebra.Commutative
+
+class (Commutative r, DivisionRing r) => Field r
+instance (Commutative r, DivisionRing r) => Field r
diff --git a/Numeric/Ring/Division.hs b/Numeric/Ring/Division.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Ring/Division.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Ring.Division
+  ( DivisionRing
+  ) where
+
+import Numeric.Algebra.Division
+import Numeric.Ring.Class
+
+class (Division r, Ring r) => DivisionRing r
+instance (Division r, Ring r) => DivisionRing r
diff --git a/algebra.cabal b/algebra.cabal
--- a/algebra.cabal
+++ b/algebra.cabal
@@ -1,6 +1,6 @@
 name:          algebra
 category:      Math, Algebra
-version:       0.6.0
+version:       0.7.0
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -34,16 +34,27 @@
     representable-tries >= 2.0 && < 2.1,
     void >= 0.5.4 && < 0.6
 
--- reflection >= 0.4 && < 0.5,
   exposed-modules:
     Numeric.Algebra
+    Numeric.Covector
+    Numeric.Natural
+
+    Numeric.Algebra.Distinguished.Class
     Numeric.Algebra.Complex
+    Numeric.Algebra.Complex.Class
+    Numeric.Algebra.Dual
+    Numeric.Algebra.Dual.Class
     Numeric.Algebra.Quaternion
-    Numeric.Algebra.Trigonometric
+    Numeric.Algebra.Quaternion.Class
     Numeric.Algebra.Hyperbolic
-    Numeric.Algebra.Geometric
+    Numeric.Coalgebra.Dual
+    Numeric.Coalgebra.Hyperbolic
+    Numeric.Coalgebra.Hyperbolic.Class
+    Numeric.Coalgebra.Trigonometric
+    Numeric.Coalgebra.Trigonometric.Class
+    Numeric.Coalgebra.Geometric
+    Numeric.Coalgebra.Quaternion
     Numeric.Band.Rectangular
-    Numeric.Covector
     Numeric.Exp
     Numeric.Log
     Numeric.Map
@@ -64,10 +75,10 @@
     Numeric.Algebra.Commutative
     Numeric.Algebra.Factorable
     Numeric.Algebra.Hopf
-    Numeric.Natural
     Numeric.Decidable.Zero
     Numeric.Decidable.Units
     Numeric.Decidable.Associates
+    Numeric.Field.Class
     Numeric.Module.Class
     Numeric.Module.Representable
     Numeric.Semiring.Integral
@@ -78,6 +89,7 @@
     Numeric.Rig.Class
     Numeric.Rng.Class
     Numeric.Ring.Class
+    Numeric.Ring.Division
     Numeric.Rig.Ordered
     Numeric.Rig.Characteristic
     Numeric.Order.Class