diff --git a/Numeric/Addition.hs b/Numeric/Addition.hs
deleted file mode 100644
--- a/Numeric/Addition.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Numeric.Addition 
-  ( module Numeric.Addition.Abelian
-  , module Numeric.Addition.Idempotent
-  , module Numeric.Addition.Partitionable
-  , module Numeric.Semigroup.Additive
-  , module Numeric.Monoid.Additive
-  , module Numeric.Group.Additive
-  ) where
-
-import Numeric.Addition.Abelian
-import Numeric.Addition.Idempotent
-import Numeric.Addition.Partitionable
-import Numeric.Semigroup.Additive
-import Numeric.Monoid.Additive
-import Numeric.Group.Additive
diff --git a/Numeric/Addition/Abelian.hs b/Numeric/Addition/Abelian.hs
deleted file mode 100644
--- a/Numeric/Addition/Abelian.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Numeric.Addition.Abelian
-  ( 
-  -- * An Addition Abelian Semigroup
-    Abelian
-  ) where
-
-import Data.Int
-import Data.Word
-import Numeric.Semigroup.Additive
-import Numeric.Natural.Internal
-
--- | an additive abelian semigroup
---
--- a + b = b + a
-class Additive r => Abelian r
-
-instance Abelian r => Abelian (e -> r)
-instance Abelian ()
-instance Abelian Bool
-instance Abelian Integer
-instance Abelian Natural
-instance Abelian Int
-instance Abelian Int8
-instance Abelian Int16
-instance Abelian Int32
-instance Abelian Int64
-instance Abelian Word
-instance Abelian Word8
-instance Abelian Word16
-instance Abelian Word32
-instance Abelian Word64
-instance (Abelian a, Abelian b) => Abelian (a,b) 
-instance (Abelian a, Abelian b, Abelian c) => Abelian (a,b,c) 
-instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a,b,c,d) 
-instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a,b,c,d,e) 
diff --git a/Numeric/Addition/Idempotent.hs b/Numeric/Addition/Idempotent.hs
deleted file mode 100644
--- a/Numeric/Addition/Idempotent.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Numeric.Addition.Idempotent
-  ( 
-  -- * Additive Monoids
-    Idempotent
-  , replicate1pIdempotent
-  , replicateIdempotent
-  ) where
-
-import Numeric.Semigroup.Additive
-import Numeric.Monoid.Additive
-import Numeric.Natural.Internal
-
--- | An additive semigroup with idempotent addition.
---
--- > a + a = a
---
--- An (Idempotent r, Rig r) => r is also known as a dioid
-class Additive r => Idempotent r
-
-replicate1pIdempotent :: Natural -> r -> r
-replicate1pIdempotent _ r = r
-
-replicateIdempotent :: (Integral n, Idempotent r, AdditiveMonoid r) => n -> r -> r
-replicateIdempotent 0 _ = zero
-replicateIdempotent _ x = x
-
-instance Idempotent ()
-instance Idempotent Bool
-instance Idempotent r => Idempotent (e -> r)
-instance (Idempotent a, Idempotent b) => Idempotent (a,b)
-instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c)
-instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)
-instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)
diff --git a/Numeric/Addition/Partitionable.hs b/Numeric/Addition/Partitionable.hs
deleted file mode 100644
--- a/Numeric/Addition/Partitionable.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-module Numeric.Addition.Partitionable
-  ( -- * Partitionable Additive Semigroups
-    Partitionable(..)
-  ) where
-
-import Prelude ((-),Bool(..),($),id,(>>=))
-import Numeric.Semigroup.Additive
-import Numeric.Natural
-import Data.List.NonEmpty (NonEmpty(..), fromList)
-
-concat :: NonEmpty (NonEmpty a) -> NonEmpty a
-concat m = m >>= id
-
-class Additive m => Partitionable m where
-  -- | partitionWith f c returns a list containing f a b for each a b such that a + b = c, 
-  partitionWith :: (m -> m -> r) -> m -> NonEmpty r
-
-instance Partitionable Bool where
-  partitionWith f False = f False False :| []
-  partitionWith f True  = f False True :| [f True False, f True True]
-
-instance Partitionable Natural where
-  partitionWith f n = fromList [ f k (n - k) | k <- [0..n] ]
-
-instance Partitionable () where
-  partitionWith f () = f () () :| []
-
-instance (Partitionable a, Partitionable b) => Partitionable (a,b) where
-  partitionWith f (a,b) = concat $ partitionWith (\ax ay -> 
-                                   partitionWith (\bx by -> f (ax,bx) (ay,by)) b) a
-
-instance (Partitionable a, Partitionable b, Partitionable c) => Partitionable (a,b,c) where
-  partitionWith f (a,b,c) = concat $ partitionWith (\ax ay -> 
-                            concat $ partitionWith (\bx by -> 
-                                     partitionWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a
-
-instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d ) => Partitionable (a,b,c,d) where
-  partitionWith f (a,b,c,d) = concat $ partitionWith (\ax ay -> 
-                              concat $ partitionWith (\bx by -> 
-                              concat $ partitionWith (\cx cy -> 
-                                       partitionWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a
-
-instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d, Partitionable e) => Partitionable (a,b,c,d,e) where
-  partitionWith f (a,b,c,d,e) = concat $ partitionWith (\ax ay -> 
-                                concat $ partitionWith (\bx by -> 
-                                concat $ partitionWith (\cx cy -> 
-                                concat $ partitionWith (\dx dy -> 
-                                         partitionWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a
diff --git a/Numeric/Additive/Class.hs b/Numeric/Additive/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Additive/Class.hs
@@ -0,0 +1,214 @@
+module Numeric.Additive.Class
+  ( 
+  -- * Additive Semigroups
+    Additive(..)
+  , sum1
+  -- * Additive Abelian semigroups
+  , Abelian
+  -- * Additive Monoids
+  , Idempotent
+  , replicate1pIdempotent
+  -- * Partitionable semigroups
+  , Partitionable(..)
+  ) where
+
+import Data.Int
+import Data.Word
+import Data.Semigroup.Foldable
+import Data.Foldable hiding (concat)
+import Numeric.Natural.Internal
+import Prelude ((-),Bool(..),($),id,(>>=),fromIntegral,(*),otherwise,quot,maybe,error,even,Maybe(..),(==),(.),($!),Integer,(||),toInteger,Integral)
+import qualified Prelude
+import Data.List.NonEmpty (NonEmpty(..), fromList)
+
+infixl 6 +
+
+-- | 
+-- > (a + b) + c = a + (b + c)
+-- > replicate 1 a = a
+-- > replicate (2 * n) a = replicate n a + replicate n a
+-- > replicate (2 * n + 1) a = replicate n a + replicate n a + a
+class Additive r where
+  (+) :: r -> r -> r
+
+  -- | replicate1p n r = replicate (1 + n) r
+  replicate1p :: Whole n => n -> r -> r
+  replicate1p y0 x0 = f x0 (1 Prelude.+ y0)
+    where
+      f x y
+        | even y = f (x + x) (y `quot` 2)
+        | y == 1 = x
+        | otherwise = g (x + x) (unsafePred y  `quot` 2) x
+      g x y z
+        | even y = g (x + x) (y `quot` 2) z
+        | y == 1 = x + z
+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)
+
+  sumWith1 :: Foldable1 f => (a -> r) -> f a -> r
+  sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing
+     where mf Nothing y = Just $! f y 
+           mf (Just x) y = Just $! x + f y
+
+sum1 :: (Foldable1 f, Additive r) => f r -> r
+sum1 = sumWith1 id
+
+instance Additive r => Additive (b -> r) where
+  f + g = \e -> f e + g e 
+  replicate1p n f e = replicate1p n (f e)
+  sumWith1 f xs e = sumWith1 (`f` e) xs
+
+instance Additive Bool where
+  (+) = (||)
+  replicate1p _ a = a
+
+instance Additive Natural where
+  (+) = (Prelude.+)
+  replicate1p n r = (1 Prelude.+ toNatural n) * r
+
+instance Additive Integer where 
+  (+) = (Prelude.+)
+  replicate1p n r = (1 Prelude.+ toInteger n) * r
+
+instance Additive Int where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int8 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int16 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int32 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int64 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word8 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word16 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word32 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word64 where
+  (+) = (Prelude.+)
+  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive () where
+  _ + _ = ()
+  replicate1p _ _ = () 
+  sumWith1 _ _ = ()
+
+instance (Additive a, Additive b) => Additive (a,b) where
+  (a,b) + (i,j) = (a + i, b + j)
+  replicate1p n (a,b) = (replicate1p n a, replicate1p n b)
+
+instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where
+  (a,b,c) + (i,j,k) = (a + i, b + j, c + k)
+  replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c)
+
+instance (Additive a, Additive b, Additive c, Additive d) => Additive (a,b,c,d) where
+  (a,b,c,d) + (i,j,k,l) = (a + i, b + j, c + k, d + l)
+  replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d)
+
+instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a,b,c,d,e) where
+  (a,b,c,d,e) + (i,j,k,l,m) = (a + i, b + j, c + k, d + l, e + m)
+  replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e)
+
+
+concat :: NonEmpty (NonEmpty a) -> NonEmpty a
+concat m = m >>= id
+
+class Additive m => Partitionable m where
+  -- | partitionWith f c returns a list containing f a b for each a b such that a + b = c, 
+  partitionWith :: (m -> m -> r) -> m -> NonEmpty r
+
+instance Partitionable Bool where
+  partitionWith f False = f False False :| []
+  partitionWith f True  = f False True :| [f True False, f True True]
+
+instance Partitionable Natural where
+  partitionWith f n = fromList [ f k (n - k) | k <- [0..n] ]
+
+instance Partitionable () where
+  partitionWith f () = f () () :| []
+
+instance (Partitionable a, Partitionable b) => Partitionable (a,b) where
+  partitionWith f (a,b) = concat $ partitionWith (\ax ay -> 
+                                   partitionWith (\bx by -> f (ax,bx) (ay,by)) b) a
+
+instance (Partitionable a, Partitionable b, Partitionable c) => Partitionable (a,b,c) where
+  partitionWith f (a,b,c) = concat $ partitionWith (\ax ay -> 
+                            concat $ partitionWith (\bx by -> 
+                                     partitionWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a
+
+instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d ) => Partitionable (a,b,c,d) where
+  partitionWith f (a,b,c,d) = concat $ partitionWith (\ax ay -> 
+                              concat $ partitionWith (\bx by -> 
+                              concat $ partitionWith (\cx cy -> 
+                                       partitionWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a
+
+instance (Partitionable a, Partitionable b, Partitionable c,Partitionable d, Partitionable e) => Partitionable (a,b,c,d,e) where
+  partitionWith f (a,b,c,d,e) = concat $ partitionWith (\ax ay -> 
+                                concat $ partitionWith (\bx by -> 
+                                concat $ partitionWith (\cx cy -> 
+                                concat $ partitionWith (\dx dy -> 
+                                         partitionWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a
+
+
+-- | an additive abelian semigroup
+--
+-- a + b = b + a
+class Additive r => Abelian r
+
+instance Abelian r => Abelian (e -> r)
+instance Abelian ()
+instance Abelian Bool
+instance Abelian Integer
+instance Abelian Natural
+instance Abelian Int
+instance Abelian Int8
+instance Abelian Int16
+instance Abelian Int32
+instance Abelian Int64
+instance Abelian Word
+instance Abelian Word8
+instance Abelian Word16
+instance Abelian Word32
+instance Abelian Word64
+instance (Abelian a, Abelian b) => Abelian (a,b) 
+instance (Abelian a, Abelian b, Abelian c) => Abelian (a,b,c) 
+instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a,b,c,d) 
+instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a,b,c,d,e) 
+
+-- | An additive semigroup with idempotent addition.
+--
+-- > a + a = a
+--
+class Additive r => Idempotent r
+
+replicate1pIdempotent :: Natural -> r -> r
+replicate1pIdempotent _ r = r
+
+instance Idempotent ()
+instance Idempotent Bool
+instance Idempotent r => Idempotent (e -> r)
+instance (Idempotent a, Idempotent b) => Idempotent (a,b)
+instance (Idempotent a, Idempotent b, Idempotent c) => Idempotent (a,b,c)
+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d) => Idempotent (a,b,c,d)
+instance (Idempotent a, Idempotent b, Idempotent c, Idempotent d, Idempotent e) => Idempotent (a,b,c,d,e)
diff --git a/Numeric/Additive/Group.hs b/Numeric/Additive/Group.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Additive/Group.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+module Numeric.Additive.Group
+  ( -- * Additive Groups
+    Group(..)
+  ) where
+
+import Data.Int
+import Data.Word
+import Prelude hiding ((*), (+), (-), negate, subtract)
+import qualified Prelude
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+
+infixl 6 - 
+infixl 7 `times`
+
+class (LeftModule Integer r, RightModule Integer r, Monoidal r) => Group r where
+  (-)      :: r -> r -> r
+  negate   :: r -> r
+  subtract :: r -> r -> r
+  times    :: Integral n => n -> r -> r
+  times y0 x0 = case compare y0 0 of
+    LT -> f (negate x0) (Prelude.negate y0)
+    EQ -> zero
+    GT -> f x0 y0
+    where
+      f x y 
+        | even y = f (x + x) (y `quot` 2)
+        | y == 1 = x
+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x
+      g x y z 
+        | even y = g (x + x) (y `quot` 2) z
+        | y == 1 = x + z
+        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)
+
+  negate a = zero - a
+  a - b  = a + negate b 
+  subtract a b = negate a + b
+
+instance Group r => Group (e -> r) where
+  f - g = \x -> f x - g x
+  negate f x = negate (f x)
+  subtract f g x = subtract (f x) (g x)
+  times n f e = times n (f e)
+
+instance Group Integer where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Int where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Int8 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Int16 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Int32 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Int64 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Word where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Word8 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Word16 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Word32 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group Word64 where
+  (-) = (Prelude.-)
+  negate = Prelude.negate
+  subtract = Prelude.subtract
+  times n r = fromIntegral n * r
+
+instance Group () where 
+  _ - _   = ()
+  negate _ = ()
+  subtract _ _  = ()
+  times _ _   = ()
+
+instance (Group a, Group b) => Group (a,b) where
+  negate (a,b) = (negate a, negate b)
+  (a,b) - (i,j) = (a-i, b-j)
+  subtract (a,b) (i,j) = (subtract a i, subtract b j)
+  times n (a,b) = (times n a,times n b)
+
+instance (Group a, Group b, Group c) => Group (a,b,c) where
+  negate (a,b,c) = (negate a, negate b, negate c)
+  (a,b,c) - (i,j,k) = (a-i, b-j, c-k)
+  subtract (a,b,c) (i,j,k) = (subtract a i, subtract b j, subtract c k)
+  times n (a,b,c) = (times n a,times n b, times n c)
+
+instance (Group a, Group b, Group c, Group d) => Group (a,b,c,d) where
+  negate (a,b,c,d) = (negate a, negate b, negate c, negate d)
+  (a,b,c,d) - (i,j,k,l) = (a-i, b-j, c-k, d-l)
+  subtract (a,b,c,d) (i,j,k,l) = (subtract a i, subtract b j, subtract c k, subtract d l)
+  times n (a,b,c,d) = (times n a,times n b, times n c, times n d)
+
+instance (Group a, Group b, Group c, Group d, Group e) => Group (a,b,c,d,e) where
+  negate (a,b,c,d,e) = (negate a, negate b, negate c, negate d, negate e)
+  (a,b,c,d,e) - (i,j,k,l,m) = (a-i, b-j, c-k, d-l, e-m)
+  subtract (a,b,c,d,e) (i,j,k,l,m) = (subtract a i, subtract b j, subtract c k, subtract d l, subtract e m)
+  times n (a,b,c,d,e) = (times n a,times n b, times n c, times n d, times n e)
+
diff --git a/Numeric/Algebra.hs b/Numeric/Algebra.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra.hs
@@ -0,0 +1,162 @@
+module Numeric.Algebra
+  ( 
+  -- * Additive
+
+  -- ** additive semigroups
+    Additive(..)
+  , sum1
+  -- ** additive Abelian semigroups
+  , Abelian
+  -- ** additive idempotent semigroups
+  , Idempotent
+  , replicate1pIdempotent
+  , replicateIdempotent
+  -- ** partitionable additive semigroups
+  , Partitionable(..)
+  -- ** additive monoids
+  , Monoidal(..)
+  , sum
+  -- ** additive groups
+  , Group(..)
+
+  -- * Multiplicative
+  
+  -- ** multiplicative semigroups
+  , Multiplicative(..)
+  , product1
+  -- ** commutative multiplicative semigroups
+  , Commutative
+  -- ** multiplicative monoids
+  , Unital(..)
+  , product
+  -- ** idempotent multiplicative semigroups
+  , Band
+  , pow1pBand
+  , powBand
+  -- ** multiplicative groups
+  , Division(..)
+  -- ** factorable multiplicative semigroups
+  , Factorable(..)
+  -- ** involutive multiplicative semigroups
+  , InvolutiveMultiplication(..)
+  , TriviallyInvolutive
+
+  -- * Ring-Structures
+  -- ** Semirings 
+  , Semiring
+  , InvolutiveSemiring
+  , Dioid
+  -- ** Rngs
+  , Rng
+  -- ** Rigs
+  , Rig(..)
+  -- * Rings
+  , Ring(..)
+
+  -- * Modules
+  , LeftModule(..)
+  , RightModule(..)
+  , Module
+
+  -- * Algebras
+  -- ** associative algebras over (non-commutative) semirings 
+  , Algebra(..)
+  , Coalgebra(..)
+  -- ** unital algebras
+  , UnitalAlgebra(..)
+  , CounitalCoalgebra(..)
+  , Bialgebra
+  -- ** involutive algebras
+  , InvolutiveAlgebra(..)
+  , InvolutiveCoalgebra(..)
+  , InvolutiveBialgebra
+  , TriviallyInvolutiveAlgebra
+  , TriviallyInvolutiveCoalgebra
+  , TriviallyInvolutiveBialgebra
+  -- ** idempotent algebras
+  , IdempotentAlgebra
+  , IdempotentBialgebra
+  -- ** commutative algebras
+  , CommutativeAlgebra
+  , CommutativeBialgebra
+  , CommutativeCoalgebra
+  -- ** division algebras
+  , DivisionAlgebra(..)
+  -- ** Hopf alegebras
+  , HopfAlgebra(..)
+
+  -- * Ring Properties
+  -- ** Characteristic
+  , Characteristic(..)
+  , charInt, charWord
+  -- ** Order
+  , Order(..)
+  , OrderedRig
+  , AdditiveOrder
+
+  , DecidableZero
+  , DecidableUnits
+  , DecidableAssociates
+
+  -- * Natural numbers
+  , Natural
+  , Whole(toNatural)
+
+  -- * Representable Additive
+  , addRep, replicate1pRep
+  -- * Representable Monoidal
+  , zeroRep, replicateRep
+  -- * Representable Group
+  , negateRep, minusRep, subtractRep, timesRep
+  -- * Representable Multiplicative (via Algebra)
+  , mulRep
+  -- * Representable Unital (via UnitalAlgebra)
+  , oneRep
+  -- * Representable Rig (via Algebra)
+  , fromNaturalRep
+  -- * Representable Ring (via Algebra)
+  , fromIntegerRep
+  
+  -- * Norm
+  , Quadrance(..)
+
+  -- * Covectors
+  , Covector(..)
+  -- ** Covectors as linear functionals
+  , counitM
+  , unitM
+  , comultM
+  , multM
+  , invM
+  , coinvM
+  , antipodeM
+  , convolveM
+  , memoM
+  ) where
+
+import Prelude ()
+import Numeric.Additive.Class
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Involutive
+import Numeric.Algebra.Idempotent
+import Numeric.Algebra.Commutative
+import Numeric.Algebra.Division
+import Numeric.Algebra.Factorable
+import Numeric.Algebra.Unital
+import Numeric.Algebra.Hopf
+import Numeric.Covector
+import Numeric.Decidable.Units
+import Numeric.Decidable.Associates
+import Numeric.Decidable.Zero
+import Numeric.Dioid.Class
+import Numeric.Module.Representable
+import Numeric.Natural.Internal
+import Numeric.Order.Class
+import Numeric.Order.Additive
+import Numeric.Quadrance.Class
+import Numeric.Rig.Class
+import Numeric.Rig.Characteristic
+import Numeric.Rig.Ordered
+import Numeric.Rng.Class
+import Numeric.Ring.Class
diff --git a/Numeric/Algebra/Class.hs b/Numeric/Algebra/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Class.hs
@@ -0,0 +1,490 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+module Numeric.Algebra.Class 
+  (
+  -- * Multiplicative Semigroups
+    Multiplicative(..)
+  , pow1pIntegral
+  , product1
+  -- * Semirings
+  , Semiring
+  -- * Left and Right Modules
+  , LeftModule(..)
+  , RightModule(..)
+  , Module
+  -- * Additive Monoids
+  , Monoidal(..)
+  , sum
+  , replicateIdempotent
+  -- * Associative algebras
+  , Algebra(..)
+  -- * Coassociative coalgebras
+  , Coalgebra(..)
+  ) where
+
+import  Numeric.Additive.Class
+import Data.Monoid (mappend)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Sequence hiding (reverse,replicate)
+import qualified Data.Sequence as Seq
+import Data.Foldable hiding (sum, concat)
+import Data.Semigroup.Foldable
+import Data.Int
+import Data.Word
+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)
+import qualified Prelude
+import Numeric.Natural.Internal
+
+infixr 8 `pow1p`
+infixl 7 *, .*, *.
+
+-- | A multiplicative semigroup
+class Multiplicative r where
+  (*) :: r -> r -> r 
+
+-- class Multiplicative r => PowerAssociative r where
+  -- pow1p x n = pow x (1 + n)
+  pow1p :: Whole n => r -> n -> r
+  pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where
+    f x y 
+      | even y = f (x * x) (y `quot` 2)
+      | y == 1 = x
+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x
+    g x y z 
+      | even y = g (x * x) (y `quot` 2) z
+      | y == 1 = x * z
+      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)
+
+-- class PowerAssociative r => Assocative r where
+  productWith1 :: Foldable1 f => (a -> r) -> f a -> r
+  productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing
+    where 
+      mf Nothing y = Just $! f y
+      mf (Just x) y = Just $! x * f y
+
+product1 :: (Foldable1 f, Multiplicative r) => f r -> r
+product1 = productWith1 id
+
+pow1pIntegral :: (Integral r, Integral n) => r -> n -> r
+pow1pIntegral r n = r ^ (1 Prelude.+ n)
+
+instance Multiplicative Bool where
+  (*) = (&&)
+  pow1p m _ = m
+
+instance Multiplicative Natural where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Integer where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Int where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Int8 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Int16 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Int32 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Int64 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Word where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Word8 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Word16 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Word32 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative Word64 where
+  (*) = (Prelude.*)
+  pow1p = pow1pIntegral
+
+instance Multiplicative () where
+  _ * _ = ()
+  pow1p _ _ = ()
+
+instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where
+  (a,b) * (c,d) = (a * c, b * d)
+
+instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where
+  (a,b,c) * (i,j,k) = (a * i, b * j, c * k)
+
+instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where
+  (a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)
+
+instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d, Multiplicative e) => Multiplicative (a,b,c,d,e) where
+  (a,b,c,d,e) * (i,j,k,l,m) = (a * i, b * j, c * k, d * l, e * m)
+
+-- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:
+-- 
+-- > a(b + c) = ab + ac -- left distribution (we are a LeftNearSemiring)
+-- > (a + b)c = ac + bc -- right distribution (we are a [Right]NearSemiring)
+--
+-- Common notation includes the laws for additive and multiplicative identity in semiring.
+--
+-- If you want that, look at 'Rig' instead.
+--
+-- Ideally we'd use the cyclic definition:
+--
+-- > class (LeftModule r r, RightModule r r, Additive r, Abelian r, Multiplicative r) => Semiring r
+--
+-- to enforce that every semiring r is an r-module over itself, but Haskell doesn't like that.
+class (Additive r, Abelian r, Multiplicative r) => Semiring r
+instance Semiring Integer
+instance Semiring Natural
+instance Semiring Bool
+instance Semiring Int
+instance Semiring Int8
+instance Semiring Int16
+instance Semiring Int32
+instance Semiring Int64
+instance Semiring Word
+instance Semiring Word8
+instance Semiring Word16
+instance Semiring Word32
+instance Semiring Word64
+instance Semiring ()
+instance (Semiring a, Semiring b) => Semiring (a, b)
+instance (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c)
+instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d)
+instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e)
+
+-- | An associative algebra built with a free module over a semiring
+class Semiring r => Algebra r a where
+  mult :: (a -> a -> r) -> a -> r
+
+instance Algebra () a where
+  mult _ _ = ()
+
+-- | The tensor algebra
+instance Semiring r => Algebra r [a] where
+  mult f = go [] where
+    go ls rrs@(r:rs) = f (reverse ls) rrs + go (r:ls) rs
+    go ls [] = f (reverse ls) []
+
+-- | The tensor algebra
+instance Semiring r => Algebra r (Seq a) where
+  mult f = go Seq.empty where
+    go ls s = case viewl s of
+       EmptyL -> f ls s 
+       r :< rs -> f ls s + go (ls |> r) rs
+
+instance Semiring r => Algebra r () where
+  mult f = f ()
+
+instance (Semiring r, Ord a) => Algebra r (Set a) where
+  mult f = go Set.empty where
+    go ls s = case Set.minView s of
+       Nothing -> f ls s
+       Just (r, rs) -> f ls s + go (Set.insert r ls) rs
+instance Semiring r => Algebra r IntSet where
+  mult f = go IntSet.empty where
+    go ls s = case IntSet.minView s of
+       Nothing -> f ls s
+       Just (r, rs) -> f ls s + go (IntSet.insert r ls) rs
+
+instance (Semiring r, Monoidal r, Ord a, Partitionable b) => Algebra r (Map a b) -- where
+--  mult f xs = case minViewWithKey xs of
+--    Nothing -> zero 
+--    Just ((k, r), rs) -> ...
+instance (Semiring r, Monoidal r, Partitionable a) => Algebra r (IntMap a)
+
+instance (Algebra r a, Algebra r b) => Algebra r (a,b) where
+  mult f (a,b) = mult (\a1 a2 -> mult (\b1 b2 -> f (a1,b1) (a2,b2)) b) a
+
+instance (Algebra r a, Algebra r b, Algebra r c) => Algebra r (a,b,c) where
+  mult f (a,b,c) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a
+
+instance (Algebra r a, Algebra r b, Algebra r c, Algebra r d) => Algebra r (a,b,c,d) where
+  mult f (a,b,c,d) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> mult (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a
+
+instance (Algebra r a, Algebra r b, Algebra r c, Algebra r d, Algebra r e) => Algebra r (a,b,c,d,e) where
+  mult f (a,b,c,d,e) = mult (\a1 a2 -> mult (\b1 b2 -> mult (\c1 c2 -> mult (\d1 d2 -> mult (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a
+
+-- incoherent
+-- instance (Algebra r b, Algebra r a) => Algebra (b -> r) a where mult f a b = mult (\a1 a2 -> f a1 a2 b) a
+
+instance Algebra r a => Multiplicative (a -> r) where
+  f * g = mult $ \a b -> f a * g b
+
+instance Algebra r a => Semiring (a -> r) 
+
+-- A coassociative coalgebra over a semiring using
+class Semiring r => Coalgebra r c where
+  comult :: (c -> r) -> c -> c -> r
+
+-- | Every coalgebra gives rise to an algebra by vector space duality classically.
+-- Sadly, it requires vector space duality, which we cannot use constructively.
+-- The dual argument only relies in the fact that any constructive coalgebra can only inspect a finite number of coefficients, 
+-- which we CAN exploit.
+instance Algebra r m => Coalgebra r (m -> r) where
+  comult k f g = k (f * g)
+
+-- incoherent
+-- instance Coalgebra () c where comult _ _ _ = ()
+
+-- incoherent
+-- instance (Algebra r b, Coalgebra r c) => Coalgebra (b -> r) c where comult f c1 c2 b = comult (`f` b) c1 c2 
+
+instance Semiring r => Coalgebra r () where
+  comult = const
+
+instance (Coalgebra r a, Coalgebra r b) => Coalgebra r (a, b) where
+  comult f (a1,b1) (a2,b2) = comult (\a -> comult (\b -> f (a,b)) b1 b2) a1 a2
+
+instance (Coalgebra r a, Coalgebra r b, Coalgebra r c) => Coalgebra r (a, b, c) where
+  comult f (a1,b1,c1) (a2,b2,c2) = comult (\a -> comult (\b -> comult (\c -> f (a,b,c)) c1 c2) b1 b2) a1 a2
+
+instance (Coalgebra r a, Coalgebra r b, Coalgebra r c, Coalgebra r d) => Coalgebra r (a, b, c, d) where
+  comult f (a1,b1,c1,d1) (a2,b2,c2,d2) = comult (\a -> comult (\b -> comult (\c -> comult (\d -> f (a,b,c,d)) d1 d2) c1 c2) b1 b2) a1 a2
+
+instance (Coalgebra r a, Coalgebra r b, Coalgebra r c, Coalgebra r d, Coalgebra r e) => Coalgebra r (a, b, c, d, e) where
+  comult f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = comult (\a -> comult (\b -> comult (\c -> comult (\d -> comult (\e -> f (a,b,c,d,e)) e1 e2) d1 d2) c1 c2) b1 b2) a1 a2
+
+-- | The tensor Hopf algebra
+instance Semiring r => Coalgebra r [a] where
+  comult f as bs = f (mappend as bs)
+
+-- | The tensor Hopf algebra
+instance Semiring r => Coalgebra r (Seq a) where
+  comult f as bs = f (mappend as bs)
+
+-- | the free commutative band coalgebra
+instance (Semiring r, Ord a) => Coalgebra r (Set a) where
+  comult f as bs = f (Set.union as bs)
+
+-- | the free commutative band coalgebra over Int
+instance Semiring r => Coalgebra r IntSet where
+  comult f as bs = f (IntSet.union as bs)
+
+-- | the free commutative coalgebra over a set and a given semigroup
+instance (Semiring r, Ord a, Additive b) => Coalgebra r (Map a b) where
+  comult f as bs = f (Map.unionWith (+) as bs)
+
+-- | the free commutative coalgebra over a set and Int
+instance (Semiring r, Additive b) => Coalgebra r (IntMap b) where
+  comult f as bs = f (IntMap.unionWith (+) as bs)
+
+class (Semiring r, Additive m) => LeftModule r m where
+  (.*) :: r -> m -> m
+
+instance LeftModule Natural Bool where 
+  0 .* _ = False
+  _ .* a = a
+instance LeftModule Natural Natural where (.*) = (*)
+instance LeftModule Natural Integer where Natural n .* m = n * m
+instance LeftModule Integer Integer where (.*) = (*) 
+instance LeftModule Natural Int where (.*) = (*) . fromIntegral
+instance LeftModule Integer Int where (.*) = (*) . fromInteger
+instance LeftModule Natural Int8 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Int8 where (.*) = (*) . fromInteger
+instance LeftModule Natural Int16 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Int16 where (.*) = (*) . fromInteger
+instance LeftModule Natural Int32 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Int32 where (.*) = (*) . fromInteger
+instance LeftModule Natural Int64 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Int64 where (.*) = (*) . fromInteger
+instance LeftModule Natural Word where (.*) = (*) . fromIntegral
+instance LeftModule Integer Word where (.*) = (*) . fromInteger
+instance LeftModule Natural Word8 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Word8 where (.*) = (*) . fromInteger
+instance LeftModule Natural Word16 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Word16 where (.*) = (*) . fromInteger
+instance LeftModule Natural Word32 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Word32 where (.*) = (*) . fromInteger
+instance LeftModule Natural Word64 where (.*) = (*) . fromIntegral
+instance LeftModule Integer Word64 where (.*) = (*) . fromInteger
+instance Semiring r => LeftModule r () where _ .* _ = ()
+instance LeftModule r m => LeftModule r (e -> m) where (.*) m f e = m .* f e
+
+instance Additive m => LeftModule () m where 
+  _ .* a = a
+instance (LeftModule r a, LeftModule r b) => LeftModule r (a, b) where
+  n .* (a, b) = (n .* a, n .* b)
+instance (LeftModule r a, LeftModule r b, LeftModule r c) => LeftModule r (a, b, c) where
+  n .* (a, b, c) = (n .* a, n .* b, n .* c)
+instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d) => LeftModule r (a, b, c, d) where
+  n .* (a, b, c, d) = (n .* a, n .* b, n .* c, n .* d)
+instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d, LeftModule r e) => LeftModule r (a, b, c, d, e) where
+  n .* (a, b, c, d, e) = (n .* a, n .* b, n .* c, n .* d, n .* e)
+
+class (Semiring r, Additive m) => RightModule r m where
+  (*.) :: m -> r -> m
+
+instance RightModule Natural Bool where 
+  _ *. 0 = False
+  a *. _ = a
+instance RightModule Natural Natural where (*.) = (*)
+instance RightModule Natural Integer where n *. Natural m = n * m
+instance RightModule Integer Integer where (*.) = (*) 
+instance RightModule Natural Int where m *. n = m * fromIntegral n
+instance RightModule Integer Int where m *. n = m * fromInteger n
+instance RightModule Natural Int8 where m *. n = m * fromIntegral n
+instance RightModule Integer Int8 where m *. n = m * fromInteger n
+instance RightModule Natural Int16 where m *. n = m * fromIntegral n
+instance RightModule Integer Int16 where m *. n = m * fromInteger n
+instance RightModule Natural Int32 where m *. n = m * fromIntegral n
+instance RightModule Integer Int32 where m *. n = m * fromInteger n
+instance RightModule Natural Int64 where m *. n = m * fromIntegral n
+instance RightModule Integer Int64 where m *. n = m * fromInteger n
+instance RightModule Natural Word where m *. n = m * fromIntegral n
+instance RightModule Integer Word where m *. n = m * fromInteger n
+instance RightModule Natural Word8 where m *. n = m * fromIntegral n
+instance RightModule Integer Word8 where m *. n = m * fromInteger n
+instance RightModule Natural Word16 where m *. n = m * fromIntegral n
+instance RightModule Integer Word16 where m *. n = m * fromInteger n
+instance RightModule Natural Word32 where m *. n = m * fromIntegral n
+instance RightModule Integer Word32 where m *. n = m * fromInteger n
+instance RightModule Natural Word64 where m *. n = m * fromIntegral n
+instance RightModule Integer Word64 where m *. n = m * fromInteger n
+instance Semiring r => RightModule r () where _ *. _ = ()
+instance RightModule r m => RightModule r (e -> m) where (*.) f m e = f e *. m
+instance Additive m => RightModule () m where 
+  (*.) = const
+instance (RightModule r a, RightModule r b) => RightModule r (a, b) where
+  (a, b) *. n = (a *. n, b *. n)
+instance (RightModule r a, RightModule r b, RightModule r c) => RightModule r (a, b, c) where
+  (a, b, c) *. n = (a *. n, b *. n, c *. n)
+instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d) => RightModule r (a, b, c, d) where
+  (a, b, c, d) *. n = (a *. n, b *. n, c *. n, d *. n)
+instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d, RightModule r e) => RightModule r (a, b, c, d, e) where
+  (a, b, c, d, e) *. n = (a *. n, b *. n, c *. n, d *. n, e *. n)
+
+class (LeftModule r m, RightModule r m) => Module r m
+instance (LeftModule r m, RightModule r m) => Module r m
+
+
+-- | An additive monoid
+--
+-- > zero + a = a = a + zero
+class (LeftModule Natural m, RightModule Natural m) => Monoidal m where
+  zero :: m
+
+  replicate :: Whole n => n -> m -> m
+  replicate 0 _  = zero
+  replicate n x0 = f x0 n
+    where
+      f x y
+        | even y = f (x + x) (y `quot` 2)
+        | y == 1 = x
+        | otherwise = g (x + x) (unsafePred y `quot` 2) x
+      g x y z
+        | even y = g (x + x) (y `quot` 2) z
+        | y == 1 = x + z
+        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)
+
+  sumWith :: Foldable f => (a -> m) -> f a -> m
+  sumWith f = foldl' (\b a -> b + f a) zero
+
+sum :: (Foldable f, Monoidal m) => f m -> m
+sum = sumWith id
+
+replicateIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r
+replicateIdempotent 0 _ = zero
+replicateIdempotent _ x = x
+
+instance Monoidal Bool where 
+  zero = False
+  replicate 0 _ = False
+  replicate _ r = r
+
+instance Monoidal Natural where
+  zero = 0
+  replicate n r = toNatural n * r
+
+instance Monoidal Integer where 
+  zero = 0
+  replicate n r = toInteger n * r
+
+instance Monoidal Int where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Int8 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Int16 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Int32 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Int64 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Word where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Word8 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Word16 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Word32 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal Word64 where 
+  zero = 0
+  replicate n r = fromIntegral n * r
+
+instance Monoidal r => Monoidal (e -> r) where
+  zero = const zero
+  sumWith f xs e = sumWith (`f` e) xs
+  replicate n r e = replicate n (r e)
+
+instance Monoidal () where 
+  zero = ()
+  replicate _ () = ()
+  sumWith _ _ = ()
+
+instance (Monoidal a, Monoidal b) => Monoidal (a,b) where
+  zero = (zero,zero)
+  replicate n (a,b) = (replicate n a, replicate n b)
+
+instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where
+  zero = (zero,zero,zero)
+  replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)
+
+instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where
+  zero = (zero,zero,zero,zero)
+  replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)
+
+instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d, Monoidal e) => Monoidal (a,b,c,d,e) where
+  zero = (zero,zero,zero,zero,zero)
+  replicate n (a,b,c,d,e) = (replicate n a, replicate n b, replicate n c, replicate n d, replicate n e)
diff --git a/Numeric/Algebra/Commutative.hs b/Numeric/Algebra/Commutative.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Commutative.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}
+module Numeric.Algebra.Commutative 
+  ( Commutative
+  , CommutativeAlgebra
+  , CommutativeCoalgebra
+  , CommutativeBialgebra
+  ) where
+
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Prelude (Bool, Ord, Integer)
+import Data.Int
+import Data.Word
+import Numeric.Natural
+import Data.Set (Set)
+-- import qualified Data.Set as Set
+import Data.IntSet (IntSet)
+-- import qualified Data.IntSet as IntSet
+import Data.Map (Map)
+-- import qualified Data.Map as Map
+import Data.IntMap (IntMap)
+-- import qualified Data.IntMap as IntMap
+
+-- | A commutative multiplicative semigroup
+class Multiplicative r => Commutative r
+
+instance Commutative () 
+instance Commutative Bool
+instance Commutative Integer
+instance Commutative Int
+instance Commutative Int8
+instance Commutative Int16
+instance Commutative Int32
+instance Commutative Int64
+instance Commutative Natural
+instance Commutative Word
+instance Commutative Word8
+instance Commutative Word16
+instance Commutative Word32
+instance Commutative Word64
+instance (Commutative a, Commutative b) => Commutative (a,b) 
+instance (Commutative a, Commutative b, Commutative c) => Commutative (a,b,c) 
+instance (Commutative a, Commutative b, Commutative c, Commutative d) => Commutative (a,b,c,d) 
+instance (Commutative a, Commutative b, Commutative c, Commutative d, Commutative e) => Commutative (a,b,c,d,e)
+
+class Algebra r a => CommutativeAlgebra r a
+
+instance (Commutative r, Semiring r) => CommutativeAlgebra r ()
+instance (CommutativeAlgebra r a, CommutativeAlgebra r b) => CommutativeAlgebra r (a,b)
+instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c) => CommutativeAlgebra r (a,b,c)
+instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c, CommutativeAlgebra r d) => CommutativeAlgebra r (a,b,c,d)
+instance (CommutativeAlgebra r a, CommutativeAlgebra r b, CommutativeAlgebra r c, CommutativeAlgebra r d, CommutativeAlgebra r e) => CommutativeAlgebra r (a,b,c,d,e)
+
+-- incoherent
+-- instance (Algebra r a, CommutativeAlgebra r b) => CommutativeAlgebra (a -> r) b
+-- instance CommutativeAlgebra () a
+
+instance (Commutative r, Semiring r, Ord a) => CommutativeAlgebra r (Set a)
+instance (Commutative r, Semiring r) => CommutativeAlgebra r IntSet
+instance (Commutative r, Monoidal r, Semiring r, Ord a, Abelian b, Partitionable b) => CommutativeAlgebra r (Map a b)
+instance (Commutative r, Monoidal r, Semiring r, Abelian b, Partitionable b) => CommutativeAlgebra r (IntMap b)
+
+instance CommutativeAlgebra r a => Commutative (a -> r)
+
+class Coalgebra r c => CommutativeCoalgebra r c
+
+
+instance CommutativeAlgebra r m => CommutativeCoalgebra r (m -> r)
+instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b) => CommutativeCoalgebra r (a,b)
+instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c) => CommutativeCoalgebra r (a,b,c)
+instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c, CommutativeCoalgebra r d) => CommutativeCoalgebra r (a,b,c,d)
+instance (CommutativeCoalgebra r a, CommutativeCoalgebra r b, CommutativeCoalgebra r c, CommutativeCoalgebra r d, CommutativeCoalgebra r e) => CommutativeCoalgebra r (a,b,c,d,e)
+
+instance (Commutative r, Semiring r, Ord a) => CommutativeCoalgebra r (Set a)
+instance (Commutative r, Semiring r) => CommutativeCoalgebra r IntSet
+instance (Commutative r, Semiring r, Ord a, Abelian b) => CommutativeCoalgebra r (Map a b)
+instance (Commutative r, Semiring r, Abelian b) => CommutativeCoalgebra r (IntMap b)
+
+-- incoherent
+-- instance (Algebra r a, CommutativeCoalgebra r c) => CommutativeCoalgebra (a -> r) c -- TODO: check this instance!
+-- instance CommutativeCoalgebra () a
+
+class    (Bialgebra r h, CommutativeAlgebra r h, CommutativeCoalgebra r h) => CommutativeBialgebra r h
+instance (Bialgebra r h, CommutativeAlgebra r h, CommutativeCoalgebra r h) => CommutativeBialgebra r h
diff --git a/Numeric/Algebra/Division.hs b/Numeric/Algebra/Division.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Division.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Algebra.Division
+  ( Division(..)
+  , DivisionAlgebra(..)
+--  , CodivisionCoalgebra(..)
+--  , DivisionBialgebra
+  ) where
+
+import Prelude hiding ((*), recip, (/),(^))
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+
+infixr 8 ^
+infixl 7 /, \\
+
+-- A multiplicative group
+class Unital r => Division r where
+  recip  :: r -> r
+  (/)    :: r -> r -> r
+  (\\)   :: r -> r -> r
+  (^)    :: Integral n => r -> n -> r
+  recip a = one / a
+  a / b = a * recip b
+  a \\ b = recip a * b
+  x0 ^ y0 = case compare y0 0 of
+    LT -> f (recip x0) (negate y0)
+    EQ -> one
+    GT -> f x0 y0
+    where
+       f x y 
+         | even y = f (x * x) (y `quot` 2)
+         | y == 1 = x
+         | otherwise = g (x * x) ((y - 1) `quot` 2) x
+       g x y z 
+         | even y = g (x * x) (y `quot` 2) z
+         | y == 1 = x * z
+         | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
+
+instance Division () where 
+  _ / _   = ()
+  recip _ = ()
+  _ \\ _  = ()
+  _ ^ _   = ()
+
+instance (Division a, Division b) => Division (a,b) where
+  recip (a,b) = (recip a, recip b)
+  (a,b) / (i,j) = (a/i,b/j)
+  (a,b) \\ (i,j) = (a\\i,b\\j)
+  (a,b) ^ n = (a^n,b^n)
+
+instance (Division a, Division b, Division c) => Division (a,b,c) where
+  recip (a,b,c) = (recip a, recip b, recip c)
+  (a,b,c) / (i,j,k) = (a/i,b/j,c/k)
+  (a,b,c) \\ (i,j,k) = (a\\i,b\\j,c\\k)
+  (a,b,c) ^ n = (a^n,b^n,c^n)
+
+instance (Division a, Division b, Division c, Division d) => Division (a,b,c,d) where
+  recip (a,b,c,d) = (recip a, recip b, recip c, recip d)
+  (a,b,c,d) / (i,j,k,l) = (a/i,b/j,c/k,d/l)
+  (a,b,c,d) \\ (i,j,k,l) = (a\\i,b\\j,c\\k,d\\l)
+  (a,b,c,d) ^ n = (a^n,b^n,c^n,d^n)
+
+instance (Division a, Division b, Division c, Division d, Division e) => Division (a,b,c,d,e) where
+  recip (a,b,c,d,e) = (recip a, recip b, recip c, recip d, recip e)
+  (a,b,c,d,e) / (i,j,k,l,m) = (a/i,b/j,c/k,d/l,e/m)
+  (a,b,c,d,e) \\ (i,j,k,l,m) = (a\\i,b\\j,c\\k,d\\l,e\\m)
+  (a,b,c,d,e) ^ n = (a^n,b^n,c^n,d^n,e^n)
+
+class UnitalAlgebra r a => DivisionAlgebra r a where
+  recipriocal :: (a -> r) -> a -> r
+  -- recipriocal f = one `over` f
+
+instance (Unital r, DivisionAlgebra r a) => Division (a -> r) where
+  recip = recipriocal
+
+{-
+class CounitalCoalgebra r c => DivisionCoalgebra r c where
+  corecipriocal :: (c -> r) -> c -> r
+
+instance CodivisionCoalgebra () c where
+  corecipriocal _ _ = ()
+
+-- | corecipriocal = recipriocal
+class (Bialgebra r h, DivisionAlgebra r h, CodivisionCoalgebra r h) => DivisionBialgebra r h
+instance (Bialgebra r h, DivisionAlgebra r h, CodivisionCoalgebra r h) => DivisionBialgebra r h
+-}
diff --git a/Numeric/Algebra/Factorable.hs b/Numeric/Algebra/Factorable.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Factorable.hs
@@ -0,0 +1,49 @@
+module Numeric.Algebra.Factorable
+  ( -- * Factorable Multiplicative Semigroups
+    Factorable(..)
+  ) where
+
+import Data.List.NonEmpty
+import Numeric.Algebra.Class (Multiplicative(..))
+import Prelude hiding (concat)
+
+-- | `factorWith f c` returns a non-empty list containing `f a b` for all `a, b` such that `a * b = c`.
+--
+-- Results of factorWith f 0 are undefined and may result in either an error or an infinite list.
+
+class Multiplicative m => Factorable m where
+  factorWith :: (m -> m -> r) -> m -> NonEmpty r
+
+instance Factorable Bool where
+  factorWith f False = f False False :| [f False True, f True False]
+  factorWith f True  = f True True :| []
+
+instance Factorable () where
+  factorWith f () = f () () :| []
+
+concat :: NonEmpty (NonEmpty a) -> NonEmpty a
+concat m = m >>= id
+
+instance (Factorable a, Factorable b) => Factorable (a,b) where
+  factorWith f (a,b) = concat $ factorWith (\ax ay ->
+                                factorWith (\bx by -> f (ax,bx) (ay,by)) b) a
+
+instance (Factorable a, Factorable b, Factorable c) => Factorable (a,b,c) where
+  factorWith f (a,b,c) = concat $ factorWith (\ax ay ->
+                            concat $ factorWith (\bx by ->
+                                     factorWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a
+
+instance (Factorable a, Factorable b, Factorable c,Factorable d ) => Factorable (a,b,c,d) where
+  factorWith f (a,b,c,d) = concat $ factorWith (\ax ay ->
+                           concat $ factorWith (\bx by ->
+                           concat $ factorWith (\cx cy ->
+                                    factorWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a
+
+instance (Factorable a, Factorable b, Factorable c,Factorable d, Factorable e) => Factorable (a,b,c,d,e) where
+  factorWith f (a,b,c,d,e) = concat $ factorWith (\ax ay ->
+                             concat $ factorWith (\bx by ->
+                             concat $ factorWith (\cx cy ->
+                             concat $ factorWith (\dx dy ->
+                                      factorWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a
+
+
diff --git a/Numeric/Algebra/Free.hs b/Numeric/Algebra/Free.hs
deleted file mode 100644
--- a/Numeric/Algebra/Free.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Algebra.Free 
-  ( module Numeric.Algebra.Free.Class
-  , module Numeric.Algebra.Free.Unital
-  , module Numeric.Algebra.Free.Hopf
-  ) where
-
-import Numeric.Algebra.Free.Class
-import Numeric.Algebra.Free.Unital
-import Numeric.Algebra.Free.Hopf
diff --git a/Numeric/Algebra/Free/Class.hs b/Numeric/Algebra/Free/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Free/Class.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Algebra.Free.Class 
-  ( FreeAlgebra(..)
-  , FreeCoalgebra(..)
-  ) where
-
-import Numeric.Semiring.Internal
-import Data.Sequence
-import Data.Monoid (mappend)
-import Prelude ()
-
--- A coassociative coalgebra over a semiring using
-class Semiring r => FreeCoalgebra r c where
-  cojoin :: (c -> r) -> c -> c -> r
-
--- convolve :: (FreeAlgebra r a, FreeCoalgebra r c) => ((c -> r) -> a -> r) -> ((c -> r) -> a -> r) -> ((c -> r) -> a -> r
-
--- | Every coalgebra gives rise to an algebra by vector space duality classically.
--- Sadly, it requires vector space duality, which we cannot use constructively.
--- This is the dual, which relies in the fact that any constructive coalgebra can only inspect a finite number of coefficients.
-instance FreeAlgebra r m => FreeCoalgebra r (m -> r) where
-  cojoin k f g = k (f * g)
-
-instance FreeCoalgebra () c where
-  cojoin _ _ _ = ()
-
-instance (FreeAlgebra r b, FreeCoalgebra r c) => FreeCoalgebra (b -> r) c where
-  cojoin f c1 c2 b = cojoin (`f` b) c1 c2 
-
-instance (FreeCoalgebra r a, FreeCoalgebra r b) => FreeCoalgebra r (a, b) where
-  cojoin f (a1,b1) (a2,b2) = cojoin (\a -> cojoin (\b -> f (a,b)) b1 b2) a1 a2
-
-instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c) => FreeCoalgebra r (a, b, c) where
-  cojoin f (a1,b1,c1) (a2,b2,c2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> f (a,b,c)) c1 c2) b1 b2) a1 a2
-
-instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d) => FreeCoalgebra r (a, b, c, d) where
-  cojoin f (a1,b1,c1,d1) (a2,b2,c2,d2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> f (a,b,c,d)) d1 d2) c1 c2) b1 b2) a1 a2
-
-instance (FreeCoalgebra r a, FreeCoalgebra r b, FreeCoalgebra r c, FreeCoalgebra r d, FreeCoalgebra r e) => FreeCoalgebra r (a, b, c, d, e) where
-  cojoin f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = cojoin (\a -> cojoin (\b -> cojoin (\c -> cojoin (\d -> cojoin (\e -> f (a,b,c,d,e)) e1 e2) d1 d2) c1 c2) b1 b2) a1 a2
-
-instance Semiring r => FreeCoalgebra r [a] where
-  cojoin f as bs = f (mappend as bs)
-
-instance Semiring r => FreeCoalgebra r (Seq a) where
-  cojoin f as bs = f (mappend as bs)
diff --git a/Numeric/Algebra/Free/Hopf.hs b/Numeric/Algebra/Free/Hopf.hs
deleted file mode 100644
--- a/Numeric/Algebra/Free/Hopf.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Algebra.Free.Hopf
-  ( Hopf(..)
-  ) where
-
-import Numeric.Algebra.Free.Unital
-
--- | A Hopf algebra on a semiring, where the module is free.
---
--- If @antipode . antipode = id@ then we are 'Involutive'
-
-class (FreeUnitalAlgebra r h, FreeCounitalCoalgebra r h) => Hopf r h where
-  -- > convolve id antipode = convolve antipode id = unit . counit
-  antipode :: (h -> r) -> h -> r
-
-instance (FreeUnitalAlgebra r a, Hopf r h) => Hopf (a -> r) h where
-  antipode f h a = antipode (`f` a) h
-
-instance Hopf () h where
-  antipode = id
-
-instance (Hopf r a, Hopf r b) => Hopf r (a, b) where
-  antipode f (a,b) = antipode (\a' -> antipode (\b' -> f (a',b')) b) a
-
-instance (Hopf r a, Hopf r b, Hopf r c) => Hopf r (a, b, c) where
-  antipode f (a,b,c) = antipode (\a' -> antipode (\b' -> antipode (\c' -> f (a',b',c')) c) b) a
-
-instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d) => Hopf r (a, b, c, d) where
-  antipode f (a,b,c,d) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> f (a',b',c',d')) d) c) b) a
-
-instance (Hopf r a, Hopf r b, Hopf r c, Hopf r d, Hopf r e) => Hopf r (a, b, c, d, e) where
-  antipode f (a,b,c,d,e) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> antipode (\e' -> f (a',b',c',d',e')) e) d) c) b) a
diff --git a/Numeric/Algebra/Free/Unital.hs b/Numeric/Algebra/Free/Unital.hs
deleted file mode 100644
--- a/Numeric/Algebra/Free/Unital.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Algebra.Free.Unital
-  ( FreeUnitalAlgebra(..)
-  , FreeCounitalCoalgebra(..)
-  ) where
-
-import Numeric.Algebra.Free.Class
-import Numeric.Monoid.Multiplicative.Internal
-import Data.Sequence (Seq)
-import Numeric.Semiring.Internal
-import qualified Data.Sequence as Seq
-import Prelude (($))
-
--- A coassociative counital coalgebra over a semiring, where the module is free
-class FreeCoalgebra r c => FreeCounitalCoalgebra r c where
-  counit :: (c -> r) -> r
-
-instance (Unital r, FreeUnitalAlgebra r m) => FreeCounitalCoalgebra r (m -> r) where
-  counit k = k one
-
-instance (FreeUnitalAlgebra r a, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra (a -> r) c where 
-  counit k a = counit (`k` a)
-
-instance FreeCounitalCoalgebra () a where
-  counit _ = ()
-
-instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b) => FreeCounitalCoalgebra r (a, b) where
-  counit k = counit $ \a -> counit $ \b -> k (a,b)
-
-instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c) => FreeCounitalCoalgebra r (a, b, c) where
-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> k (a,b,c)
-
-instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d) => FreeCounitalCoalgebra r (a, b, c, d) where
-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> k (a,b,c,d)
-
-instance (FreeCounitalCoalgebra r a, FreeCounitalCoalgebra r b, FreeCounitalCoalgebra r c, FreeCounitalCoalgebra r d, FreeCounitalCoalgebra r e) => FreeCounitalCoalgebra r (a, b, c, d, e) where
-  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> counit $ \e -> k (a,b,c,d,e)
-
-instance Semiring r => FreeCounitalCoalgebra r [a] where
-  counit k = k []
-
-instance Semiring r => FreeCounitalCoalgebra r (Seq a) where
-  counit k = k (Seq.empty)
diff --git a/Numeric/Algebra/Geometric.hs b/Numeric/Algebra/Geometric.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Geometric.hs
@@ -0,0 +1,216 @@
+{-# 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/Hopf.hs b/Numeric/Algebra/Hopf.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Hopf.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Algebra.Hopf
+  ( HopfAlgebra(..)
+  ) where
+
+import Numeric.Algebra.Unital
+
+-- | A HopfAlgebra algebra on a semiring, where the module is free.
+--
+-- When @antipode . antipode = id@ and antipode is an antihomomorphism then we are an InvolutiveBialgebra with @inv = antipode@ as well
+
+class Bialgebra r h => HopfAlgebra r h where
+  -- > convolve id antipode = convolve antipode id = unit . counit
+  antipode :: (h -> r) -> h -> r
+
+-- incoherent
+-- instance (UnitalAlgebra r a, HopfAlgebra r h) => HopfAlgebra (a -> r) h where antipode f h a = antipode (`f` a) h
+-- instance HopfAlgebra () h where antipode = id
+
+-- TODO: check this
+-- instance InvolutiveSemiring r => HopfAlgebra r () where antipode = adjoint
+
+instance (HopfAlgebra r a, HopfAlgebra r b) => HopfAlgebra r (a, b) where
+  antipode f (a,b) = antipode (\a' -> antipode (\b' -> f (a',b')) b) a
+
+instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c) => HopfAlgebra r (a, b, c) where
+  antipode f (a,b,c) = antipode (\a' -> antipode (\b' -> antipode (\c' -> f (a',b',c')) c) b) a
+
+instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c, HopfAlgebra r d) => HopfAlgebra r (a, b, c, d) where
+  antipode f (a,b,c,d) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> f (a',b',c',d')) d) c) b) a
+
+instance (HopfAlgebra r a, HopfAlgebra r b, HopfAlgebra r c, HopfAlgebra r d, HopfAlgebra r e) => HopfAlgebra r (a, b, c, d, e) where
+  antipode f (a,b,c,d,e) = antipode (\a' -> antipode (\b' -> antipode (\c' -> antipode (\d' -> antipode (\e' -> f (a',b',c',d',e')) e) d) c) b) a
diff --git a/Numeric/Algebra/Idempotent.hs b/Numeric/Algebra/Idempotent.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Idempotent.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+module Numeric.Algebra.Idempotent 
+  ( Band
+  , pow1pBand
+  , powBand
+  -- * Idempotent algebras
+  , IdempotentAlgebra
+  , IdempotentCoalgebra
+  , IdempotentBialgebra
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Natural
+import Data.Set (Set)
+import Data.IntSet (IntSet)
+
+-- | An multiplicative semigroup with idempotent multiplication.
+--
+-- > a * a = a
+class Multiplicative r => Band r
+
+pow1pBand :: Whole n => r -> n -> r
+pow1pBand r _ = r 
+
+powBand :: (Unital r, Whole n) => r -> n -> r
+powBand _ 0 = one
+powBand r _ = r
+
+instance Band ()
+instance Band Bool
+instance (Band a, Band b) => Band (a,b)
+instance (Band a, Band b, Band c) => Band (a,b,c)
+instance (Band a, Band b, Band c, Band d) => Band (a,b,c,d)
+instance (Band a, Band b, Band c, Band d, Band e) => Band (a,b,c,d,e)
+
+-- idempotent algebra
+class Algebra r a => IdempotentAlgebra r a
+instance (Semiring r, Band r, Ord a) => IdempotentAlgebra r (Set a)
+instance (Semiring r, Band r) => IdempotentAlgebra r IntSet
+instance (Semiring r, Band r) => IdempotentAlgebra r ()
+instance (IdempotentAlgebra r a, IdempotentAlgebra r b) => IdempotentAlgebra r (a,b)
+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c) => IdempotentAlgebra r (a,b,c)
+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c, IdempotentAlgebra r d) => IdempotentAlgebra r (a,b,c,d)
+instance (IdempotentAlgebra r a, IdempotentAlgebra r b, IdempotentAlgebra r c, IdempotentAlgebra r d, IdempotentAlgebra r e) => IdempotentAlgebra r (a,b,c,d,e)
+
+-- idempotent coalgebra
+class Coalgebra r c => IdempotentCoalgebra r c
+instance (Semiring r, Band r, Ord c) => IdempotentCoalgebra r (Set c)
+instance (Semiring r, Band r) => IdempotentCoalgebra r IntSet
+instance (Semiring r, Band r) => IdempotentCoalgebra r ()
+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b) => IdempotentCoalgebra r (a,b)
+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c) => IdempotentCoalgebra r (a,b,c)
+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c, IdempotentCoalgebra r d) => IdempotentCoalgebra r (a,b,c,d)
+instance (IdempotentCoalgebra r a, IdempotentCoalgebra r b, IdempotentCoalgebra r c, IdempotentCoalgebra r d, IdempotentCoalgebra r e) => IdempotentCoalgebra r (a,b,c,d,e)
+
+-- idempotent bialgebra
+class (Bialgebra r h, IdempotentAlgebra r h, IdempotentCoalgebra r h) => IdempotentBialgebra r h 
+instance (Bialgebra r h, IdempotentAlgebra r h, IdempotentCoalgebra r h) => IdempotentBialgebra r h 
diff --git a/Numeric/Algebra/Involutive.hs b/Numeric/Algebra/Involutive.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Involutive.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+module Numeric.Algebra.Involutive
+  ( 
+  -- * Involution
+    InvolutiveMultiplication(..)
+  , InvolutiveSemiring
+  -- * Involutive Algebras
+  , InvolutiveAlgebra(..)
+  , InvolutiveCoalgebra(..)
+  , InvolutiveBialgebra
+  -- * Trivial Involution
+  , TriviallyInvolutive
+  , TriviallyInvolutiveAlgebra
+  , TriviallyInvolutiveCoalgebra
+  , TriviallyInvolutiveBialgebra
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Algebra.Commutative
+import Numeric.Algebra.Unital
+import Data.Int
+import Data.Word
+import Numeric.Natural.Internal
+
+-- | An semigroup with involution
+-- 
+-- > adjoint a * adjoint b = adjoint (b * a)
+class Multiplicative r => InvolutiveMultiplication r where
+  adjoint :: r -> r
+
+instance InvolutiveMultiplication Int where adjoint = id
+instance InvolutiveMultiplication Integer where adjoint = id
+instance InvolutiveMultiplication Int8 where adjoint = id
+instance InvolutiveMultiplication Int16 where adjoint = id
+instance InvolutiveMultiplication Int32 where adjoint = id
+instance InvolutiveMultiplication Int64 where adjoint = id
+instance InvolutiveMultiplication Bool where adjoint = id
+instance InvolutiveMultiplication Word where adjoint = id
+instance InvolutiveMultiplication Natural where adjoint = id
+instance InvolutiveMultiplication Word8 where adjoint = id
+instance InvolutiveMultiplication Word16 where adjoint = id
+instance InvolutiveMultiplication Word32 where adjoint = id
+instance InvolutiveMultiplication Word64 where adjoint = id
+instance InvolutiveMultiplication () where adjoint = id
+instance (InvolutiveMultiplication a, InvolutiveMultiplication b) => InvolutiveMultiplication (a,b) where
+  adjoint (a,b) = (adjoint a, adjoint b)
+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c) => InvolutiveMultiplication (a,b,c) where
+  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)
+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d) => InvolutiveMultiplication (a,b,c,d) where
+  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)
+instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d, InvolutiveMultiplication e) => InvolutiveMultiplication (a,b,c,d,e) where
+  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)
+
+
+-- | adjoint (x + y) = adjoint x + adjoint y
+class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r
+
+instance InvolutiveSemiring Integer
+instance InvolutiveSemiring Int
+instance InvolutiveSemiring Int8
+instance InvolutiveSemiring Int16
+instance InvolutiveSemiring Int32
+instance InvolutiveSemiring Int64
+
+instance InvolutiveSemiring Natural
+instance InvolutiveSemiring Word
+instance InvolutiveSemiring Word8
+instance InvolutiveSemiring Word16
+instance InvolutiveSemiring Word32
+instance InvolutiveSemiring Word64
+
+instance InvolutiveSemiring ()
+instance (InvolutiveSemiring a, InvolutiveSemiring b) => InvolutiveSemiring (a, b)
+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c) => InvolutiveSemiring (a, b, c)
+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c, InvolutiveSemiring d) => InvolutiveSemiring (a, b, c, d)
+instance (InvolutiveSemiring a, InvolutiveSemiring b, InvolutiveSemiring c, InvolutiveSemiring d, InvolutiveSemiring e) => InvolutiveSemiring (a, b, c, d, e)
+
+-- adjoint = id
+class (Commutative r, InvolutiveMultiplication r) => TriviallyInvolutive r
+instance TriviallyInvolutive Int
+instance TriviallyInvolutive Integer
+instance TriviallyInvolutive Int8
+instance TriviallyInvolutive Int16
+instance TriviallyInvolutive Int32
+instance TriviallyInvolutive Int64
+instance TriviallyInvolutive Bool
+instance TriviallyInvolutive Word
+instance TriviallyInvolutive Natural
+instance TriviallyInvolutive Word8
+instance TriviallyInvolutive Word16
+instance TriviallyInvolutive Word32
+instance TriviallyInvolutive Word64
+instance TriviallyInvolutive ()
+instance (TriviallyInvolutive a, TriviallyInvolutive b) => TriviallyInvolutive (a,b)
+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c) => TriviallyInvolutive (a,b,c)
+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c, TriviallyInvolutive d) => TriviallyInvolutive (a,b,c,d)
+instance (TriviallyInvolutive a, TriviallyInvolutive b, TriviallyInvolutive c, TriviallyInvolutive d, TriviallyInvolutive e) => TriviallyInvolutive (a,b,c,d,e)
+
+-- inv is an associative algebra homomorphism
+class Algebra r a => InvolutiveAlgebra r a where
+  inv :: (a -> r) -> a -> r
+
+-- instance InvolutiveAlgebra () a where inv _ _ = ()
+-- instance (Algebra r b, InvolutiveAlgebra r a) => InvolutiveAlgebra (b -> r) a where inv f c a = inv (`f` a) c
+
+instance InvolutiveSemiring r => InvolutiveAlgebra r () where
+  inv = (adjoint .)
+
+instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b) => InvolutiveAlgebra r (a, b) where
+  inv f (a,b) = inv (\a' -> inv (\b' -> f (a',b')) b) a
+
+instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b, InvolutiveAlgebra r c) => InvolutiveAlgebra r (a, b, c) where
+  inv f (a,b,c) = inv (\a' -> inv (\b' -> inv (\c' -> f (a',b',c')) c) b) a
+
+instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b, InvolutiveAlgebra r c, InvolutiveAlgebra r d) => InvolutiveAlgebra r (a, b, c, d) where
+  inv f (a,b,c,d) = inv (\a' -> inv (\b' -> inv (\c' -> inv (\d' -> f (a',b',c',d')) d) c) b) a
+
+instance (InvolutiveAlgebra r a, InvolutiveAlgebra r b, InvolutiveAlgebra r c, InvolutiveAlgebra r d, InvolutiveAlgebra r e) => InvolutiveAlgebra r (a, b, c, d, e) where
+  inv f (a,b,c,d,e) = inv (\a' -> inv (\b' -> inv (\c' -> inv (\d' -> inv (\e' -> f (a',b',c',d',e')) e) d) c) b) a
+
+instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where
+  adjoint = inv
+
+class (CommutativeAlgebra r a, InvolutiveAlgebra r a) => TriviallyInvolutiveAlgebra r a
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r) => TriviallyInvolutiveAlgebra r ()
+instance (TriviallyInvolutiveAlgebra r a, TriviallyInvolutiveAlgebra r b) => TriviallyInvolutiveAlgebra r (a, b) where
+instance (TriviallyInvolutiveAlgebra r a, TriviallyInvolutiveAlgebra r b, TriviallyInvolutiveAlgebra r c) => TriviallyInvolutiveAlgebra r (a, b, c) where
+instance (TriviallyInvolutiveAlgebra r a, TriviallyInvolutiveAlgebra r b, TriviallyInvolutiveAlgebra r c, TriviallyInvolutiveAlgebra r d) => TriviallyInvolutiveAlgebra r (a, b, c, d)
+instance (TriviallyInvolutiveAlgebra r a, TriviallyInvolutiveAlgebra r b, TriviallyInvolutiveAlgebra r c, TriviallyInvolutiveAlgebra r d, TriviallyInvolutiveAlgebra r e) => TriviallyInvolutiveAlgebra r (a, b, c, d, e)
+instance TriviallyInvolutiveAlgebra r h => TriviallyInvolutive (h -> r)
+-- instance TriviallyInvolutiveAlgebra () a 
+-- instance (Algebra r b, TriviallyInvolutiveAlgebra r a) => TriviallyInvolutiveAlgebra (b -> r) a
+
+class Coalgebra r c => InvolutiveCoalgebra r c where
+  coinv :: (c -> r) -> c -> r
+-- instance InvolutiveCoalgebra () c where coinv _ _ = ()
+-- instance (Algebra r b, InvolutiveCoalgebra r c) => InvolutiveCoalgebra (b -> r) c where coinv f c a = coinv (`f` a) c
+instance InvolutiveSemiring r => InvolutiveCoalgebra r () where
+  coinv f c = adjoint (f c)
+instance (InvolutiveCoalgebra r a, InvolutiveCoalgebra r b) => InvolutiveCoalgebra r (a, b) where
+  coinv f (a,b) = coinv (\a' -> coinv (\b' -> f (a',b')) b) a
+instance (InvolutiveCoalgebra r a, InvolutiveCoalgebra r b, InvolutiveCoalgebra r c) => InvolutiveCoalgebra r (a, b, c) where
+  coinv f (a,b,c) = coinv (\a' -> coinv (\b' -> coinv (\c' -> f (a',b',c')) c) b) a
+instance (InvolutiveCoalgebra r a, InvolutiveCoalgebra r b, InvolutiveCoalgebra r c, InvolutiveCoalgebra r d) => InvolutiveCoalgebra r (a, b, c, d) where
+  coinv f (a,b,c,d) = coinv (\a' -> coinv (\b' -> coinv (\c' -> coinv (\d' -> f (a',b',c',d')) d) c) b) a
+instance (InvolutiveCoalgebra r a, InvolutiveCoalgebra r b, InvolutiveCoalgebra r c, InvolutiveCoalgebra r d, InvolutiveCoalgebra r e) => InvolutiveCoalgebra r (a, b, c, d, e) where
+  coinv f (a,b,c,d,e) = coinv (\a' -> coinv (\b' -> coinv (\c' -> coinv (\d' -> coinv (\e' -> f (a',b',c',d',e')) e) d) c) b) a
+-- instance InvolutiveCoalgebra r h => Involutive (Covector r h)
+
+class (CommutativeCoalgebra r a, InvolutiveCoalgebra r a) => TriviallyInvolutiveCoalgebra r a
+
+-- instance TriviallyInvolutiveCoalgebra () a 
+-- instance (Algebra r b, TriviallyInvolutiveCoalgebra r a) => TriviallyInvolutiveCoalgebra (b -> r) a
+
+instance (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b) => TriviallyInvolutiveCoalgebra r (a, b) where
+instance (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b, TriviallyInvolutiveCoalgebra r c) => TriviallyInvolutiveCoalgebra r (a, b, c) where
+instance (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b, TriviallyInvolutiveCoalgebra r c, TriviallyInvolutiveCoalgebra r d) => TriviallyInvolutiveCoalgebra r (a, b, c, d)
+instance (TriviallyInvolutiveCoalgebra r a, TriviallyInvolutiveCoalgebra r b, TriviallyInvolutiveCoalgebra r c, TriviallyInvolutiveCoalgebra r d, TriviallyInvolutiveCoalgebra r e) => TriviallyInvolutiveCoalgebra r (a, b, c, d, e)
+
+-- inv = coinv
+class (Bialgebra r h, InvolutiveAlgebra r h, InvolutiveCoalgebra r h) => InvolutiveBialgebra r h
+instance (Bialgebra r h, InvolutiveAlgebra r h, InvolutiveCoalgebra r h) => InvolutiveBialgebra r h
+
+class (InvolutiveBialgebra r h, TriviallyInvolutiveAlgebra r h, TriviallyInvolutiveCoalgebra r h) => TriviallyInvolutiveBialgebra r h
+instance (InvolutiveBialgebra r h, TriviallyInvolutiveAlgebra r h, TriviallyInvolutiveCoalgebra r h) => TriviallyInvolutiveBialgebra r h
diff --git a/Numeric/Algebra/Unital.hs b/Numeric/Algebra/Unital.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Algebra/Unital.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Algebra.Unital
+  ( 
+  -- * Unital Multiplication (Multiplicative monoid)
+    Unital(..)
+  , product
+  -- * Unital Associative Algebra 
+  , UnitalAlgebra(..)
+  -- * Unital Coassociative Coalgebra
+  , CounitalCoalgebra(..)
+  -- * Bialgebra
+  , Bialgebra
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Natural.Internal
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Data.Foldable hiding (product)
+import Data.Int
+import Data.Word
+import Prelude hiding ((*), foldr, product)
+
+infixr 8 `pow`
+
+class Multiplicative r => Unital r where
+  one :: r
+  pow :: Whole n => r -> n -> r
+  pow _ 0 = one
+  pow x0 y0 = f x0 y0 where
+    f x y 
+      | even y = f (x * x) (y `quot` 2)
+      | y == 1 = x
+      | otherwise = g (x * x) ((y - 1) `quot` 2) x
+    g x y z 
+      | even y = g (x * x) (y `quot` 2) z
+      | y == 1 = x * z
+      | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
+  productWith :: Foldable f => (a -> r) -> f a -> r
+  productWith f = foldl' (\b a -> b * f a) one
+
+product :: (Foldable f, Unital r) => f r -> r
+product = productWith id
+
+instance Unital Bool where one = True
+instance Unital Integer where one = 1
+instance Unital Int where one = 1
+instance Unital Int8 where one = 1
+instance Unital Int16 where one = 1
+instance Unital Int32 where one = 1
+instance Unital Int64 where one = 1
+instance Unital Natural where one = 1
+instance Unital Word where one = 1
+instance Unital Word8 where one = 1
+instance Unital Word16 where one = 1
+instance Unital Word32 where one = 1
+instance Unital Word64 where one = 1
+instance Unital () where one = ()
+instance (Unital a, Unital b) => Unital (a,b) where
+  one = (one,one)
+
+instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where
+  one = (one,one,one)
+
+instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where
+  one = (one,one,one,one)
+
+instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where
+  one = (one,one,one,one,one)
+
+-- | An associative unital algebra over a semiring, built using a free module
+class Algebra r a => UnitalAlgebra r a where
+  unit :: r -> a -> r
+
+instance (Unital r, UnitalAlgebra r a) => Unital (a -> r) where
+  one = unit one
+
+instance Semiring r => UnitalAlgebra r () where
+  unit r () = r
+
+-- incoherent
+-- instance UnitalAlgebra () a where unit _ _ = ()
+-- instance (UnitalAlgebra r a, UnitalAlgebra r b) => UnitalAlgebra (a -> r) b where unit f b a = unit (f a) b
+
+instance (UnitalAlgebra r a, UnitalAlgebra r b) => UnitalAlgebra r (a,b) where
+  unit r (a,b) = unit r a * unit r b
+
+instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c) => UnitalAlgebra r (a,b,c) where
+  unit r (a,b,c) = unit r a * unit r b * unit r c
+
+instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c, UnitalAlgebra r d) => UnitalAlgebra r (a,b,c,d) where
+  unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d
+
+instance (UnitalAlgebra r a, UnitalAlgebra r b, UnitalAlgebra r c, UnitalAlgebra r d, UnitalAlgebra r e) => UnitalAlgebra r (a,b,c,d,e) where
+  unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e
+
+instance (Monoidal r, Semiring r) => UnitalAlgebra r [a] where
+  unit r [] = r
+  unit _ _ = zero
+
+instance (Monoidal r, Semiring r) => UnitalAlgebra r (Seq a) where
+  unit r a | Seq.null a = r
+           | otherwise = zero
+
+-- A coassociative counital coalgebra over a semiring, where the module is free
+class Coalgebra r c => CounitalCoalgebra r c where
+  counit :: (c -> r) -> r
+
+instance (Unital r, UnitalAlgebra r m) => CounitalCoalgebra r (m -> r) where
+  counit k = k one
+
+-- incoherent
+-- instance (UnitalAlgebra r a, CounitalCoalgebra r c) => CounitalCoalgebra (a -> r) c where counit k a = counit (`k` a)
+-- instance CounitalCoalgebra () a where counit _ = ()
+
+instance Semiring r => CounitalCoalgebra r () where
+  counit f = f ()
+
+instance (CounitalCoalgebra r a, CounitalCoalgebra r b) => CounitalCoalgebra r (a, b) where
+  counit k = counit $ \a -> counit $ \b -> k (a,b)
+
+instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c) => CounitalCoalgebra r (a, b, c) where
+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> k (a,b,c)
+
+instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c, CounitalCoalgebra r d) => CounitalCoalgebra r (a, b, c, d) where
+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> k (a,b,c,d)
+
+instance (CounitalCoalgebra r a, CounitalCoalgebra r b, CounitalCoalgebra r c, CounitalCoalgebra r d, CounitalCoalgebra r e) => CounitalCoalgebra r (a, b, c, d, e) where
+  counit k = counit $ \a -> counit $ \b -> counit $ \c -> counit $ \d -> counit $ \e -> k (a,b,c,d,e)
+
+instance Semiring r => CounitalCoalgebra r [a] where
+  counit k = k []
+
+instance Semiring r => CounitalCoalgebra r (Seq a) where
+  counit k = k (Seq.empty)
+
+-- | A bialgebra is both a unital algebra and counital coalgebra 
+-- where the `mult` and `unit` are compatible in some sense with 
+-- the `comult` and `counit`. That is to say that 
+-- 'mult' and 'unit' are a coalgebra homomorphisms or (equivalently) that 
+-- 'comult' and 'counit' are an algebra homomorphisms.
+
+class (UnitalAlgebra r a, CounitalCoalgebra r a) => Bialgebra r a
+
+-- TODO
+-- instance (Unital r, Bialgebra r m) => Bialgebra r (m -> r)
+-- instance Bialgebra () c
+-- instance (UnitalAlgebra r b, Bialgebra r c) => Bialgebra (b -> r) c
+
+instance Semiring r => Bialgebra r ()
+instance (Bialgebra r a, Bialgebra r b) => Bialgebra r (a, b)
+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c) => Bialgebra r (a, b, c)
+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c, Bialgebra r d) => Bialgebra r (a, b, c, d)
+instance (Bialgebra r a, Bialgebra r b, Bialgebra r c, Bialgebra r d, Bialgebra r e) => Bialgebra r (a, b, c, d, e)
+
+instance (Monoidal r, Semiring r) => Bialgebra r [a]
+instance (Monoidal r, Semiring r) => Bialgebra r (Seq a)
diff --git a/Numeric/Band.hs b/Numeric/Band.hs
deleted file mode 100644
--- a/Numeric/Band.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Numeric.Band
-  ( module Numeric.Band.Class
-  , module Numeric.Band.Rectangular
-  ) where
-
-import Numeric.Band.Class
-import Numeric.Band.Rectangular
diff --git a/Numeric/Band/Class.hs b/Numeric/Band/Class.hs
--- a/Numeric/Band/Class.hs
+++ b/Numeric/Band/Class.hs
@@ -1,30 +1,7 @@
 module Numeric.Band.Class
-  ( 
-  -- * Multiplicative Bands
-    Band
+  ( Band
   , pow1pBand
   , powBand
   ) where
 
-import Numeric.Semigroup.Multiplicative
-import Numeric.Monoid.Multiplicative
-import Numeric.Natural
-
--- | An multiplicative semigroup with idempotent multiplication.
---
--- > a * a = a
-class Multiplicative r => Band r
-
-pow1pBand :: Whole n => r -> n -> r
-pow1pBand r _ = r 
-
-powBand :: (Unital r, Whole n) => r -> n -> r
-powBand _ 0 = one
-powBand r _ = r
-
-instance Band ()
-instance Band Bool
-instance (Band a, Band b) => Band (a,b)
-instance (Band a, Band b, Band c) => Band (a,b,c)
-instance (Band a, Band b, Band c, Band d) => Band (a,b,c,d)
-instance (Band a, Band b, Band c, Band d, Band e) => Band (a,b,c,d,e)
+import Numeric.Algebra.Idempotent
diff --git a/Numeric/Band/Rectangular.hs b/Numeric/Band/Rectangular.hs
--- a/Numeric/Band/Rectangular.hs
+++ b/Numeric/Band/Rectangular.hs
@@ -2,8 +2,8 @@
   ( Rect(..)
   ) where
 
-import Numeric.Semigroup.Multiplicative
-import Numeric.Band.Class
+import Numeric.Algebra.Class
+import Numeric.Algebra.Idempotent
 import Data.Semigroupoid
 
 -- | a rectangular band is a nowhere commutative semigroup.
diff --git a/Numeric/Covector.hs b/Numeric/Covector.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Covector.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE ImplicitParams, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+module Numeric.Covector 
+  ( Covector(..)
+  -- * Covectors as linear functionals
+  , counitM
+  , unitM
+  , comultM
+  , multM
+  , invM
+  , coinvM
+  , antipodeM
+  , convolveM
+  , memoM
+  ) where
+
+import Numeric.Additive.Class
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Algebra.Idempotent
+import Numeric.Algebra.Involutive
+import Numeric.Algebra.Commutative
+import Numeric.Algebra.Hopf
+import Numeric.Module.Class
+import Numeric.Rig.Class
+import Numeric.Ring.Class
+import Control.Applicative
+import Control.Monad
+import Data.Key
+import Data.Functor.Representable.Trie
+import Data.Functor.Plus hiding (zero)
+import qualified Data.Functor.Plus as Plus
+import Data.Functor.Bind
+import qualified Prelude
+import Prelude hiding ((+),(-),negate,subtract,replicate,(*))
+
+-- | Linear functionals from elements of an (infinite) free module to a scalar
+
+-- f $* (x + y) = (f $* x) + (f $* y)
+-- f $* (a .* x) = a * (f $* x)
+
+newtype Covector r a = Covector ((a -> r) -> r)
+
+infixr 0 $*
+
+($*) :: Indexable m => Covector r (Key m) -> m r -> r
+Covector f $* m = f (index m)
+
+instance Functor (Covector r) where
+  fmap f m = Covector $ \k -> m $* k . f
+
+instance Apply (Covector r) where
+  mf <.> ma = Covector $ \k -> mf $* \f -> ma $* k . f
+
+instance Applicative (Covector r) where
+  pure a = Covector $ \k -> k a
+  mf <*> ma = Covector $ \k -> mf $* \f -> ma $* k . f
+
+instance Bind (Covector r) where
+  m >>- f = Covector $ \k -> m $* \a -> f a $* k
+  
+instance Monad (Covector r) where
+  return a = Covector $ \k -> k a
+  m >>= f = Covector $ \k -> m $* \a -> f a $* k
+
+instance Additive r => Alt (Covector r) where
+  Covector m <!> Covector n = Covector $ m + n
+
+instance Monoidal r => Plus (Covector r) where
+  zero = Covector zero 
+
+instance Monoidal r => Alternative (Covector r) where
+  Covector m <|> Covector n = Covector $ m + n
+  empty = Covector zero
+
+instance Monoidal r => MonadPlus (Covector r) where
+  Covector m `mplus` Covector n = Covector $ m + n
+  mzero = Covector zero
+
+instance Additive r => Additive (Covector r a) where
+  Covector m + Covector n = Covector $ m + n
+  replicate1p n (Covector m) = Covector $ replicate1p n m
+
+instance Coalgebra r m => Multiplicative (Covector r m) where
+  f * Covector g = Covector $ \k -> f $* g . comult k
+
+instance (Commutative m, Coalgebra r m) => Commutative (Covector r m)
+
+instance Coalgebra r m => Semiring (Covector r m)
+
+instance CounitalCoalgebra r m => Unital (Covector r m) where
+  one = Covector counit
+
+instance (Rig r, CounitalCoalgebra r m) => Rig (Covector r m)
+
+instance (Ring r, CounitalCoalgebra r m) => Ring (Covector r m)
+
+instance Idempotent r => Idempotent (Covector r a)
+
+instance (Idempotent r, IdempotentCoalgebra r a) => Band (Covector r a)
+
+multM :: Coalgebra r c => c -> c -> Covector r c
+multM a b = Covector $ \k -> comult k a b
+
+unitM :: CounitalCoalgebra r c => Covector r c
+unitM = Covector counit
+
+comultM :: Algebra r a => a -> Covector r (a,a)
+comultM c = Covector $ \k -> mult (curry k) c 
+
+counitM :: UnitalAlgebra r a => a -> Covector r ()
+counitM a = Covector $ \k -> unit (k ()) a
+
+convolveM :: (Algebra r c, Coalgebra r a) => (c -> Covector r a) -> (c -> Covector r a) -> c -> Covector r a
+convolveM f g c = do
+   (c1,c2) <- comultM c
+   a1 <- f c1
+   a2 <- g c2
+   multM a1 a2
+
+invM :: InvolutiveAlgebra r h => h -> Covector r h
+invM = Covector . flip inv
+
+coinvM :: InvolutiveCoalgebra r h => h -> Covector r h
+coinvM = Covector . flip coinv
+
+-- | convolveM antipodeM return = convolveM return antipodeM = comultM >=> uncurry joinM
+antipodeM :: HopfAlgebra r h => h -> Covector r h
+antipodeM = Covector . flip antipode
+
+memoM :: HasTrie a => a -> Covector s a
+memoM = Covector . flip memo
+
+-- TODO: we can also build up the augmentation ideal
+
+instance Monoidal s => Monoidal (Covector s a) where
+  zero = Covector zero
+  replicate n (Covector m) = Covector (replicate n m)
+
+instance Abelian s => Abelian (Covector s a)
+
+instance Group s => Group (Covector s a) where
+  Covector m - Covector n = Covector $ m - n
+  negate (Covector m) = Covector $ negate m
+  subtract (Covector m) (Covector n) = Covector $ subtract m n
+  times n (Covector m) = Covector $ times n m
+
+instance Coalgebra r m => LeftModule (Covector r m) (Covector r m) where
+  (.*) = (*)
+
+instance LeftModule r s => LeftModule r (Covector s m) where
+  s .* m = Covector $ \k -> s .* (m $* k)
+
+instance Coalgebra r m => RightModule (Covector r m) (Covector r m) where
+  (*.) = (*)
+
+instance RightModule r s => RightModule r (Covector s m) where
+  m *. s = Covector $ \k -> (m $* k) *. s
diff --git a/Numeric/Decidable/Associates.hs b/Numeric/Decidable/Associates.hs
--- a/Numeric/Decidable/Associates.hs
+++ b/Numeric/Decidable/Associates.hs
@@ -7,8 +7,8 @@
 import Data.Function (on)
 import Data.Int
 import Data.Word
-import Numeric.Monoid.Multiplicative
-import Numeric.Natural
+import Numeric.Algebra.Unital
+import Numeric.Natural.Internal
 
 isAssociateIntegral :: Num n => n -> n -> Bool
 isAssociateIntegral = (==) `on` abs
diff --git a/Numeric/Decidable/Units.hs b/Numeric/Decidable/Units.hs
--- a/Numeric/Decidable/Units.hs
+++ b/Numeric/Decidable/Units.hs
@@ -7,8 +7,8 @@
 import Data.Maybe (isJust)
 import Data.Int
 import Data.Word
-import Numeric.Semigroup.Multiplicative
-import Numeric.Monoid.Multiplicative
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
 import Numeric.Natural.Internal
 import Control.Applicative
 import Prelude hiding ((*))
diff --git a/Numeric/Decidable/Zero.hs b/Numeric/Decidable/Zero.hs
--- a/Numeric/Decidable/Zero.hs
+++ b/Numeric/Decidable/Zero.hs
@@ -2,12 +2,12 @@
   ( DecidableZero(..)
   ) where
 
-import Numeric.Monoid.Additive
+import Numeric.Algebra.Class
 import Data.Int
 import Data.Word
-import Numeric.Natural
+import Numeric.Natural.Internal
 
-class AdditiveMonoid r => DecidableZero r where
+class Monoidal r => DecidableZero r where
   isZero :: r -> Bool
 
 instance DecidableZero Bool where isZero = not
diff --git a/Numeric/Dioid/Class.hs b/Numeric/Dioid/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Dioid/Class.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Dioid.Class 
+  ( Dioid
+  ) where
+
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+
+class (Semiring r, Idempotent r) => Dioid r
+instance (Semiring r, Idempotent r) => Dioid r
diff --git a/Numeric/Exp.hs b/Numeric/Exp.hs
--- a/Numeric/Exp.hs
+++ b/Numeric/Exp.hs
@@ -3,9 +3,7 @@
   ) where
 
 import Data.Function (on)
-import Numeric.Addition
-import Numeric.Multiplication
-import Numeric.Band.Class
+import Numeric.Algebra
 
 import Prelude hiding ((+),(-),negate,replicate,subtract)
 
@@ -16,12 +14,12 @@
   productWith1 f = Exp . sumWith1 (runExp . f)
   pow1p (Exp m) n = Exp (replicate1p n m)
 
-instance AdditiveMonoid r => Unital (Exp r) where
+instance Monoidal r => Unital (Exp r) where
   one = Exp zero
   pow (Exp m) n = Exp (replicate n m)
   productWith f = Exp . sumWith (runExp . f)
 
-instance AdditiveGroup r => MultiplicativeGroup (Exp r) where
+instance Group r => Division (Exp r) where
   Exp a / Exp b = Exp (a - b)
   recip (Exp a) = Exp (negate a)
   Exp a \\ Exp b = Exp (subtract a b)
diff --git a/Numeric/Functional/Antilinear.hs b/Numeric/Functional/Antilinear.hs
deleted file mode 100644
--- a/Numeric/Functional/Antilinear.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-module Numeric.Functional.Antilinear 
-  ( Antilinear(..)
-  ) where
-
-import Numeric.Module
-import Numeric.Addition
-import Control.Applicative
-import Control.Monad
-import Data.Functor.Plus hiding (zero)
-import qualified Data.Functor.Plus as Plus
-import Data.Functor.Bind
-import qualified Prelude
-import Prelude hiding ((+),(-),negate,subtract,replicate)
-
--- | Antilinear functionals from elements of a free module to a scalar
-
--- appAntilinear f (x + y) = appAntilinear f x + appAntilinear f y
--- appAntilinear f (a .* x) = adjoint a * appAntilinear f x
-
-newtype Antilinear s a = Antilinear { appAntilinear :: (a -> s) -> s }
-
-instance Functor (Antilinear s) where
-  fmap f (Antilinear m) = Antilinear (\k -> m (k . f))
-
-instance Apply (Antilinear s) where
-  Antilinear mf <.> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))
-
-instance Applicative (Antilinear s) where
-  pure a = Antilinear (\k -> k a)
-  Antilinear mf <*> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))
-
-instance Bind (Antilinear s) where
-  Antilinear m >>- f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))
-  
-instance Monad (Antilinear s) where
-  return a = Antilinear (\k -> k a)
-  Antilinear m >>= f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))
-
-instance Additive s => Alt (Antilinear s) where
-  Antilinear m <!> Antilinear n = Antilinear (m + n)
-
-instance AdditiveMonoid s => Plus (Antilinear s) where
-  zero = Antilinear zero 
-
-instance AdditiveMonoid s => Alternative (Antilinear s) where
-  Antilinear m <|> Antilinear n = Antilinear (m + n)
-  empty = Antilinear zero
-
-instance AdditiveMonoid s => MonadPlus (Antilinear s) where
-  Antilinear m `mplus` Antilinear n = Antilinear (m + n)
-  mzero = Antilinear zero
-
-instance Additive s => Additive (Antilinear s a) where
-  Antilinear m + Antilinear n = Antilinear (m + n)
-  replicate1p n (Antilinear m) = Antilinear (replicate1p n m)
-
-instance AdditiveMonoid s => AdditiveMonoid (Antilinear s a) where
-  zero = Antilinear zero
-  replicate n (Antilinear m) = Antilinear (replicate n m)
-
-instance AdditiveGroup s => AdditiveGroup (Antilinear s a) where
-  Antilinear m - Antilinear n = Antilinear (m - n)
-  negate (Antilinear m) = Antilinear (negate m)
-  subtract (Antilinear m) (Antilinear n) = Antilinear (subtract m n)
-  times n (Antilinear m) = Antilinear (times n m)
-
-instance Abelian s => Abelian (Antilinear s a)
-
--- instance (Multiplicative m, Semiring s) => LeftModule (Antilinear s m) (Antilinear s m) where (.*) = (*)
-
-instance LeftModule r s => LeftModule r (Antilinear s m) where
-  s .* Antilinear m = Antilinear (\k -> s .* m k)
-
--- instance (Multiplicative m, Semiring s) => RightModule (Antilinear s m) (Antilinear s m) where (*.) = (*)
-
-instance RightModule r s => RightModule r (Antilinear s m) where
-  Antilinear m *. s = Antilinear (\k -> m k *. s)
-
diff --git a/Numeric/Functional/Linear.hs b/Numeric/Functional/Linear.hs
deleted file mode 100644
--- a/Numeric/Functional/Linear.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE ImplicitParams, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-module Numeric.Functional.Linear 
-  ( Linear(..)
-  -- * Vectors
-  , Vector
-  , unitVector
-  -- * Covectors as linear functionals
-  , Covector
-  , counitCovector
-  , embedCovector
-  , augmentCovector
-  ) where
-
-import Numeric.Addition
-import Numeric.Algebra.Free
-import Numeric.Multiplication
-import Numeric.Module
-import Numeric.Semiring.Class
-import Numeric.Rig.Class
-import Numeric.Rng.Class
-import Numeric.Ring.Class
-import Control.Applicative
-import Control.Monad
-import Data.Functor.Plus hiding (zero)
-import qualified Data.Functor.Plus as Plus
-import Data.Functor.Bind
-import qualified Prelude
-import Prelude hiding ((+),(-),negate,subtract,replicate,(*))
-
-infixr 0 $*
-
--- | Linear functionals from elements of a free module to a scalar
-
--- f $* (x + y) = (f $* x) + (f $* y)
--- f $* (a .* x) = a * (f $* x)
-
-newtype Linear r a = Linear { ($*) :: (a -> r) -> r }
-
-type Covector a r = Linear r a
-type Vector = (->)
-
-instance Functor (Linear r) where
-  fmap f m = Linear $ \k -> m $* k . f
-
-instance Apply (Linear r) where
-  mf <.> ma = Linear $ \k -> mf $* \f -> ma $* k . f
-
-instance Applicative (Linear r) where
-  pure a = Linear $ \k -> k a
-  mf <*> ma = Linear $ \k -> mf $* \f -> ma $* k . f
-
-instance Bind (Linear r) where
-  m >>- f = Linear $ \k -> m $* \a -> f a $* k
-  
-instance Monad (Linear r) where
-  return a = Linear $ \k -> k a
-  m >>= f = Linear $ \k -> m $* \a -> f a $* k
-
-instance Additive r => Alt (Linear r) where
-  Linear m <!> Linear n = Linear $ m + n
-
-instance AdditiveMonoid r => Plus (Linear r) where
-  zero = Linear zero 
-
-instance AdditiveMonoid r => Alternative (Linear r) where
-  Linear m <|> Linear n = Linear $ m + n
-  empty = Linear zero
-
-instance AdditiveMonoid r => MonadPlus (Linear r) where
-  Linear m `mplus` Linear n = Linear $ m + n
-  mzero = Linear zero
-
-instance Additive r => Additive (Linear r a) where
-  Linear m + Linear n = Linear $ m + n
-  replicate1p n (Linear m) = Linear $ replicate1p n m
-
-instance FreeCoalgebra r m => Multiplicative (Linear r m) where
-  f * Linear g = Linear $ \k -> f $* g . cojoin k
-instance (Commutative m, FreeCoalgebra r m) => Commutative (Linear r m)
-instance FreeCoalgebra r m => Semiring (Linear r m)
-instance FreeCounitalCoalgebra r m => Unital (Linear r m) where
-  one = Linear counit
-instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Linear r m)
-instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Linear r m)
-instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Linear r m)
-
-unitVector :: (FreeUnitalAlgebra r a, Unital r) => a -> r
-unitVector = unit one
-
-counitCovector :: FreeCounitalCoalgebra r c => Linear r c
-counitCovector = Linear counit
-
--- ring homomorphism from r -> r^a, generalizes the embedding of a semiring into its monoid semiring
-embedCovector :: (Unital m, FreeCounitalCoalgebra r m) => r -> Linear r m
-embedCovector r = Linear $ \k -> r * k one
-
--- if the characteristic of s does not divide the order of a, then s[a] is semisimple
--- and if a has a length function, we can build a filtered algebra
-
--- | The augmentation ring homomorphism from r^a -> r, generalizes the augmentation homomorphism from a monoid semiring to the underlying semiring
-augmentCovector :: Unital s => Linear s a -> s
-augmentCovector m = m $* const one
-
--- TODO: we can also build up the augmentation ideal
-
-instance AdditiveMonoid s => AdditiveMonoid (Linear s a) where
-  zero = Linear zero
-  replicate n (Linear m) = Linear (replicate n m)
-
-instance Abelian s => Abelian (Linear s a)
-
-instance AdditiveGroup s => AdditiveGroup (Linear s a) where
-  Linear m - Linear n = Linear $ m - n
-  negate (Linear m) = Linear $ negate m
-  subtract (Linear m) (Linear n) = Linear $ subtract m n
-  times n (Linear m) = Linear $ times n m
-
-instance FreeCoalgebra r m => LeftModule (Linear r m) (Linear r m) where
-  (.*) = (*)
-
-instance LeftModule r s => LeftModule r (Linear s m) where
-  s .* m = Linear $ \k -> s .* (m $* k)
-
-instance FreeCoalgebra r m => RightModule (Linear r m) (Linear r m) where
-  (*.) = (*)
-
-instance RightModule r s => RightModule r (Linear s m) where
-  m *. s = Linear $ \k -> (m $* k) *. s
-
diff --git a/Numeric/Group.hs b/Numeric/Group.hs
deleted file mode 100644
--- a/Numeric/Group.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Group
-  ( module Numeric.Monoid
-  , module Numeric.Group.Additive
-  , module Numeric.Group.Multiplicative
-  ) where
-
-import Numeric.Monoid
-import Numeric.Group.Additive
-import Numeric.Group.Multiplicative
diff --git a/Numeric/Group/Additive.hs b/Numeric/Group/Additive.hs
deleted file mode 100644
--- a/Numeric/Group/Additive.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-module Numeric.Group.Additive
-  ( 
-  -- * Additive Groups
-    AdditiveGroup(..)
-  ) where
-
-import Data.Int
-import Data.Word
-import Prelude hiding ((+), (-), negate, subtract)
-import qualified Prelude
-import Numeric.Semigroup.Additive
-import Numeric.Monoid.Additive
-import Numeric.Module.Class
-
-infixl 6 - 
-infixl 7 `times`
-
-class (LeftModule Integer r, RightModule Integer r, AdditiveMonoid r) => AdditiveGroup r where
-  (-)      :: r -> r -> r
-  negate   :: r -> r
-  subtract :: r -> r -> r
-  times    :: Integral n => n -> r -> r
-  times y0 x0 = case compare y0 0 of
-    LT -> f (negate x0) (Prelude.negate y0)
-    EQ -> zero
-    GT -> f x0 y0
-    where
-      f x y 
-        | even y = f (x + x) (y `quot` 2)
-        | y == 1 = x
-        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x
-      g x y z 
-        | even y = g (x + x) (y `quot` 2) z
-        | y == 1 = x + z
-        | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)
-
-  negate a = zero - a
-  a - b  = a + negate b 
-  subtract a b = negate a + b
-
-instance AdditiveGroup r => AdditiveGroup (e -> r) where
-  f - g = \x -> f x - g x
-  negate f x = negate (f x)
-  subtract f g x = subtract (f x) (g x)
-  times n f e = times n (f e)
-
-instance AdditiveGroup Integer where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Int where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Int8 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Int16 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Int32 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Int64 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Word where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Word8 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Word16 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Word32 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup Word64 where
-  (-) = (Prelude.-)
-  negate = Prelude.negate
-  subtract = Prelude.subtract
-  times n r = fromIntegral n * r
-
-instance AdditiveGroup () where 
-  _ - _   = ()
-  negate _ = ()
-  subtract _ _  = ()
-  times _ _   = ()
-
-instance (AdditiveGroup a, AdditiveGroup b) => AdditiveGroup (a,b) where
-  negate (a,b) = (negate a, negate b)
-  (a,b) - (i,j) = (a-i, b-j)
-  subtract (a,b) (i,j) = (subtract a i, subtract b j)
-  times n (a,b) = (times n a,times n b)
-
-instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) => AdditiveGroup (a,b,c) where
-  negate (a,b,c) = (negate a, negate b, negate c)
-  (a,b,c) - (i,j,k) = (a-i, b-j, c-k)
-  subtract (a,b,c) (i,j,k) = (subtract a i, subtract b j, subtract c k)
-  times n (a,b,c) = (times n a,times n b, times n c)
-
-instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) => AdditiveGroup (a,b,c,d) where
-  negate (a,b,c,d) = (negate a, negate b, negate c, negate d)
-  (a,b,c,d) - (i,j,k,l) = (a-i, b-j, c-k, d-l)
-  subtract (a,b,c,d) (i,j,k,l) = (subtract a i, subtract b j, subtract c k, subtract d l)
-  times n (a,b,c,d) = (times n a,times n b, times n c, times n d)
-
-instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d, AdditiveGroup e) => AdditiveGroup (a,b,c,d,e) where
-  negate (a,b,c,d,e) = (negate a, negate b, negate c, negate d, negate e)
-  (a,b,c,d,e) - (i,j,k,l,m) = (a-i, b-j, c-k, d-l, e-m)
-  subtract (a,b,c,d,e) (i,j,k,l,m) = (subtract a i, subtract b j, subtract c k, subtract d l, subtract e m)
-  times n (a,b,c,d,e) = (times n a,times n b, times n c, times n d, times n e)
diff --git a/Numeric/Group/Multiplicative.hs b/Numeric/Group/Multiplicative.hs
deleted file mode 100644
--- a/Numeric/Group/Multiplicative.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-module Numeric.Group.Multiplicative
-  ( MultiplicativeGroup(..)
-  ) where
-
-import Prelude hiding ((*), recip, (/),(^))
-import Numeric.Semigroup.Multiplicative
-import Numeric.Monoid.Multiplicative
-
-infixr 8 ^
-infixl 7 /, \\
-
-class Unital r => MultiplicativeGroup r where
-  recip  :: r -> r
-  (/)    :: r -> r -> r
-  (\\)   :: r -> r -> r
-  (^)    :: Integral n => r -> n -> r
-  recip a = one / a
-  a / b = a * recip b
-  a \\ b = recip a * b
-  x0 ^ y0 = case compare y0 0 of
-    LT -> f (recip x0) (negate y0)
-    EQ -> one
-    GT -> f x0 y0
-    where
-       f x y 
-         | even y = f (x * x) (y `quot` 2)
-         | y == 1 = x
-         | otherwise = g (x * x) ((y - 1) `quot` 2) x
-       g x y z 
-         | even y = g (x * x) (y `quot` 2) z
-         | y == 1 = x * z
-         | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
-
-instance MultiplicativeGroup () where 
-  _ / _   = ()
-  recip _ = ()
-  _ \\ _  = ()
-  _ ^ _   = ()
-instance (MultiplicativeGroup a, MultiplicativeGroup b) => MultiplicativeGroup (a,b) where
-  recip (a,b) = (recip a, recip b)
-  (a,b) / (i,j) = (a/i,b/j)
-  (a,b) \\ (i,j) = (a\\i,b\\j)
-  (a,b) ^ n = (a^n,b^n)
-instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c) => MultiplicativeGroup (a,b,c) where
-  recip (a,b,c) = (recip a, recip b, recip c)
-  (a,b,c) / (i,j,k) = (a/i,b/j,c/k)
-  (a,b,c) \\ (i,j,k) = (a\\i,b\\j,c\\k)
-  (a,b,c) ^ n = (a^n,b^n,c^n)
-instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d) => MultiplicativeGroup (a,b,c,d) where
-  recip (a,b,c,d) = (recip a, recip b, recip c, recip d)
-  (a,b,c,d) / (i,j,k,l) = (a/i,b/j,c/k,d/l)
-  (a,b,c,d) \\ (i,j,k,l) = (a\\i,b\\j,c\\k,d\\l)
-  (a,b,c,d) ^ n = (a^n,b^n,c^n,d^n)
-
-instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d, MultiplicativeGroup e) => MultiplicativeGroup (a,b,c,d,e) where
-  recip (a,b,c,d,e) = (recip a, recip b, recip c, recip d, recip e)
-  (a,b,c,d,e) / (i,j,k,l,m) = (a/i,b/j,c/k,d/l,e/m)
-  (a,b,c,d,e) \\ (i,j,k,l,m) = (a\\i,b\\j,c\\k,d\\l,e\\m)
-  (a,b,c,d,e) ^ n = (a^n,b^n,c^n,d^n,e^n)
diff --git a/Numeric/Log.hs b/Numeric/Log.hs
--- a/Numeric/Log.hs
+++ b/Numeric/Log.hs
@@ -4,17 +4,12 @@
   ) where
 
 import Data.Function (on)
-import Numeric.Addition
-import Numeric.Module
-import Numeric.Multiplication
-import Numeric.Band.Class
-import Numeric.Natural.Internal
+import Numeric.Algebra
 
 import Prelude hiding ((*),(^),(/),recip,negate,subtract)
 
 newtype Log r = Log { runLog :: r } 
 
-
 instance Multiplicative r => Additive (Log r) where
   Log a + Log b = Log (a * b)
   sumWith1 f = Log . productWith1 (runLog . f)
@@ -26,18 +21,18 @@
 instance Unital r => RightModule Natural (Log r) where
   Log m *. n = Log (pow m n)
 
-instance Unital r => AdditiveMonoid (Log r) where
+instance Unital r => Monoidal (Log r) where
   zero = Log one
   replicate n (Log m) = Log (pow m n)
   sumWith f = Log . productWith (runLog . f)
 
-instance MultiplicativeGroup r => LeftModule Integer (Log r) where
+instance Division r => LeftModule Integer (Log r) where
   n .* Log m = Log (m ^ n)
 
-instance MultiplicativeGroup r => RightModule Integer (Log r) where
+instance Division r => RightModule Integer (Log r) where
   Log m *. n = Log (m ^ n)
 
-instance MultiplicativeGroup r => AdditiveGroup (Log r) where
+instance Division r => Group (Log r) where
   Log a - Log b = Log (a / b)
   negate (Log a) = Log (recip a)
   subtract (Log a) (Log b) = Log (a \\ b)
diff --git a/Numeric/Map.hs b/Numeric/Map.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Map.hs
@@ -0,0 +1,312 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
+module Numeric.Map
+  ( Map(..)
+  , ($@)
+  , multMap
+  , unitMap
+  , memoMap
+  , comultMap
+  , counitMap
+  , invMap
+  , coinvMap
+  , antipodeMap
+  , convolveMap
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Categorical.Bifunctor
+import Control.Category
+import Control.Category.Associative
+import Control.Category.Braided
+import Control.Category.Cartesian
+import Control.Category.Cartesian.Closed
+import Control.Category.Distributive
+import qualified Control.Category.Monoidal as C
+import Control.Category.Monoidal (Id)
+import Control.Monad
+import Control.Monad.Reader.Class
+import Data.Key hiding (Sum)
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie 
+import Data.Functor.Bind
+import Data.Functor.Plus hiding (zero)
+import qualified Data.Functor.Plus as Plus
+import Data.Semigroupoid
+import Data.Void
+import Numeric.Algebra
+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)
+
+-- | linear maps from elements of a free module to another free module over r
+--
+-- > f $# x + y = (f $# x) + (f $# y)
+-- > f $# (r .* x) = r .* (f $# x)
+--
+--
+-- @Map r b a@ represents a linear mapping from a free module with basis @a@ over @r@ to a free module with basis @b@ over @r@.
+-- 
+-- Note well the reversed direction of the arrow, due to the contravariance of change of basis!
+--
+-- This way enables we can employ arbitrary pure functions as linear maps by lifting them using `arr`, or build them
+-- by using the monad instance for Map r b.  As a consequence Map is an instance of, well, almost everything.
+
+infixr 0 $#
+newtype Map r b a = Map ((a -> r) -> b -> r)
+
+($#) :: (Indexable v, Representable w) => Map r (Key w) (Key v) -> v r -> w r
+($#) (Map m) = tabulate . m . index
+
+infixr 0 $@
+-- | extract a linear functional from a linear map
+($@) :: Map r b a -> b -> Covector r a
+m $@ b = Covector $ \k -> (m $# k) b
+
+-- NB: due to contravariance (>>>) to get the usual notion of composition!
+instance Category (Map r) where
+  id = Map id
+  Map f . Map g = Map (g . f)
+
+instance Semigroupoid (Map r) where
+  Map f `o` Map g = Map (g . f)
+
+instance Functor (Map r b) where
+  fmap f m = Map $ \k -> m $# k . f
+
+instance Apply (Map r b) where
+  mf <.> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b
+
+instance Applicative (Map r b) where
+  pure a = Map $ \k _ -> k a
+  mf <*> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b
+
+instance Bind (Map r b) where
+  Map m >>- f = Map $ \k b -> m (\a -> (f a $# k) b) b
+  
+instance Monad (Map r b) where
+  return a = Map $ \k _ -> k a
+  m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b
+
+instance PFunctor (,) (Map r) (Map r) where
+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a
+
+instance QFunctor (,) (Map r) (Map r) where
+  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a
+
+instance Bifunctor (,) (Map r) (Map r) (Map r) where
+  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a
+
+instance Associative (Map r) (,) where
+  associate = arr associate
+
+instance Disassociative (Map r) (,) where
+  disassociate = arr disassociate
+
+instance Braided (Map r) (,) where
+  braid = arr braid
+
+instance Symmetric (Map r) (,)
+
+type instance Id (Map r) (,) = ()
+
+instance C.Monoidal (Map r) (,) where
+  idl = arr C.idl
+  idr = arr C.idr
+
+instance C.Comonoidal (Map r) (,) where
+  coidl = arr C.coidl
+  coidr = arr C.coidr
+
+instance PreCartesian (Map r) where
+  type Product (Map r) = (,) 
+  fst = arr fst
+  snd = arr snd
+  diag = arr diag
+  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a
+
+instance CCC (Map r) where
+  type Exp (Map r) = Map r 
+  apply = Map $ \k (f,a) -> (f $# k) a
+  curry m = Map $ \k a -> k (Map $ \k' b -> (m $# k') (a, b))
+  uncurry m = Map $ \k (a, b) -> (m $# (\m' -> (m' $# k) b)) a
+
+instance Distributive (Map r) where
+  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p
+
+instance PFunctor Either (Map r) (Map r) where
+  first m = Map $ \k -> either (m $# k . Left) (k . Right)
+
+instance QFunctor Either (Map r) (Map r) where
+  second m = Map $ \k -> either (k . Left) (m $# k . Right)
+
+instance Bifunctor Either (Map r) (Map r) (Map r) where
+  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)
+
+instance Associative (Map r) Either where
+  associate = arr associate
+
+instance Disassociative (Map r) Either where
+  disassociate = arr disassociate
+
+instance Braided (Map r) Either where
+  braid = arr braid
+
+instance Symmetric (Map r) Either
+
+type instance Id (Map r) Either = Void
+
+instance PreCoCartesian (Map r) where
+  type Sum (Map r) = Either
+  inl = arr inl 
+  inr = arr inr
+  codiag = arr codiag
+  m ||| n = Map $ \k -> either (m $# k) (n $# k) 
+
+instance C.Comonoidal (Map r) Either where
+  coidl = arr C.coidl
+  coidr = arr C.coidr
+
+instance C.Monoidal (Map r) Either where
+  idl = arr C.idl
+  idr = arr C.idr
+
+instance Arrow (Map r) where
+  arr f = Map (. f)
+  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a
+  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a
+  m *** n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a
+  m &&& n = Map $ \k a -> (m $# \b -> (n $# \c -> k (b,c)) a) a
+
+instance ArrowApply (Map r) where
+  app = Map $ \k (f,a) -> (f $# k) a
+
+instance MonadReader b (Map r b) where
+  ask = id
+  local f m = Map $ \k -> (m $# k) . f
+
+-- While the following typechecks, it isn't correct,
+-- callCC is non-linear, the internal Map ignores the functional it is given!
+--
+--instance MonadCont (Map r b) where
+--  callCC f = Map $ \k -> (f $# \a -> Map $ \_ _ -> k a) k
+
+-- label :: ((a -> r) -> Map r b a) -> Map r b a
+-- label f = Map $ \k -> f k $# k 
+
+-- break :: (a -> r) -> a -> Map r b a
+
+instance Monoidal r => ArrowZero (Map r) where
+  zeroArrow = Map zero
+
+instance Monoidal r => ArrowPlus (Map r) where
+  Map m <+> Map n = Map $ m + n
+
+instance ArrowChoice (Map r) where
+  left m = Map $ \k -> either (m $# k . Left) (k . Right)
+  right m = Map $ \k -> either (k . Left) (m $# k . Right)
+  m +++ n =  Map $ \k -> either (m $# k . Left) (n $# k . Right)
+  m ||| n = Map $ \k -> either (m $# k) (n $# k) 
+
+-- TODO: ArrowLoop?
+
+-- TODO: more categories instances for (Map r) & Either to get to precocartesian!
+
+instance Additive r => Additive (Map r b a) where
+  Map m + Map n = Map $ m + n
+  replicate1p n (Map m) = Map $ replicate1p n m
+
+instance Coalgebra r m => Multiplicative (Map r b m) where
+  f * g = Map $ \k b -> (f $# \a -> (g $# comult k a) b) b
+instance CounitalCoalgebra r m => Unital (Map r b m) where
+  one = Map $ \k _ -> counit k
+
+instance Coalgebra r m => Semiring (Map r b m)
+
+instance Coalgebra r m => LeftModule (Map r b m) (Map r b m) where 
+  (.*) = (*)
+
+instance LeftModule r s => LeftModule r (Map s b m) where
+  s .* Map m = Map $ \k b -> s .* m k b
+
+instance Coalgebra r m => RightModule (Map r b m) (Map r b m) where (*.) = (*)
+instance RightModule r s => RightModule r (Map s b m) where
+  Map m *. s = Map $ \k b -> m k b *. s
+
+instance Additive r => Alt (Map r b) where
+  Map m <!> Map n = Map $ m + n
+
+instance Monoidal r => Plus (Map r b) where
+  zero = Map zero 
+
+instance Monoidal r => Alternative (Map r b) where
+  Map m <|> Map n = Map $ m + n
+  empty = Map zero
+
+instance Monoidal r => MonadPlus (Map r b) where
+  Map m `mplus` Map n = Map $ m + n
+  mzero = Map zero
+
+instance Monoidal s => Monoidal (Map s b a) where
+  zero = Map zero
+  replicate n (Map m) = Map $ replicate n m
+
+instance Abelian s => Abelian (Map s b a)
+
+instance Group s => Group (Map s b a) where
+  Map m - Map n = Map $ m - n
+  negate (Map m) = Map $ negate m
+  subtract (Map m) (Map n) = Map $ subtract m n
+  times n (Map m) = Map $ times n m
+
+instance (Commutative m, Coalgebra r m) => Commutative (Map r b m)
+
+instance (Rig r, CounitalCoalgebra r m) => Rig (Map r b m)
+
+instance (Ring r, CounitalCoalgebra r m) => Ring (Map r a m)
+
+-- | (inefficiently) combine a linear combination of basis vectors to make a map.
+-- arrMap :: (Monoidal r, Semiring r) => (b -> [(r, a)]) -> Map r b a
+-- arrMap f = Map $ \k b -> sum [ r * k a | (r, a) <- f b ]
+
+-- | Memoize the results of this linear map
+memoMap :: HasTrie a => Map r a a
+memoMap = Map memo
+
+comultMap :: Algebra r a => Map r a (a,a)
+comultMap = Map $ mult . curry
+
+multMap :: Coalgebra r c => Map r (c,c) c
+multMap = Map $ uncurry . comult
+
+counitMap :: UnitalAlgebra r a => Map r a ()
+counitMap = Map $ \k -> unit $ k ()
+
+unitMap :: CounitalCoalgebra r c => Map r () c
+unitMap = Map $ \k () -> counit k
+
+-- | convolution given an associative algebra and coassociative coalgebra
+convolveMap :: (Algebra r a, Coalgebra r c) => Map r a c -> Map r a c -> Map r a c
+convolveMap f g = multMap . (f *** g) . comultMap
+
+-- convolveMap antipodeMap id = convolveMap id antipodeMap = unit . counit
+antipodeMap :: HopfAlgebra r h => Map r h h
+antipodeMap = Map antipode
+
+coinvMap :: InvolutiveAlgebra r a => Map r a a
+coinvMap = Map inv
+
+invMap :: InvolutiveCoalgebra r c => Map r c c
+invMap = Map coinv
+
+{-
+-- ring homomorphism from r -> r^a
+embedMap :: (Unital m, CounitalCoalgebra r m) => (b -> r) -> Map r b m 
+embedMap f = Map $ \k b -> f b * k one
+
+-- if the characteristic of s does not divide the order of a, then s[a] is semisimple
+-- and if a has a length function, we can build a filtered algebra
+
+-- | The augmentation ring homomorphism from r^a -> r
+augmentMap :: Unital s => Map s b m -> b -> s
+augmentMap m = m $# const one
+-}
+
diff --git a/Numeric/Map/Linear.hs b/Numeric/Map/Linear.hs
deleted file mode 100644
--- a/Numeric/Map/Linear.hs
+++ /dev/null
@@ -1,307 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
-module Numeric.Map.Linear
-  ( Map(..)
-  , ($@)
-  , joinMap
-  , unitMap
-  , memoMap
-  , cojoinMap
-  , counitMap
-  , antipodeMap
-  , convolveMap
-  , embedMap
-  , augmentMap
-  , arrMap
-  ) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Categorical.Bifunctor
-import Control.Category
-import Control.Category.Associative
-import Control.Category.Braided
-import Control.Category.Cartesian
-import Control.Category.Cartesian.Closed
-import Control.Category.Distributive
-import Control.Category.Monoidal
-import Control.Monad hiding (join)
-import Control.Monad.Reader.Class
-import Data.Functor.Representable.Trie
-import Data.Functor.Bind hiding (join)
-import Data.Functor.Plus hiding (zero)
-import qualified Data.Functor.Plus as Plus
-import Data.Semigroupoid
-import Data.Void
-import Numeric.Addition
-import Numeric.Algebra.Free
-import Numeric.Multiplication
-import Numeric.Module
-import Numeric.Semiring.Class
-import Numeric.Rig.Class
-import Numeric.Ring.Class
-import Numeric.Rng.Class
-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)
-import Numeric.Functional.Linear
-
--- | linear maps from elements of a free module to another free module over r
---
--- > f $# x + y = (f $# x) + (f $# y)
--- > f $# (r .* x) = r .* (f $# x)
---
---
--- @Map r b a@ represents a linear mapping from a free module with basis @a@ over @r@ to a free module with basis @b@ over @r@.
--- 
--- Note well the change of direction, due to the contravariance of change of basis!
---
--- This way enables we can employ arbitrary pure functions as linear maps by lifting them using `arr`, or build them
--- by using the monad instance for Map r b.  As a consequence Map is an instance of, well, almost everything.
-
-infixr 0 $#
-newtype Map r b a = Map { ($#) :: (a -> r) -> b -> r }
-
-infixr 0 $@
--- | extract a linear functional from a linear map
-($@) :: Map r b a -> b -> Linear r a
-m $@ b = Linear $ \k -> (m $# k) b
-
--- NB: due to contravariance (>>>) to get the usual notion of composition!
-instance Category (Map r) where
-  id = Map id
-  Map f . Map g = Map (g . f)
-
-instance Semigroupoid (Map r) where
-  Map f `o` Map g = Map (g . f)
-
-instance Functor (Map r b) where
-  fmap f m = Map $ \k -> m $# k . f
-
-instance Apply (Map r b) where
-  mf <.> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b
-
-instance Applicative (Map r b) where
-  pure a = Map $ \k _ -> k a
-  mf <*> ma = Map $ \k b -> (mf $# \f -> (ma $# k . f) b) b
-
-instance Bind (Map r b) where
-  Map m >>- f = Map $ \k b -> m (\a -> (f a $# k) b) b
-  
-instance Monad (Map r b) where
-  return a = Map $ \k _ -> k a
-  m >>= f = Map $ \k b -> (m $# \a -> (f a $# k) b) b
-
-instance PFunctor (,) (Map r) (Map r) where
-  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a
-
-instance QFunctor (,) (Map r) (Map r) where
-  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a
-
-instance Bifunctor (,) (Map r) (Map r) (Map r) where
-  bimap m n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a
-
-instance Associative (Map r) (,) where
-  associate = arr associate
-
-instance Disassociative (Map r) (,) where
-  disassociate = arr disassociate
-
-instance Braided (Map r) (,) where
-  braid = arr braid
-
-instance Symmetric (Map r) (,)
-
-type instance Id (Map r) (,) = ()
-
-instance Monoidal (Map r) (,) where
-  idl = arr idl
-  idr = arr idr
-
-instance Comonoidal (Map r) (,) where
-  coidl = arr coidl
-  coidr = arr coidr
-
-instance PreCartesian (Map r) where
-  type Product (Map r) = (,) 
-  fst = arr fst
-  snd = arr snd
-  diag = arr diag
-  f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a
-
-instance CCC (Map r) where
-  type Exp (Map r) = Map r 
-  apply = Map $ \k (f,a) -> (f $# k) a
-  curry m = Map $ \k a -> k (Map $ \k' b -> (m $# k') (a, b))
-  uncurry m = Map $ \k (a, b) -> (m $# (\m' -> (m' $# k) b)) a
-
-instance Distributive (Map r) where
-  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p
-
-instance PFunctor Either (Map r) (Map r) where
-  first m = Map $ \k -> either (m $# k . Left) (k . Right)
-
-instance QFunctor Either (Map r) (Map r) where
-  second m = Map $ \k -> either (k . Left) (m $# k . Right)
-
-instance Bifunctor Either (Map r) (Map r) (Map r) where
-  bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right)
-
-instance Associative (Map r) Either where
-  associate = arr associate
-
-instance Disassociative (Map r) Either where
-  disassociate = arr disassociate
-
-instance Braided (Map r) Either where
-  braid = arr braid
-
-instance Symmetric (Map r) Either
-
-type instance Id (Map r) Either = Void
-
-instance PreCoCartesian (Map r) where
-  type Sum (Map r) = Either
-  inl = arr inl 
-  inr = arr inr
-  codiag = arr codiag
-  m ||| n = Map $ \k -> either (m $# k) (n $# k) 
-
-instance Comonoidal (Map r) Either where
-  coidl = arr coidl
-  coidr = arr coidr
-
-instance Monoidal (Map r) Either where
-  idl = arr idl
-  idr = arr idr
-
-instance Arrow (Map r) where
-  arr f = Map (. f)
-  first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a
-  second m = Map $ \k (c,a) -> (m $# \b -> k (c,b)) a
-  m *** n = Map $ \k (a,c) -> (m $# \b -> (n $# \d -> k (b,d)) c) a
-  m &&& n = Map $ \k a -> (m $# \b -> (n $# \c -> k (b,c)) a) a
-
-instance ArrowApply (Map r) where
-  app = Map $ \k (f,a) -> (f $# k) a
-
-instance MonadReader b (Map r b) where
-  ask = id
-  local f m = Map $ \k -> (m $# k) . f
-
--- While the following typechecks, it isn't correct,
--- callCC is non-linear, the internal Map ignores the functional it is given!
---
---instance MonadCont (Map r b) where
---  callCC f = Map $ \k -> (f $# \a -> Map $ \_ _ -> k a) k
-
--- label :: ((a -> r) -> Map r b a) -> Map r b a
--- label f = Map $ \k -> f k $# k 
-
--- break :: (a -> r) -> a -> Map r b a
-
-instance AdditiveMonoid r => ArrowZero (Map r) where
-  zeroArrow = Map zero
-
-instance AdditiveMonoid r => ArrowPlus (Map r) where
-  Map m <+> Map n = Map $ m + n
-
-instance ArrowChoice (Map r) where
-  left m = Map $ \k -> either (m $# k . Left) (k . Right)
-  right m = Map $ \k -> either (k . Left) (m $# k . Right)
-  m +++ n =  Map $ \k -> either (m $# k . Left) (n $# k . Right)
-  m ||| n = Map $ \k -> either (m $# k) (n $# k) 
-
--- TODO: ArrowLoop?
-
--- TODO: more categories instances for (Map r) & Either to get to precocartesian!
-
-instance Additive r => Additive (Map r b a) where
-  Map m + Map n = Map $ m + n
-  replicate1p n (Map m) = Map $ replicate1p n m
-
-instance FreeCoalgebra r m => Multiplicative (Map r b m) where
-  f * g = Map $ \k b -> (f $# \a -> (g $# cojoin k a) b) b
-instance FreeCounitalCoalgebra r m => Unital (Map r b m) where
-  one = Map $ \k _ -> counit k
-
-instance FreeCoalgebra r m => Semiring (Map r b m)
-
-instance FreeCoalgebra r m => LeftModule (Map r b m) (Map r b m) where 
-  (.*) = (*)
-
-instance LeftModule r s => LeftModule r (Map s b m) where
-  s .* Map m = Map $ \k b -> s .* m k b
-
-instance FreeCoalgebra r m => RightModule (Map r b m) (Map r b m) where (*.) = (*)
-instance RightModule r s => RightModule r (Map s b m) where
-  Map m *. s = Map $ \k b -> m k b *. s
-
-instance Additive r => Alt (Map r b) where
-  Map m <!> Map n = Map $ m + n
-
-instance AdditiveMonoid r => Plus (Map r b) where
-  zero = Map zero 
-
-instance AdditiveMonoid r => Alternative (Map r b) where
-  Map m <|> Map n = Map $ m + n
-  empty = Map zero
-
-instance AdditiveMonoid r => MonadPlus (Map r b) where
-  Map m `mplus` Map n = Map $ m + n
-  mzero = Map zero
-
-instance AdditiveMonoid s => AdditiveMonoid (Map s b a) where
-  zero = Map zero
-  replicate n (Map m) = Map $ replicate n m
-
-instance Abelian s => Abelian (Map s b a)
-
-instance AdditiveGroup s => AdditiveGroup (Map s b a) where
-  Map m - Map n = Map $ m - n
-  negate (Map m) = Map $ negate m
-  subtract (Map m) (Map n) = Map $ subtract m n
-  times n (Map m) = Map $ times n m
-
-instance (Commutative m, FreeCoalgebra r m) => Commutative (Map r b m)
-
-instance (Rig r, FreeCounitalCoalgebra r m) => Rig (Map r b m)
-instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Map r b m)
-instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Map r a m)
-
--- | (inefficiently) combine a linear combination of basis vectors to make a map.
-arrMap :: (AdditiveMonoid r, Semiring r) => (b -> [(r, a)]) -> Map r b a
-arrMap f = Map $ \k b -> sum [ r * k a | (r, a) <- f b ]
-
--- | Memoize the results of this linear map
-memoMap :: HasTrie a => Map r a a
-memoMap = Map memo
-
-joinMap :: FreeAlgebra r a => Map r a (a,a)
-joinMap = Map $ join . curry
-
-cojoinMap :: FreeCoalgebra r c => Map r (c,c) c
-cojoinMap = Map $ uncurry . cojoin
-
-unitMap :: FreeUnitalAlgebra r a => Map r a ()
-unitMap = Map $ \k -> unit $ k ()
-
-counitMap :: FreeCounitalCoalgebra r c => Map r () c
-counitMap = Map $ \k () -> counit k
-
--- | convolution given an associative algebra and coassociative coalgebra
-convolveMap :: (FreeAlgebra r a, FreeCoalgebra r c) => Map r a c -> Map r a c -> Map r a c
-convolveMap f g = joinMap >>> (f *** g) >>> cojoinMap
-
--- convolveMap antipodeMap id = convolveMap id antipodeMap = unit . counit
-antipodeMap :: Hopf r h => Map r h h
-antipodeMap = Map antipode
-
--- ring homomorphism from r -> r^a
-embedMap :: (Unital m, FreeCounitalCoalgebra r m) => (b -> r) -> Map r b m 
-embedMap f = Map $ \k b -> f b * k one
-
--- if the characteristic of s does not divide the order of a, then s[a] is semisimple
--- and if a has a length function, we can build a filtered algebra
-
--- | The augmentation ring homomorphism from r^a -> r
-augmentMap :: Unital s => Map s b m -> b -> s
-augmentMap m = m $# const one
-
diff --git a/Numeric/Module.hs b/Numeric/Module.hs
deleted file mode 100644
--- a/Numeric/Module.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Numeric.Module 
-  ( module Numeric.Module.Class
-  ) where
-
-import Numeric.Module.Class
diff --git a/Numeric/Module/Class.hs b/Numeric/Module/Class.hs
--- a/Numeric/Module/Class.hs
+++ b/Numeric/Module/Class.hs
@@ -1,98 +1,9 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
--- This package is an unfortunate ball of mud forced on me by mutual dependencies
 module Numeric.Module.Class
   (  
   -- * Module over semirings
     LeftModule(..)
   , RightModule(..)
+  , Module
   ) where
 
-import Data.Int
-import Data.Word
-import Numeric.Natural.Internal
-import Numeric.Semigroup.Additive
-import Numeric.Semiring.Internal
-import Prelude hiding ((*))
-
-infixl 7 .*, *.
-
-class (Semiring r, Additive m) => LeftModule r m where
-  (.*) :: r -> m -> m
-
-instance LeftModule Natural Bool where 
-  0 .* _ = False
-  _ .* a = a
-instance LeftModule Natural Natural where (.*) = (*)
-instance LeftModule Natural Integer where Natural n .* m = n * m
-instance LeftModule Integer Integer where (.*) = (*) 
-instance LeftModule Natural Int where (.*) = (*) . fromIntegral
-instance LeftModule Integer Int where (.*) = (*) . fromInteger
-instance LeftModule Natural Int8 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Int8 where (.*) = (*) . fromInteger
-instance LeftModule Natural Int16 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Int16 where (.*) = (*) . fromInteger
-instance LeftModule Natural Int32 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Int32 where (.*) = (*) . fromInteger
-instance LeftModule Natural Int64 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Int64 where (.*) = (*) . fromInteger
-instance LeftModule Natural Word where (.*) = (*) . fromIntegral
-instance LeftModule Integer Word where (.*) = (*) . fromInteger
-instance LeftModule Natural Word8 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Word8 where (.*) = (*) . fromInteger
-instance LeftModule Natural Word16 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Word16 where (.*) = (*) . fromInteger
-instance LeftModule Natural Word32 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Word32 where (.*) = (*) . fromInteger
-instance LeftModule Natural Word64 where (.*) = (*) . fromIntegral
-instance LeftModule Integer Word64 where (.*) = (*) . fromInteger
-instance Semiring r => LeftModule r () where _ .* _ = ()
-instance LeftModule r m => LeftModule r (e -> m) where (.*) m f e = m .* f e
-instance (LeftModule r a, LeftModule r b) => LeftModule r (a, b) where
-  n .* (a, b) = (n .* a, n .* b)
-instance (LeftModule r a, LeftModule r b, LeftModule r c) => LeftModule r (a, b, c) where
-  n .* (a, b, c) = (n .* a, n .* b, n .* c)
-instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d) => LeftModule r (a, b, c, d) where
-  n .* (a, b, c, d) = (n .* a, n .* b, n .* c, n .* d)
-instance (LeftModule r a, LeftModule r b, LeftModule r c, LeftModule r d, LeftModule r e) => LeftModule r (a, b, c, d, e) where
-  n .* (a, b, c, d, e) = (n .* a, n .* b, n .* c, n .* d, n .* e)
-
-class (Semiring r, Additive m) => RightModule r m where
-  (*.) :: m -> r -> m
-
-instance RightModule Natural Bool where 
-  _ *. 0 = False
-  a *. _ = a
-instance RightModule Natural Natural where (*.) = (*)
-instance RightModule Natural Integer where n *. Natural m = n * m
-instance RightModule Integer Integer where (*.) = (*) 
-instance RightModule Natural Int where m *. n = m * fromIntegral n
-instance RightModule Integer Int where m *. n = m * fromInteger n
-instance RightModule Natural Int8 where m *. n = m * fromIntegral n
-instance RightModule Integer Int8 where m *. n = m * fromInteger n
-instance RightModule Natural Int16 where m *. n = m * fromIntegral n
-instance RightModule Integer Int16 where m *. n = m * fromInteger n
-instance RightModule Natural Int32 where m *. n = m * fromIntegral n
-instance RightModule Integer Int32 where m *. n = m * fromInteger n
-instance RightModule Natural Int64 where m *. n = m * fromIntegral n
-instance RightModule Integer Int64 where m *. n = m * fromInteger n
-instance RightModule Natural Word where m *. n = m * fromIntegral n
-instance RightModule Integer Word where m *. n = m * fromInteger n
-instance RightModule Natural Word8 where m *. n = m * fromIntegral n
-instance RightModule Integer Word8 where m *. n = m * fromInteger n
-instance RightModule Natural Word16 where m *. n = m * fromIntegral n
-instance RightModule Integer Word16 where m *. n = m * fromInteger n
-instance RightModule Natural Word32 where m *. n = m * fromIntegral n
-instance RightModule Integer Word32 where m *. n = m * fromInteger n
-instance RightModule Natural Word64 where m *. n = m * fromIntegral n
-instance RightModule Integer Word64 where m *. n = m * fromInteger n
-instance Semiring r => RightModule r () where _ *. _ = ()
-instance RightModule r m => RightModule r (e -> m) where (*.) f m e = f e *. m
-instance (RightModule r a, RightModule r b) => RightModule r (a, b) where
-  (a, b) *. n = (a *. n, b *. n)
-instance (RightModule r a, RightModule r b, RightModule r c) => RightModule r (a, b, c) where
-  (a, b, c) *. n = (a *. n, b *. n, c *. n)
-instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d) => RightModule r (a, b, c, d) where
-  (a, b, c, d) *. n = (a *. n, b *. n, c *. n, d *. n)
-instance (RightModule r a, RightModule r b, RightModule r c, RightModule r d, RightModule r e) => RightModule r (a, b, c, d, e) where
-  (a, b, c, d, e) *. n = (a *. n, b *. n, c *. n, d *. n, e *. n)
-
+import Numeric.Algebra.Class
diff --git a/Numeric/Module/Complex.hs b/Numeric/Module/Complex.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Module/Complex.hs
@@ -0,0 +1,215 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Module.Complex
+  ( Complicated(..)
+  , ComplexBasis(..)
+  , Complex
+  ) 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 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
+
+instance Complicated ComplexBasis where
+  e = E
+  i = I
+
+instance Rig r => Complicated (Complex r) where
+  e = Complex one zero
+  i = Complex zero one
+  
+instance Rig r => Complicated (ComplexBasis -> r) where
+  e E = one
+  e _ = zero
+  i I = one
+  i _ = zero 
+
+instance Complicated a => Complicated (Covector r a) where
+  e = return e
+  i = return i
+
+type instance Key Complex = ComplexBasis
+
+instance Representable Complex where
+  tabulate f = Complex (f E) (f I)
+
+instance Indexable Complex where
+  index (Complex a _ ) E = a
+  index (Complex _ b ) I = b
+
+instance Lookup Complex where
+  lookup = lookupDefault
+
+instance Adjustable Complex where
+  adjust f E (Complex a b) = Complex (f a) b
+  adjust f I (Complex a b) = Complex a (f b)
+
+instance Distributive Complex where
+  distribute = distributeRep 
+
+instance Functor Complex where
+  fmap f (Complex a b) = Complex (f a) (f b)
+
+instance Zip Complex where
+  zipWith f (Complex a1 b1) (Complex a2 b2) = Complex (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Complex where
+  zipWithKey f (Complex a1 b1) (Complex a2 b2) = Complex (f E a1 a2) (f I b1 b2)
+
+instance Keyed Complex where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Complex where
+  (<.>) = apRep
+
+instance Applicative Complex where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Complex where
+  (>>-) = bindRep
+
+instance Monad Complex where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader ComplexBasis Complex where
+  ask = askRep
+  local = localRep
+
+instance Foldable Complex where
+  foldMap f (Complex a b) = f a `mappend` f b
+
+instance FoldableWithKey Complex where
+  foldMapWithKey f (Complex a b) = f E a `mappend` f I b
+
+instance Traversable Complex where
+  traverse f (Complex a b) = Complex <$> f a <*> f b
+
+instance TraversableWithKey Complex where
+  traverseWithKey f (Complex a b) = Complex <$> f E a <*> f I b
+
+instance Foldable1 Complex where
+  foldMap1 f (Complex a b) = f a <> f b
+
+instance FoldableWithKey1 Complex where
+  foldMapWithKey1 f (Complex a b) = f E a <> f I b
+
+instance Traversable1 Complex where
+  traverse1 f (Complex a b) = Complex <$> f a <.> f b
+
+instance TraversableWithKey1 Complex where
+  traverseWithKey1 f (Complex a b) = Complex <$> f E a <.> f I b
+
+instance HasTrie ComplexBasis where
+  type BaseTrie ComplexBasis = Complex
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Complex r) where
+  (+) = addRep 
+  replicate1p = replicate1pRep
+
+instance LeftModule r s => LeftModule r (Complex s) where
+  r .* Complex a b = Complex (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Complex s) where
+  Complex a b *. r = Complex (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Complex r) where
+  zero = zeroRep
+  replicate = replicateRep
+
+instance Group r => Group (Complex r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Complex r)
+
+instance Idempotent r => Idempotent (Complex r)
+
+instance Partitionable r => Partitionable (Complex r) where
+  partitionWith f (Complex a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Complex a1 b1) (Complex a2 b2)) b) a
+
+instance Rng k => Algebra k ComplexBasis where
+  mult f = f' where
+    fe = f E E - f I I
+    fi = f E I + f I E
+    f' E = fe
+    f' I = fi
+
+instance Rng k => UnitalAlgebra k ComplexBasis where
+  unit x E = x
+  unit _ _ = zero
+
+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
+
+instance Rng k => CounitalCoalgebra k ComplexBasis where
+  counit f = f E
+
+instance Rng k => Bialgebra k ComplexBasis 
+
+instance Rng k => InvolutiveAlgebra k ComplexBasis where
+  inv f E = f E
+  inv f b = negate (f b)
+
+instance Rng k => InvolutiveCoalgebra k ComplexBasis where
+  coinv = inv
+
+instance Rng k => HopfAlgebra k ComplexBasis where
+  antipode = inv
+
+instance (Commutative r, Rng r) => Multiplicative (Complex r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng r) => Commutative (Complex r)
+
+instance (Commutative r, Rng r) => Semiring (Complex r)
+
+instance (Commutative r, Ring r) => Unital (Complex r) where
+  one = oneRep
+
+instance (Commutative r, Ring r) => Rig (Complex r) where
+  fromNatural n = Complex (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Complex r) where
+  fromInteger n = Complex (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Complex r) (Complex r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Complex r) (Complex r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Complex r) where
+  adjoint (Complex a b) = Complex (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Complex r)
diff --git a/Numeric/Module/Quaternion.hs b/Numeric/Module/Quaternion.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Module/Quaternion.hs
@@ -0,0 +1,275 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Module.Quaternion 
+  ( Complicated(..)
+  , Hamiltonian(..)
+  , QuaternionBasis(..)
+  , Quaternion(..)
+  , complicate
+  , uncomplicate
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Ix
+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.Module.Complex (ComplexBasis, Complicated(..))
+import qualified Numeric.Module.Complex as Complex
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+
+class Complicated t => Hamiltonian t where
+  j :: t
+  k :: t
+
+instance Complicated QuaternionBasis where
+  e = E
+  i = I
+
+instance Hamiltonian QuaternionBasis where
+  j = J
+  k = K
+
+instance Rig r => Complicated (Quaternion r) where
+  e = Quaternion one zero zero zero
+  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
+  e E = one 
+  e _ = zero
+
+  i I = one
+  i _ = zero
+  
+instance Rig r => Hamiltonian (QuaternionBasis -> r) where
+  j J = one
+  j _ = zero
+
+  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)
+
+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
+
+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)
+    fi = f E I + f I E + f J K - f K J
+    fj = f E J + f J E + f K I - f I K
+    fk = f E K + f K E + f I J - f J I
+    f' E = fe
+    f' I = fi
+    f' J = fj
+    f' K = fk
+             
+instance (TriviallyInvolutive r, Rng r) => UnitalAlgebra r QuaternionBasis where
+  unit x E = x 
+  unit _ _ = zero
+
+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' E I = fi
+     f' E J = fj
+     f' E K = fk
+     f' I E = fi
+     f' I I = negate fe
+     f' I J = fk
+     f' I K = negate fj
+     f' J E = fj
+     f' J I = negate fk
+     f' J J = negate fe
+     f' J K = fi
+     f' K E = fk
+     f' K I = fj
+     f' K J = negate fi
+     f' K K = negate 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, Rng r)  => InvolutiveAlgebra r QuaternionBasis where
+  inv f E = f E
+  inv f b = negate (f b)
+
+instance (TriviallyInvolutive r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where
+  coinv = inv
+
+instance (TriviallyInvolutive r, Rng r) => HopfAlgebra r QuaternionBasis where
+  antipode = inv
+
+instance (TriviallyInvolutive r, Rng r) => Multiplicative (Quaternion r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng 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 :: 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)
+
+-- | 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
diff --git a/Numeric/Module/Representable.hs b/Numeric/Module/Representable.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Module/Representable.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}
+module Numeric.Module.Representable 
+  ( 
+  -- * Representable Additive
+    addRep, replicate1pRep
+  -- * Representable Monoidal
+  , zeroRep, replicateRep
+  -- * Representable Group
+  , negateRep, minusRep, subtractRep, timesRep
+  -- * Representable Multiplicative (via Algebra)
+  , mulRep
+  -- * Representable Unital (via UnitalAlgebra)
+  , oneRep
+  -- * Representable Rig (via Algebra)
+  , fromNaturalRep
+  -- * Representable Ring (via Algebra)
+  , fromIntegerRep
+  ) where
+
+import Control.Applicative
+import Data.Functor
+import Data.Functor.Representable
+import Data.Key
+import Numeric.Additive.Class
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Natural.Internal
+import Numeric.Rig.Class
+import Numeric.Ring.Class
+import Control.Category
+import Prelude (($), Integral(..),Integer)
+
+-- | `Additive.(+)` default definition
+addRep :: (Zip m, Additive r) => m r -> m r -> m r
+addRep = zipWith (+)
+
+-- | `Additive.replicate1p` default definition
+replicate1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r
+replicate1pRep = fmap . replicate1p
+
+-- | `Monoidal.zero` default definition
+zeroRep :: (Applicative m, Monoidal r) => m r 
+zeroRep = pure zero
+
+-- | `Monoidal.replicate` default definition
+replicateRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r
+replicateRep = fmap . replicate
+
+-- | `Group.negate` default definition
+negateRep :: (Functor m, Group r) => m r -> m r
+negateRep = fmap negate
+
+-- | `Group.(-)` default definition
+minusRep :: (Zip m, Group r) => m r -> m r -> m r
+minusRep = zipWith (-)
+
+-- | `Group.subtract` default definition
+subtractRep :: (Zip m, Group r) => m r -> m r -> m r
+subtractRep = zipWith subtract
+
+-- | `Group.times` default definition
+timesRep :: (Integral n, Functor m, Group r) => n -> m r -> m r
+timesRep = fmap . times
+
+-- | `Multiplicative.(*)` default definition
+mulRep :: (Representable m, Algebra r (Key m)) => m r -> m r -> m r
+mulRep m n = tabulate $ mult (\b1 b2 -> index m b1 * index n b2)
+
+-- | `Unital.one` default definition
+oneRep :: (Representable m, Unital r, UnitalAlgebra r (Key m)) => m r
+oneRep = tabulate $ unit one
+
+-- | `Rig.fromNatural` default definition
+fromNaturalRep :: (UnitalAlgebra r (Key m), Representable m, Rig r) => Natural -> m r
+fromNaturalRep n = tabulate $ unit (fromNatural n)
+
+-- | `Ring.fromInteger` default definition
+fromIntegerRep :: (UnitalAlgebra r (Key m), Representable m, Ring r) => Integer -> m r
+fromIntegerRep n = tabulate $ unit (fromInteger n)
diff --git a/Numeric/Monoid.hs b/Numeric/Monoid.hs
deleted file mode 100644
--- a/Numeric/Monoid.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Monoid
-  ( module Numeric.Semigroup
-  , module Numeric.Monoid.Additive
-  , module Numeric.Monoid.Multiplicative
-  ) where
-
-import Numeric.Semigroup
-import Numeric.Monoid.Additive
-import Numeric.Monoid.Multiplicative
diff --git a/Numeric/Monoid/Additive.hs b/Numeric/Monoid/Additive.hs
deleted file mode 100644
--- a/Numeric/Monoid/Additive.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
-module Numeric.Monoid.Additive
-  ( 
-  -- * Additive Monoids
-    AdditiveMonoid(..)
-  , sum
-  ) where
-
-import Data.Foldable hiding (sum)
-import Data.Int
-import Data.Word
-import Numeric.Module.Class
-import Numeric.Natural.Internal
-import Numeric.Semigroup.Additive
-import Prelude hiding ((+), sum, replicate)
-
--- | An additive monoid
---
--- > zero + a = a = a + zero
-class (LeftModule Natural m, RightModule Natural m) => AdditiveMonoid m where
-  zero :: m
-
-  replicate :: Whole n => n -> m -> m
-  replicate 0 _  = zero
-  replicate n x0 = f x0 n
-    where
-      f x y
-        | even y = f (x + x) (y `quot` 2)
-        | y == 1 = x
-        | otherwise = g (x + x) (unsafePred y `quot` 2) x
-      g x y z
-        | even y = g (x + x) (y `quot` 2) z
-        | y == 1 = x + z
-        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)
-
-  sumWith :: Foldable f => (a -> m) -> f a -> m
-  sumWith f = foldl' (\b a -> b + f a) zero
-
-sum :: (Foldable f, AdditiveMonoid m) => f m -> m
-sum = sumWith id
-
-instance AdditiveMonoid Bool where 
-  zero = False
-  replicate 0 _ = False
-  replicate _ r = r
-
-instance AdditiveMonoid Natural where
-  zero = 0
-  replicate n r = toNatural n * r
-
-instance AdditiveMonoid Integer where 
-  zero = 0
-  replicate n r = toInteger n * r
-
-instance AdditiveMonoid Int where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Int8 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Int16 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Int32 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Int64 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Word where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Word8 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Word16 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Word32 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid Word64 where 
-  zero = 0
-  replicate n r = fromIntegral n * r
-
-instance AdditiveMonoid r => AdditiveMonoid (e -> r) where
-  zero = const zero
-  sumWith f xs e = sumWith (`f` e) xs
-  replicate n r e = replicate n (r e)
-
-instance AdditiveMonoid () where 
-  zero = ()
-  replicate _ () = ()
-  sumWith _ _ = ()
-
-instance (AdditiveMonoid a, AdditiveMonoid b) => AdditiveMonoid (a,b) where
-  zero = (zero,zero)
-  replicate n (a,b) = (replicate n a, replicate n b)
-
-instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c) => AdditiveMonoid (a,b,c) where
-  zero = (zero,zero,zero)
-  replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)
-
-instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d) => AdditiveMonoid (a,b,c,d) where
-  zero = (zero,zero,zero,zero)
-  replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)
-
-instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d, AdditiveMonoid e) => AdditiveMonoid (a,b,c,d,e) where
-  zero = (zero,zero,zero,zero,zero)
-  replicate n (a,b,c,d,e) = (replicate n a, replicate n b, replicate n c, replicate n d, replicate n e)
diff --git a/Numeric/Monoid/Multiplicative.hs b/Numeric/Monoid/Multiplicative.hs
deleted file mode 100644
--- a/Numeric/Monoid/Multiplicative.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Numeric.Monoid.Multiplicative
-  ( Unital(..)
-  , product
-  ) where
-
-import Numeric.Monoid.Multiplicative.Internal
-import Prelude ()
diff --git a/Numeric/Monoid/Multiplicative/Internal.hs b/Numeric/Monoid/Multiplicative/Internal.hs
deleted file mode 100644
--- a/Numeric/Monoid/Multiplicative/Internal.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Monoid.Multiplicative.Internal
-  ( Unital(..)
-  , product
-  , FreeUnitalAlgebra(..)
-  ) where
-
-import Data.Foldable hiding (product)
-import Data.Int
-import Data.Word
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import Prelude hiding ((*), foldr, product)
-import Numeric.Semiring.Internal
-import Numeric.Monoid.Additive
-import Numeric.Natural.Internal
-
-infixr 8 `pow`
-
-class Multiplicative r => Unital r where
-  one :: r
-  pow :: Whole n => r -> n -> r
-  pow _ 0 = one
-  pow x0 y0 = f x0 y0 where
-    f x y 
-      | even y = f (x * x) (y `quot` 2)
-      | y == 1 = x
-      | otherwise = g (x * x) ((y - 1) `quot` 2) x
-    g x y z 
-      | even y = g (x * x) (y `quot` 2) z
-      | y == 1 = x * z
-      | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
-  productWith :: Foldable f => (a -> r) -> f a -> r
-  productWith f = foldl' (\b a -> b * f a) one
-
-product :: (Foldable f, Unital r) => f r -> r
-product = productWith id
-
-instance Unital Bool where one = True
-instance Unital Integer where one = 1
-instance Unital Int where one = 1
-instance Unital Int8 where one = 1
-instance Unital Int16 where one = 1
-instance Unital Int32 where one = 1
-instance Unital Int64 where one = 1
-instance Unital Natural where one = 1
-instance Unital Word where one = 1
-instance Unital Word8 where one = 1
-instance Unital Word16 where one = 1
-instance Unital Word32 where one = 1
-instance Unital Word64 where one = 1
-instance Unital () where one = ()
-instance (Unital a, Unital b) => Unital (a,b) where
-  one = (one,one)
-
-instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where
-  one = (one,one,one)
-
-instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where
-  one = (one,one,one,one)
-
-instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where
-  one = (one,one,one,one,one)
-
--- | An associative unital algebra over a semiring, built using a free module
-class (FreeAlgebra r a) => FreeUnitalAlgebra r a where
-  unit :: r -> a -> r
-
-instance (Unital r, FreeUnitalAlgebra r a) => Unital (a -> r) where
-  one = unit one
-
-instance FreeUnitalAlgebra () a where
-  unit _ _ = ()
-
-instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra (a -> r) b where
-  unit f b a = unit (f a) b
-
-instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra r (a,b) where
-  unit r (a,b) = unit r a * unit r b
-
-instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c) => FreeUnitalAlgebra r (a,b,c) where
-  unit r (a,b,c) = unit r a * unit r b * unit r c
-
-instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d) => FreeUnitalAlgebra r (a,b,c,d) where
-  unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d
-
-instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d, FreeUnitalAlgebra r e) => FreeUnitalAlgebra r (a,b,c,d,e) where
-  unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e
-
-instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r [a] where
-  unit r [] = r
-  unit _ _ = zero
-
-instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r (Seq a) where
-  unit r a | Seq.null a = r
-           | otherwise = zero
diff --git a/Numeric/Multiplication.hs b/Numeric/Multiplication.hs
deleted file mode 100644
--- a/Numeric/Multiplication.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Numeric.Multiplication 
-  ( module Numeric.Semigroup.Multiplicative
-  , module Numeric.Monoid.Multiplicative
-  , module Numeric.Group.Multiplicative
-  , module Numeric.Multiplication.Commutative
-  , module Numeric.Multiplication.Involutive
-  , module Numeric.Multiplication.Factorable
-  ) where
-
-import Numeric.Semigroup.Multiplicative
-import Numeric.Monoid.Multiplicative
-import Numeric.Group.Multiplicative
-import Numeric.Multiplication.Commutative
-import Numeric.Multiplication.Involutive
-import Numeric.Multiplication.Factorable
diff --git a/Numeric/Multiplication/Commutative.hs b/Numeric/Multiplication/Commutative.hs
deleted file mode 100644
--- a/Numeric/Multiplication/Commutative.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Numeric.Multiplication.Commutative where
-
-import Data.Int
-import Data.Word
-import Numeric.Semigroup.Multiplicative
-import Numeric.Natural
-
--- | A commutative multiplicative semigroup
-class Multiplicative r => Commutative r
-
-instance Commutative () 
-instance Commutative Bool
-instance Commutative Integer
-instance Commutative Int
-instance Commutative Int8
-instance Commutative Int16
-instance Commutative Int32
-instance Commutative Int64
-instance Commutative Natural
-instance Commutative Word
-instance Commutative Word8
-instance Commutative Word16
-instance Commutative Word32
-instance Commutative Word64
-instance (Commutative a, Commutative b) => Commutative (a,b) 
-instance (Commutative a, Commutative b, Commutative c) => Commutative (a,b,c) 
-instance (Commutative a, Commutative b, Commutative c, Commutative d) => Commutative (a,b,c,d) 
-instance (Commutative a, Commutative b, Commutative c, Commutative d, Commutative e) => Commutative (a,b,c,d,e) 
diff --git a/Numeric/Multiplication/Factorable.hs b/Numeric/Multiplication/Factorable.hs
deleted file mode 100644
--- a/Numeric/Multiplication/Factorable.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-module Numeric.Multiplication.Factorable
-  ( -- * Partitionable Additive Semigroups
-    Factorable(..)
-  ) where
-
-import Data.List.NonEmpty
-import Numeric.Semigroup.Multiplicative
-import Prelude hiding (concat)
-
--- | `factorWith f c` returns a non-empty list containing `f a b` for all `a, b` such that `a * b = c`.
---
--- Results of factorWith f 0 are undefined and may result in either an error or an infinite list.
-
-class Multiplicative m => Factorable m where
-  factorWith :: (m -> m -> r) -> m -> NonEmpty r
-
-instance Factorable Bool where
-  factorWith f False = f False False :| [f False True, f True False]
-  factorWith f True  = f True True :| []
-
-instance Factorable () where
-  factorWith f () = f () () :| []
-
-concat :: NonEmpty (NonEmpty a) -> NonEmpty a
-concat m = m >>= id
-
-instance (Factorable a, Factorable b) => Factorable (a,b) where
-  factorWith f (a,b) = concat $ factorWith (\ax ay ->
-                                factorWith (\bx by -> f (ax,bx) (ay,by)) b) a
-
-instance (Factorable a, Factorable b, Factorable c) => Factorable (a,b,c) where
-  factorWith f (a,b,c) = concat $ factorWith (\ax ay ->
-                            concat $ factorWith (\bx by ->
-                                     factorWith (\cx cy -> f (ax,bx,cx) (ay,by,cy)) c) b) a
-
-instance (Factorable a, Factorable b, Factorable c,Factorable d ) => Factorable (a,b,c,d) where
-  factorWith f (a,b,c,d) = concat $ factorWith (\ax ay ->
-                           concat $ factorWith (\bx by ->
-                           concat $ factorWith (\cx cy ->
-                                    factorWith (\dx dy -> f (ax,bx,cx,dx) (ay,by,cy,dy)) d) c) b) a
-
-instance (Factorable a, Factorable b, Factorable c,Factorable d, Factorable e) => Factorable (a,b,c,d,e) where
-  factorWith f (a,b,c,d,e) = concat $ factorWith (\ax ay ->
-                             concat $ factorWith (\bx by ->
-                             concat $ factorWith (\cx cy ->
-                             concat $ factorWith (\dx dy ->
-                                      factorWith (\ex ey -> f (ax,bx,cx,dx,ex) (ay,by,cy,dy,ey)) e) d) c) b) a
-
-
diff --git a/Numeric/Multiplication/Involutive.hs b/Numeric/Multiplication/Involutive.hs
deleted file mode 100644
--- a/Numeric/Multiplication/Involutive.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-module Numeric.Multiplication.Involutive
-  ( InvolutiveMultiplication(..)
-  , adjointCommutative
-  ) where
-
-import Data.Int
-import Data.Word
-import Numeric.Natural.Internal
-import Numeric.Semigroup.Multiplicative
-import Numeric.Multiplication.Commutative
-
--- | An semigroup with involution
--- 
--- > adjoint a * adjoint b = adjoint (b * a)
-class Multiplicative r => InvolutiveMultiplication r where
-  adjoint :: r -> r
-
-adjointCommutative :: Commutative r => r -> r
-adjointCommutative = id
-
-instance InvolutiveMultiplication Int where adjoint = id
-instance InvolutiveMultiplication Integer where adjoint = id
-instance InvolutiveMultiplication Int8 where adjoint = id
-instance InvolutiveMultiplication Int16 where adjoint = id
-instance InvolutiveMultiplication Int32 where adjoint = id
-instance InvolutiveMultiplication Int64 where adjoint = id
-instance InvolutiveMultiplication Bool where adjoint = id
-instance InvolutiveMultiplication Word where adjoint = id
-instance InvolutiveMultiplication Natural where adjoint = id
-instance InvolutiveMultiplication Word8 where adjoint = id
-instance InvolutiveMultiplication Word16 where adjoint = id
-instance InvolutiveMultiplication Word32 where adjoint = id
-instance InvolutiveMultiplication Word64 where adjoint = id
-instance InvolutiveMultiplication () where adjoint = id
-instance (InvolutiveMultiplication a, InvolutiveMultiplication b) => InvolutiveMultiplication (a,b) where
-  adjoint (a,b) = (adjoint a, adjoint b)
-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c) => InvolutiveMultiplication (a,b,c) where
-  adjoint (a,b,c) = (adjoint a, adjoint b, adjoint c)
-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d) => InvolutiveMultiplication (a,b,c,d) where
-  adjoint (a,b,c,d) = (adjoint a, adjoint b, adjoint c, adjoint d)
-instance (InvolutiveMultiplication a, InvolutiveMultiplication b, InvolutiveMultiplication c, InvolutiveMultiplication d, InvolutiveMultiplication e) => InvolutiveMultiplication (a,b,c,d,e) where
-  adjoint (a,b,c,d,e) = (adjoint a, adjoint b, adjoint c, adjoint d, adjoint e)
diff --git a/Numeric/Order.hs b/Numeric/Order.hs
deleted file mode 100644
--- a/Numeric/Order.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Order
-  ( module Numeric.Order.Class
-  , module Numeric.Order.Additive
-  , module Numeric.Rig.Ordered
-  ) where
-
-import Numeric.Order.Class
-import Numeric.Order.Additive
-import Numeric.Rig.Ordered
diff --git a/Numeric/Order/Additive.hs b/Numeric/Order/Additive.hs
--- a/Numeric/Order/Additive.hs
+++ b/Numeric/Order/Additive.hs
@@ -2,8 +2,8 @@
   ( AdditiveOrder
   ) where
 
-import Numeric.Natural
-import Numeric.Semigroup.Additive
+import Numeric.Natural.Internal
+import Numeric.Additive.Class
 import Numeric.Order.Class
 
 -- An additive semigroup with a partial order (<=)
diff --git a/Numeric/Order/Class.hs b/Numeric/Order/Class.hs
--- a/Numeric/Order/Class.hs
+++ b/Numeric/Order/Class.hs
@@ -5,7 +5,7 @@
 
 import Data.Int
 import Data.Word
-import Numeric.Natural
+import Numeric.Natural.Internal
 
 -- a partial order (a, <=)
 class Order a where
diff --git a/Numeric/Polynomial/Basis/Power.hs b/Numeric/Polynomial/Basis/Power.hs
deleted file mode 100644
--- a/Numeric/Polynomial/Basis/Power.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE TypeOperators, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}
-module Numeric.Polynomial.Basis.Power 
-  ( 
-  -- * Power basis
-    (:^)(Power, logPower)
-  , (^:)
-  -- * Variables
-  , W(..), X(..), Y(..), Z(..)
-  , x
-  , at
-  , delta
-  , coef
-  ) where
-
-import Control.Applicative
-import Data.Foldable
-import Data.Function (on)
-import Data.Proxy
-import Data.Reflection
-import Data.Functor.Representable.Trie
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Traversable
-import Numeric.Addition
-import Numeric.Algebra.Free
-import Numeric.Multiplication
-import Numeric.Decidable.Zero
-import Numeric.Decidable.Units
-import Numeric.Semiring.Class
-import Numeric.Rig.Class
-import Numeric.Functional.Linear
-import Numeric.Natural.Internal
-import Prelude hiding ((^),(+),(-),(*),negate, replicate,subtract)
-
-infixr 8 :^,^:
-
-newtype x:^n = Power { logPower :: n } deriving (Eq,Ord)
-
--- convenient constructor 
--- X ^: 12
-(^:) :: x -> n -> x :^ n
-_ ^: n = Power n
-
-data W = W deriving Show; instance Reifies W W where reflect _ = W
-  
-data X = X deriving Show; instance Reifies X X where reflect _ = X
-
-data Y = Y deriving Show; instance Reifies Y Y where reflect _ = Y
-
-data Z = Z deriving Show; instance Reifies Z Z where reflect _ = Z
-
-instance (Show t, Reifies x t, Show n) => Show (x:^n) where
-  showsPrec d p = showParen (d > 8) $
-   showsPrec 9 (reflect (proxyX p)) . showString "^:" . showsPrec 8 (logPower p) where
-      proxyX :: x:^n -> Proxy x
-      proxyX _ = Proxy
-
-instance Functor ((:^) x) where
-  fmap f (Power n) = Power (f n)
-
-instance Foldable ((:^) x) where
-  foldMap f (Power n) = f n
-
-instance Traversable ((:^) x) where
-  traverse f (Power n) = Power <$> f n
-
-instance Foldable1 ((:^) x) where
-  foldMap1 f (Power n) = f n
-
-instance Traversable1 ((:^) x) where
-  traverse1 f (Power n) = Power <$> f n
-
-instance HasTrie n => HasTrie (x :^ n) where
-  type BaseTrie (x :^ n) = BaseTrie n
-  embedKey = embedKey . logPower
-  projectKey = Power . projectKey
-
-instance Additive n => Multiplicative (x :^ n) where
-  Power n * Power m = Power (n + m)
-  pow1p (Power n) m = Power (replicate1p m n)
-
-instance AdditiveMonoid n => Unital (x :^ n) where
-  one = Power zero
-  pow (Power n) m = Power (replicate m n)
-
-instance AdditiveGroup n => MultiplicativeGroup (x :^ n) where
-  Power n / Power m = Power (n - m)
-  recip (Power n) = Power (negate n)
-  Power n \\ Power m = Power (subtract n m)
-  Power n ^ m = Power (times m n)
-
-instance DecidableZero n => DecidableUnits (x :^ n) where
-  recipUnit (Power n) | isZero n  = Just (Power n)
-                      | otherwise = Nothing
-
-instance Partitionable n => Factorable (x :^ n) where
-  factorWith f = partitionWith (f `on` Power) . logPower 
-
-instance (Semiring r, Additive n) => FreeCoalgebra r (x :^ n) where
-  cojoin f i j = f $ i * j
-
-instance (Semiring r, AdditiveMonoid n) => FreeCounitalCoalgebra r (x :^ n) where
-  counit f = f one
-
-instance (Semiring r, Partitionable n) => FreeAlgebra r (x :^ n) where
-  join f = sum1 . partitionWith (f `on` Power) . logPower
-
-instance (Semiring r, AdditiveMonoid r, Unital r, DecidableZero n, Partitionable n) => FreeUnitalAlgebra r (x :^ n) where
-  unit r (Power n) | isZero n  = r
-                   | otherwise = zero
-
-x :: Unital n => Linear r (x:^n)
-x = Linear $ \k -> k $ Power one
-
--- the price of this approach is the loss of Horner's scheme
-at :: (Unital r, Whole n) => Linear r (x:^n) -> r -> r
-m `at` r = m $* pow r . logPower
-
-delta :: (Rig r, Eq a) => a -> a -> r
-delta i j | i == j = one
-          | otherwise = zero
-
--- extract the nth coefficient of a polynomial
-coef :: (Rig r, Eq n) => n -> Linear r (x:^n) -> r
-coef n m = m $* delta (Power n)
-
diff --git a/Numeric/Quadrance/Class.hs b/Numeric/Quadrance/Class.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Quadrance/Class.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE MultiParamTypeClasses, IncoherentInstances, OverlappingInstances, FlexibleInstances #-}
+module Numeric.Quadrance.Class
+  ( Quadrance(..)
+  ) where
+
+import Data.Int
+import Data.Word
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Rig.Class
+import Numeric.Natural.Internal
+import Prelude hiding ((+),(*))
+
+-- a module with a computable squared norm
+class Additive r => Quadrance r m where
+  quadrance :: m -> r
+
+instance Quadrance () a where 
+  quadrance _ = ()
+
+instance Monoidal r => Quadrance r () where
+  quadrance _ = zero
+
+instance (Quadrance r a, Quadrance r b) => Quadrance r (a,b) where
+  quadrance (a,b) = quadrance a + quadrance b
+
+instance (Quadrance r a, Quadrance r b, Quadrance r c) => Quadrance r (a,b,c) where
+  quadrance (a,b,c) = quadrance a + quadrance b + quadrance c
+
+instance (Quadrance r a, Quadrance r b, Quadrance r c, Quadrance r d) => Quadrance r (a,b,c,d) where
+  quadrance (a,b,c,d) = quadrance a + quadrance b + quadrance c + quadrance d
+
+instance (Quadrance r a, Quadrance r b, Quadrance r c, Quadrance r d, Quadrance r e) => Quadrance r (a,b,c,d,e) where
+  quadrance (a,b,c,d,e) = quadrance a + quadrance b + quadrance c + quadrance d + quadrance e
+
+instance Rig r => Quadrance r Bool where
+  quadrance False = zero
+  quadrance True  = one
+
+sq :: Multiplicative r => r -> r
+sq r = r * r
+
+instance Rig r => Quadrance r Int where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Word where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Natural where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Integer where 
+  quadrance = fromNatural . Natural . fromInteger . sq
+
+instance Rig r => Quadrance r Int8 where 
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Int16 where 
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Int32 where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Int64 where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Word8 where 
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Word16 where 
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Word32 where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+instance Rig r => Quadrance r Word64 where
+  quadrance = fromNatural . Natural . sq . toInteger
+
+{-
+instance InvolutiveSemiring r => Quadrance r (Complex r) where
+  quadrance n = e (adjoint n * n)
+
+instance InvolutiveSemiring r => Quadrance r (Quaternion r) where
+  quadrance n = e (adjoint n * n)
+-}
diff --git a/Numeric/Rig.hs b/Numeric/Rig.hs
deleted file mode 100644
--- a/Numeric/Rig.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Rig
-  ( module Numeric.Rig.Class
-  , module Numeric.Rig.Ordered
-  , module Numeric.Rig.Characteristic
-  ) where
-
-import Numeric.Rig.Class
-import Numeric.Rig.Ordered
-import Numeric.Rig.Characteristic
diff --git a/Numeric/Rig/Characteristic.hs b/Numeric/Rig/Characteristic.hs
--- a/Numeric/Rig/Characteristic.hs
+++ b/Numeric/Rig/Characteristic.hs
@@ -2,32 +2,26 @@
   ( Characteristic(..)
   , charInt
   , charWord
-  , frobenius
   ) where
 
 import Data.Int
 import Data.Word
-import Data.Proxy
 import Numeric.Rig.Class
-import Numeric.Ring.Endomorphism
 import Numeric.Natural.Internal
-import Numeric.Monoid.Multiplicative
 import Prelude hiding ((^))
 
-class Rig r => Characteristic r where
-  char :: Proxy r -> Natural
-
--- the frobenius ring endomorphism (assuming the characteristic is prime)
-frobenius :: Characteristic r => End r
-frobenius = End $ \r -> r `pow` char (ofRing r)
+data Proxy p = Proxy
 
-ofRing :: r -> Proxy r
-ofRing _ = Proxy
+class Rig r => Characteristic r where
+  char :: proxy r -> Natural
 
-charInt :: (Integral s, Bounded s) => Proxy s -> Natural
+charInt :: (Integral s, Bounded s) => proxy s -> Natural
 charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2
 
-charWord :: (Whole s, Bounded s) => Proxy s -> Natural
+asProxyTypeOf :: a -> p a -> a
+asProxyTypeOf = const
+
+charWord :: (Whole s, Bounded s) => proxy s -> Natural
 charWord p = toNatural (maxBound `asProxyTypeOf` p) + 1
 
 -- | NB: we're using the boolean semiring, not the boolean ring
@@ -48,40 +42,40 @@
 
 instance (Characteristic a, Characteristic b) => Characteristic (a,b) where
   char p = char (a p) `lcm` char (b p) where
-    a :: Proxy (a,b) -> Proxy a
+    a :: proxy (a,b) -> Proxy a
     a _ = Proxy
-    b :: Proxy (a,b) -> Proxy b
+    b :: proxy (a,b) -> Proxy b
     b _ = Proxy
 
 instance (Characteristic a, Characteristic b, Characteristic c) => Characteristic (a,b,c) where
   char p = char (a p) `lcm` char (b p) `lcm` char (c p) where
-    a :: Proxy (a,b,c) -> Proxy a
+    a :: proxy (a,b,c) -> Proxy a
     a _ = Proxy
-    b :: Proxy (a,b,c) -> Proxy b
+    b :: proxy (a,b,c) -> Proxy b
     b _ = Proxy
-    c :: Proxy (a,b,c) -> Proxy c
+    c :: proxy (a,b,c) -> Proxy c
     c _ = Proxy
 
 instance (Characteristic a, Characteristic b, Characteristic c, Characteristic d) => Characteristic (a,b,c,d) where
   char p = char (a p) `lcm` char (b p) `lcm` char (c p) `lcm` char (d p) where
-    a :: Proxy (a,b,c,d) -> Proxy a
+    a :: proxy (a,b,c,d) -> Proxy a
     a _ = Proxy
-    b :: Proxy (a,b,c,d) -> Proxy b
+    b :: proxy (a,b,c,d) -> Proxy b
     b _ = Proxy
-    c :: Proxy (a,b,c,d) -> Proxy c
+    c :: proxy (a,b,c,d) -> Proxy c
     c _ = Proxy
-    d :: Proxy (a,b,c,d) -> Proxy d
+    d :: proxy (a,b,c,d) -> Proxy d
     d _ = Proxy
 
 instance (Characteristic a, Characteristic b, Characteristic c, Characteristic d, Characteristic e) => Characteristic (a,b,c,d,e) where
   char p = char (a p) `lcm` char (b p) `lcm` char (c p) `lcm` char (d p) `lcm` char (e p) where
-    a :: Proxy (a,b,c,d,e) -> Proxy a
+    a :: proxy (a,b,c,d,e) -> Proxy a
     a _ = Proxy
-    b :: Proxy (a,b,c,d,e) -> Proxy b
+    b :: proxy (a,b,c,d,e) -> Proxy b
     b _ = Proxy
-    c :: Proxy (a,b,c,d,e) -> Proxy c
+    c :: proxy (a,b,c,d,e) -> Proxy c
     c _ = Proxy
-    d :: Proxy (a,b,c,d,e) -> Proxy d
+    d :: proxy (a,b,c,d,e) -> Proxy d
     d _ = Proxy
-    e :: Proxy (a,b,c,d,e) -> Proxy e
+    e :: proxy (a,b,c,d,e) -> Proxy e
     e _ = Proxy
diff --git a/Numeric/Rig/Class.hs b/Numeric/Rig/Class.hs
--- a/Numeric/Rig/Class.hs
+++ b/Numeric/Rig/Class.hs
@@ -4,9 +4,8 @@
   , fromWhole
   ) where
 
-import Numeric.Monoid.Additive
-import Numeric.Monoid.Multiplicative
-import Numeric.Semiring.Class
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
 import Data.Int
 import Data.Word
 import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))
@@ -16,8 +15,7 @@
 fromNaturalNum (Natural n) = fromInteger n
 
 -- | A Ring without (n)egation
-
-class (Semiring r, AdditiveMonoid r, Unital r) => Rig r where
+class (Semiring r, Unital r, Monoidal r) => Rig r where
   fromNatural :: Natural -> r
   fromNatural n = replicate n one
 
diff --git a/Numeric/Ring.hs b/Numeric/Ring.hs
deleted file mode 100644
--- a/Numeric/Ring.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Numeric.Ring
-  ( module Numeric.Ring.Class
-  , module Numeric.Ring.Endomorphism
-  , module Numeric.Ring.Opposite
-  , module Numeric.Ring.Rng
-  ) where
-
-import Numeric.Ring.Class
-import Numeric.Ring.Endomorphism
-import Numeric.Ring.Opposite
-import Numeric.Ring.Rng
diff --git a/Numeric/Ring/Class.hs b/Numeric/Ring/Class.hs
--- a/Numeric/Ring/Class.hs
+++ b/Numeric/Ring/Class.hs
@@ -7,8 +7,8 @@
 import Data.Word
 import Numeric.Rig.Class
 import Numeric.Rng.Class
-import Numeric.Group.Additive
-import Numeric.Monoid.Multiplicative
+import Numeric.Additive.Group
+import Numeric.Algebra.Unital
 import qualified Prelude
 import Prelude (Integral(toInteger), Integer, (.))
 
diff --git a/Numeric/Ring/Endomorphism.hs b/Numeric/Ring/Endomorphism.hs
--- a/Numeric/Ring/Endomorphism.hs
+++ b/Numeric/Ring/Endomorphism.hs
@@ -3,17 +3,13 @@
   ( End(..)
   , toEnd
   , fromEnd
+  , frobenius
   ) where
 
 import Data.Monoid
-import Numeric.Addition
-import Numeric.Module
-import Numeric.Multiplication
-import Numeric.Semiring.Class
-import Numeric.Rng.Class
-import Numeric.Rig.Class
-import Numeric.Ring.Class
+import Numeric.Algebra
 import Prelude hiding ((*),(+),(-),negate,subtract)
+import Data.Proxy
 
 -- | The endomorphism ring of an abelian group or the endomorphism semiring of an abelian monoid
 -- 
@@ -25,9 +21,9 @@
 instance Additive r => Additive (End r) where
   End f + End g = End (f + g)
 instance Abelian r => Abelian (End r)
-instance AdditiveMonoid r => AdditiveMonoid (End r) where
+instance Monoidal r => Monoidal (End r) where
   zero = End (const zero)
-instance AdditiveGroup r => AdditiveGroup (End r) where
+instance Group r => Group (End r) where
   End f - End g = End (f - g)
   negate (End f) = End (negate f)
   subtract (End f) (End g) = End (subtract f g)
@@ -36,19 +32,19 @@
 instance Unital (End r) where
   one = End id
 instance (Abelian r, Commutative r) => Commutative (End r) 
-instance (Abelian r, AdditiveMonoid r) => Semiring (End r)
-instance (Abelian r, AdditiveMonoid r) => Rig (End r)
-instance (Abelian r, AdditiveGroup r) => Rng (End r)
-instance (Abelian r, AdditiveGroup r) => Ring (End r)
-instance (AdditiveMonoid m, Abelian m) => LeftModule (End m) (End m) where
+instance (Abelian r, Monoidal r) => Semiring (End r)
+instance (Abelian r, Monoidal r) => Rig (End r)
+instance (Abelian r, Group r) => Ring (End r)
+instance (Monoidal m, Abelian m) => LeftModule (End m) (End m) where
   End f .* End g = End (f . g)
-instance (AdditiveMonoid m, Abelian m) => RightModule (End m) (End m) where
+instance (Monoidal m, Abelian m) => RightModule (End m) (End m) where
   End f *. End g = End (f . g)
 instance LeftModule r m => LeftModule r (End m) where
   r .* End f = End (\e -> r .* f e)
 instance RightModule r m => RightModule r (End m) where
   End f *. r = End (\e -> f e *. r)
 
+-- TODO: Involutive? Invertible?
 -- instance SimpleAdditiveAbelianGroup r => DivisionRing (End r) where
 
 -- ring isomorphism from r to the endomorphism ring of r.
@@ -58,3 +54,11 @@
 -- ring isomorphism from the endormorphism ring of r to r.
 fromEnd :: Unital r => End r -> r
 fromEnd (End f) = f one
+
+-- the frobenius ring endomorphism (assuming the characteristic is prime)
+frobenius :: Characteristic r => End r
+frobenius = End $ \r -> r `pow` char (ofRing r)
+
+ofRing :: r -> Proxy r
+ofRing _ = Proxy
+
diff --git a/Numeric/Ring/Opposite.hs b/Numeric/Ring/Opposite.hs
--- a/Numeric/Ring/Opposite.hs
+++ b/Numeric/Ring/Opposite.hs
@@ -8,14 +8,7 @@
 import Data.Semigroup.Foldable
 import Data.Semigroup.Traversable
 import Data.Traversable
-import Numeric.Addition
-import Numeric.Multiplication
-import Numeric.Module
-import Numeric.Band.Class
-import Numeric.Semiring.Class
-import Numeric.Rig.Class
-import Numeric.Rng.Class
-import Numeric.Ring.Class
+import Numeric.Algebra
 import Numeric.Decidable.Associates
 import Numeric.Decidable.Units
 import Numeric.Decidable.Zero
@@ -41,7 +34,7 @@
   Opposite a + Opposite b = Opposite (a + b)
   replicate1p n (Opposite a) = Opposite (replicate1p n a)
   sumWith1 f = Opposite . sumWith1 (runOpposite . f)
-instance AdditiveMonoid r => AdditiveMonoid (Opposite r) where
+instance Monoidal r => Monoidal (Opposite r) where
   zero = Opposite zero
   replicate n (Opposite a) = Opposite (replicate n a)
   sumWith f = Opposite . sumWith (runOpposite . f)
@@ -53,7 +46,7 @@
   Opposite s *. r = Opposite (r .* s)
 instance Semiring r => RightModule (Opposite r) (Opposite r) where
   (*.) = (*)
-instance AdditiveGroup r => AdditiveGroup (Opposite r) where
+instance Group r => Group (Opposite r) where
   negate = Opposite . negate . runOpposite
   Opposite a - Opposite b = Opposite (a - b)
   subtract (Opposite a) (Opposite b) = Opposite (subtract a b)
@@ -74,12 +67,11 @@
 instance Unital r => Unital (Opposite r) where
   one = Opposite one
   pow (Opposite a) n = Opposite (pow a n)
-instance MultiplicativeGroup r => MultiplicativeGroup (Opposite r) where
+instance Division r => Division (Opposite r) where
   recip = Opposite . recip . runOpposite
   Opposite a / Opposite b = Opposite (b \\ a)
   Opposite a \\ Opposite b = Opposite (b / a)
   Opposite a ^ n = Opposite (a ^ n)
 instance Semiring r => Semiring (Opposite r)
-instance Rng r => Rng (Opposite r)
 instance Rig r => Rig (Opposite r)
 instance Ring r => Ring (Opposite r)
diff --git a/Numeric/Ring/Rng.hs b/Numeric/Ring/Rng.hs
--- a/Numeric/Ring/Rng.hs
+++ b/Numeric/Ring/Rng.hs
@@ -5,14 +5,7 @@
   , liftRngHom
   ) where
 
-import Numeric.Addition
-import Numeric.Module
-import Numeric.Natural.Internal
-import Numeric.Multiplication
-import Numeric.Rig.Class
-import Numeric.Rng.Class
-import Numeric.Ring.Class
-import Numeric.Semiring.Class
+import Numeric.Algebra
 import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)
 
 -- | The free Ring given a Rng obtained by adjoining Z, such that
@@ -28,23 +21,23 @@
 
 instance Abelian r => Abelian (RngRing r)
 
-instance (Abelian r, AdditiveMonoid r) => LeftModule Natural (RngRing r) where
+instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where
   n .* RngRing m a = RngRing (toInteger n * m) (replicate n a)
 
-instance (Abelian r, AdditiveMonoid r) => RightModule Natural (RngRing r) where
+instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where
   RngRing m a *. n = RngRing (toInteger n * m) (replicate n a)
 
-instance (Abelian r, AdditiveMonoid r) => AdditiveMonoid (RngRing r) where
+instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where
   zero = RngRing 0 zero
   replicate n (RngRing m a) = RngRing (toInteger n * m) (replicate n a)
 
-instance (Abelian r, AdditiveGroup r) => LeftModule Integer (RngRing r) where
+instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where
   n .* RngRing m a = RngRing (toInteger n * m) (times n a)
 
-instance (Abelian r, AdditiveGroup r) => RightModule Integer (RngRing r) where
+instance (Abelian r, Group r) => RightModule Integer (RngRing r) where
   RngRing m a *. n = RngRing (toInteger n * m) (times n a)
 
-instance (Abelian r, AdditiveGroup r) => AdditiveGroup (RngRing r) where
+instance (Abelian r, Group r) => Group (RngRing r) where
   RngRing n a - RngRing m b = RngRing (n - m) (a - b)
   negate (RngRing n a) = RngRing (negate n) (negate a)
   subtract (RngRing n a) (RngRing m b) = RngRing (subtract n m) (subtract a b)
@@ -64,12 +57,10 @@
 instance Rng r => Unital (RngRing r) where
   one = RngRing 1 zero
 
-instance (Rng r, MultiplicativeGroup r) => MultiplicativeGroup (RngRing r) where
+instance (Rng r, Division r) => Division (RngRing r) where
   RngRing n a / RngRing m b = RngRing 0 $ (times n one + a) / (times m one + b)
 
 instance Rng r => Semiring (RngRing r) 
-
-instance Rng r => Rng (RngRing r)
 
 instance Rng r => Rig (RngRing r)
 
diff --git a/Numeric/Rng.hs b/Numeric/Rng.hs
deleted file mode 100644
--- a/Numeric/Rng.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Numeric.Rng
-  ( module Numeric.Group.Additive
-  , module Numeric.Semiring
-  , module Numeric.Rng.Class
-  , module Numeric.Rng.Zero
-  ) where
-
-import Numeric.Group.Additive
-import Numeric.Semiring
-import Numeric.Rng.Class
-import Numeric.Rng.Zero
diff --git a/Numeric/Rng/Class.hs b/Numeric/Rng/Class.hs
--- a/Numeric/Rng/Class.hs
+++ b/Numeric/Rng/Class.hs
@@ -1,28 +1,12 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module Numeric.Rng.Class
   ( Rng
   ) where
 
-import Numeric.Group.Additive
-import Numeric.Semiring
-import Data.Int
-import Data.Word
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
 
 -- | A Ring without an /i/dentity.
 
-class (AdditiveGroup r, Semiring r) => Rng r where
-instance Rng Integer
-instance Rng Int
-instance Rng Int8
-instance Rng Int16
-instance Rng Int32
-instance Rng Int64
-instance Rng Word
-instance Rng Word8
-instance Rng Word16
-instance Rng Word32
-instance Rng Word64
-instance Rng ()
-instance (Rng a, Rng b) => Rng (a, b)
-instance (Rng a, Rng b, Rng c) => Rng (a, b, c)
-instance (Rng a, Rng b, Rng c, Rng d) => Rng (a, b, c, d)
-instance (Rng a, Rng b, Rng c, Rng d, Rng e) => Rng (a, b, c, d, e)
+class (Group r, Semiring r) => Rng r
+instance (Group r, Semiring r) => Rng r
diff --git a/Numeric/Rng/Zero.hs b/Numeric/Rng/Zero.hs
--- a/Numeric/Rng/Zero.hs
+++ b/Numeric/Rng/Zero.hs
@@ -3,12 +3,7 @@
   ( ZeroRng(..)
   ) where
 
-import Numeric.Addition
-import Numeric.Multiplication
-import Numeric.Module
-import Numeric.Semiring.Class
-import Numeric.Rng.Class
-import Numeric.Natural.Internal
+import Numeric.Algebra
 import Data.Foldable (toList)
 import Prelude hiding ((+),(-),negate,subtract,replicate)
 
@@ -29,32 +24,32 @@
 
 instance Abelian r => Abelian (ZeroRng r)
 
-instance AdditiveMonoid r => AdditiveMonoid (ZeroRng r) where
+instance Monoidal r => Monoidal (ZeroRng r) where
   zero = ZeroRng zero
   sumWith f = ZeroRng . sumWith (runZeroRng . f)
   replicate n (ZeroRng a) = ZeroRng (replicate n a)
   
-instance AdditiveGroup r => AdditiveGroup (ZeroRng r) where
+instance Group r => Group (ZeroRng r) where
   ZeroRng a - ZeroRng b = ZeroRng (a - b)
   negate (ZeroRng a) = ZeroRng (negate a)
   subtract (ZeroRng a) (ZeroRng b) = ZeroRng (subtract a b)
   times n (ZeroRng a) = ZeroRng (times n a)
 
-instance AdditiveMonoid r => Multiplicative (ZeroRng r) where
+instance Monoidal r => Multiplicative (ZeroRng r) where
   _ * _ = zero
   productWith1 f as = case toList as of
     [] -> error "productWith1: empty Foldable1"
     [a] -> f a
     _   -> zero
 
-instance (AdditiveMonoid r, Abelian r) => Semiring (ZeroRng r)
-instance AdditiveMonoid r => Commutative (ZeroRng r)
-instance (AdditiveGroup r, Abelian r) => Rng (ZeroRng r)
-instance AdditiveMonoid r => LeftModule Natural (ZeroRng r) where
+instance (Monoidal r, Abelian r) => Semiring (ZeroRng r)
+instance Monoidal r => Commutative (ZeroRng r)
+instance (Group r, Abelian r) => Rng (ZeroRng r)
+instance Monoidal r => LeftModule Natural (ZeroRng r) where
   (.*) = replicate
-instance AdditiveMonoid r => RightModule Natural (ZeroRng r) where
+instance Monoidal r => RightModule Natural (ZeroRng r) where
   m *. n = replicate n m
-instance AdditiveGroup r => LeftModule Integer (ZeroRng r) where
+instance Group r => LeftModule Integer (ZeroRng r) where
   (.*) = times
-instance AdditiveGroup r => RightModule Integer (ZeroRng r) where
+instance Group r => RightModule Integer (ZeroRng r) where
   m *. n = times n m
diff --git a/Numeric/Semigroup.hs b/Numeric/Semigroup.hs
deleted file mode 100644
--- a/Numeric/Semigroup.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Numeric.Semigroup
-  ( module Numeric.Semigroup.Additive
-  , module Numeric.Semigroup.Multiplicative
-  , module Numeric.Addition.Abelian
-  , module Numeric.Addition.Idempotent
-  , module Numeric.Order.Additive
-  , module Numeric.Band
-  , module Numeric.Multiplication.Commutative
-  , module Numeric.Multiplication.Involutive
-  ) where
-
-import Numeric.Semigroup.Additive
-import Numeric.Semigroup.Multiplicative
-import Numeric.Addition.Abelian
-import Numeric.Addition.Idempotent
-import Numeric.Order.Additive
-import Numeric.Band
-import Numeric.Multiplication.Commutative
-import Numeric.Multiplication.Involutive
diff --git a/Numeric/Semigroup/Additive.hs b/Numeric/Semigroup/Additive.hs
deleted file mode 100644
--- a/Numeric/Semigroup/Additive.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-module Numeric.Semigroup.Additive
-  ( 
-  -- * Additive Semigroups
-    Additive(..)
-  , sum1
-  ) where
-
-import qualified Prelude
-import Prelude hiding ((+), replicate)
-import Data.Int
-import Data.Word
-import Data.Semigroup.Foldable
-import Data.Foldable
-import Numeric.Natural.Internal
-
-infixl 6 +
-
--- | 
--- > (a + b) + c = a + (b + c)
--- > replicate 1 a = a
--- > replicate (2 * n) a = replicate n a + replicate n a
--- > replicate (2 * n + 1) a = replicate n a + replicate n a + a
-class Additive r where
-  (+) :: r -> r -> r
-
-  -- | replicate1p n r = replicate (1 + n) r
-  replicate1p :: Whole n => n -> r -> r
-  replicate1p y0 x0 = f x0 (1 Prelude.+ y0)
-    where
-      f x y
-        | even y = f (x + x) (y `quot` 2)
-        | y == 1 = x
-        | otherwise = g (x + x) (unsafePred y  `quot` 2) x
-      g x y z
-        | even y = g (x + x) (y `quot` 2) z
-        | y == 1 = x + z
-        | otherwise = g (x + x) (unsafePred y `quot` 2) (x + z)
-
-  sumWith1 :: Foldable1 f => (a -> r) -> f a -> r
-  sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing
-     where mf Nothing y = Just $! f y 
-           mf (Just x) y = Just $! x + f y
-
-sum1 :: (Foldable1 f, Additive r) => f r -> r
-sum1 = sumWith1 id
-
-instance Additive r => Additive (b -> r) where
-  f + g = \e -> f e + g e 
-  replicate1p n f e = replicate1p n (f e)
-  sumWith1 f xs e = sumWith1 (`f` e) xs
-
-instance Additive Bool where
-  (+) = (||)
-  replicate1p _ a = a
-
-instance Additive Natural where
-  (+) = (Prelude.+)
-  replicate1p n r = (1 Prelude.+ toNatural n) * r
-
-instance Additive Integer where 
-  (+) = (Prelude.+)
-  replicate1p n r = (1 Prelude.+ toInteger n) * r
-
-instance Additive Int where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int8 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int16 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int32 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int64 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word8 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word16 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word32 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word64 where
-  (+) = (Prelude.+)
-  replicate1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive () where
-  _ + _ = ()
-  replicate1p _ _ = () 
-  sumWith1 _ _ = ()
-
-instance (Additive a, Additive b) => Additive (a,b) where
-  (a,b) + (i,j) = (a + i, b + j)
-  replicate1p n (a,b) = (replicate1p n a, replicate1p n b)
-
-instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where
-  (a,b,c) + (i,j,k) = (a + i, b + j, c + k)
-  replicate1p n (a,b,c) = (replicate1p n a, replicate1p n b, replicate1p n c)
-
-instance (Additive a, Additive b, Additive c, Additive d) => Additive (a,b,c,d) where
-  (a,b,c,d) + (i,j,k,l) = (a + i, b + j, c + k, d + l)
-  replicate1p n (a,b,c,d) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d)
-
-instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a,b,c,d,e) where
-  (a,b,c,d,e) + (i,j,k,l,m) = (a + i, b + j, c + k, d + l, e + m)
-  replicate1p n (a,b,c,d,e) = (replicate1p n a, replicate1p n b, replicate1p n c, replicate1p n d, replicate1p n e)
diff --git a/Numeric/Semigroup/Multiplicative.hs b/Numeric/Semigroup/Multiplicative.hs
deleted file mode 100644
--- a/Numeric/Semigroup/Multiplicative.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Numeric.Semigroup.Multiplicative
-  ( Multiplicative(..)
-  , pow1pIntegral
-  , product1
-  ) where
-
-import Numeric.Semiring.Internal
diff --git a/Numeric/Semiring.hs b/Numeric/Semiring.hs
deleted file mode 100644
--- a/Numeric/Semiring.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Semiring
-  ( module Numeric.Semiring.Class
-  , module Numeric.Semiring.Integral
-  , module Numeric.Semiring.Involutive
-  ) where
-
-import Numeric.Semiring.Class
-import Numeric.Semiring.Integral
-import Numeric.Semiring.Involutive
diff --git a/Numeric/Semiring/Class.hs b/Numeric/Semiring/Class.hs
deleted file mode 100644
--- a/Numeric/Semiring/Class.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Numeric.Semiring.Class
-  ( Semiring
-  ) where
-
-import Numeric.Semiring.Internal
diff --git a/Numeric/Semiring/Integral.hs b/Numeric/Semiring/Integral.hs
--- a/Numeric/Semiring/Integral.hs
+++ b/Numeric/Semiring/Integral.hs
@@ -2,12 +2,13 @@
   ( IntegralSemiring
   ) where
 
-import Numeric.Semiring.Class
-import Numeric.Monoid.Additive
+import Numeric.Algebra.Class
 import Numeric.Natural.Internal
 
--- a * b = 0 implies a == 0 || b == 0
-class (AdditiveMonoid r, Semiring r) => IntegralSemiring r
+-- | An integral semiring has no zero divisors
+--
+-- > a * b = 0 implies a == 0 || b == 0
+class (Monoidal r, Semiring r) => IntegralSemiring r
 
 instance IntegralSemiring Integer
 instance IntegralSemiring Natural
diff --git a/Numeric/Semiring/Internal.hs b/Numeric/Semiring/Internal.hs
deleted file mode 100644
--- a/Numeric/Semiring/Internal.hs
+++ /dev/null
@@ -1,202 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
--- This package is an unfortunate ball of mud forced on me by mutual dependencies
-module Numeric.Semiring.Internal
-  ( 
-  -- * Multiplicative Semigroups
-    Multiplicative(..)
-  , pow1pIntegral
-  , product1
-  -- * Semirings
-  , Semiring
-  -- * Associative algebras of free semigroups over semirings
-  , FreeAlgebra(..)
-  ) where
-
-import Data.Foldable hiding (sum, concat)
-import Data.Semigroup.Foldable
-import Data.Int
-import Data.Sequence hiding (reverse)
-import qualified Data.Sequence as Seq
-import Data.Word
-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)
-import qualified Prelude
-import Numeric.Natural.Internal
-import Numeric.Semigroup.Additive
-import Numeric.Addition.Abelian
-
-infixr 8 `pow1p`
-infixl 7 *
-
--- | A multiplicative semigroup
-class Multiplicative r where
-  (*) :: r -> r -> r 
-
-  -- pow1p x n = pow x (1 + n)
-  pow1p :: Whole n => r -> n -> r
-  pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where
-    f x y 
-      | even y = f (x * x) (y `quot` 2)
-      | y == 1 = x
-      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x
-    g x y z 
-      | even y = g (x * x) (y `quot` 2) z
-      | y == 1 = x * z
-      | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)
-
-  productWith1 :: Foldable1 f => (a -> r) -> f a -> r
-  productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing
-    where 
-      mf Nothing y = Just $! f y
-      mf (Just x) y = Just $! x * f y
-
-product1 :: (Foldable1 f, Multiplicative r) => f r -> r
-product1 = productWith1 id
-
-pow1pIntegral :: (Integral r, Integral n) => r -> n -> r
-pow1pIntegral r n = r ^ (1 Prelude.+ n)
-
-instance Multiplicative Bool where
-  (*) = (&&)
-  pow1p m _ = m
-
-instance Multiplicative Natural where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Integer where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Int where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Int8 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Int16 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Int32 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Int64 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Word where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Word8 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Word16 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Word32 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative Word64 where
-  (*) = (Prelude.*)
-  pow1p = pow1pIntegral
-
-instance Multiplicative () where
-  _ * _ = ()
-  pow1p _ _ = ()
-
-instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where
-  (a,b) * (c,d) = (a * c, b * d)
-
-instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where
-  (a,b,c) * (i,j,k) = (a * i, b * j, c * k)
-
-instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where
-  (a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)
-
-instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d, Multiplicative e) => Multiplicative (a,b,c,d,e) where
-  (a,b,c,d,e) * (i,j,k,l,m) = (a * i, b * j, c * k, d * l, e * m)
-
--- | A pair of an additive abelian semigroup, and a multiplicative semigroup, with the distributive laws:
--- 
--- > a(b + c) = ab + ac
--- > (a + b)c = ac + bc
---
--- Common notation includes the laws for additive and multiplicative identity in semiring.
---
--- If you want that, look at 'Rig' instead.
---
--- Ideally we'd use the cyclic definition:
---
--- > class (LeftModule r r, RightModule r r, Additive r, Abelian r, Multiplicative r) => Semiring r
---
--- to enforce that every semiring r is an r-module over itself, but Haskell doesn't like that.
-class (Additive r, Abelian r, Multiplicative r) => Semiring r
-
-instance Semiring Integer
-instance Semiring Natural
-instance Semiring Bool
-instance Semiring Int
-instance Semiring Int8
-instance Semiring Int16
-instance Semiring Int32
-instance Semiring Int64
-instance Semiring Word
-instance Semiring Word8
-instance Semiring Word16
-instance Semiring Word32
-instance Semiring Word64
-instance Semiring ()
-instance (Semiring a, Semiring b) => Semiring (a, b)
-instance (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c)
-instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d)
-instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e)
-
--- | An associative algebra built with a free module over a semiring
-class Semiring r => FreeAlgebra r a where
-  join :: (a -> a -> r) -> a -> r
-
-instance FreeAlgebra r a => Multiplicative (a -> r) where
-  f * g = join $ \a b -> f a * g b
-
-instance FreeAlgebra r a => Semiring (a -> r) 
-
-  
-instance FreeAlgebra () a where
-  join _ _ = ()
-
--- | The tensor algebra
-instance Semiring r => FreeAlgebra r [a] where
-  join f = go [] where
-    go ls rrs@(r:rs) = f (reverse ls) rrs + go (r:ls) rs
-    go ls [] = f (reverse ls) []
-
--- | The tensor algebra
-instance Semiring r => FreeAlgebra r (Seq a) where
-  join f = go Seq.empty where
-    go ls s = case viewl s of
-       EmptyL -> f ls s 
-       r :< rs -> f ls s + go (ls |> r) rs
-
-instance (FreeAlgebra r a, FreeAlgebra r b) => FreeAlgebra r (a,b) where
-  join f (a,b) = join (\a1 a2 -> join (\b1 b2 -> f (a1,b1) (a2,b2)) b) a
-
-instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c) => FreeAlgebra r (a,b,c) where
-  join f (a,b,c) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a
-
-instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d) => FreeAlgebra r (a,b,c,d) where
-  join f (a,b,c,d) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a
-
-instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d, FreeAlgebra r e) => FreeAlgebra r (a,b,c,d,e) where
-  join f (a,b,c,d,e) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> join (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a
-
--- TODO: check this
-instance (FreeAlgebra r b, FreeAlgebra r a) => FreeAlgebra (b -> r) a where
-  join f a b = join (\a1 a2 -> f a1 a2 b) a
-
diff --git a/Numeric/Semiring/Involutive.hs b/Numeric/Semiring/Involutive.hs
--- a/Numeric/Semiring/Involutive.hs
+++ b/Numeric/Semiring/Involutive.hs
@@ -1,32 +1,5 @@
-module Numeric.Semiring.Involutive
-  ( Involutive 
+module Numeric.Semiring.Involutive 
+  ( InvolutiveSemiring
   ) where
 
-import Data.Int
-import Data.Word
-import Numeric.Natural
-import Numeric.Multiplication.Involutive
-import Numeric.Rig.Class
-
--- | adjoint (x + y) = adjoint x + adjoint y
-class (Rig r, InvolutiveMultiplication r) => Involutive r
-
-instance Involutive Integer
-instance Involutive Int
-instance Involutive Int8
-instance Involutive Int16
-instance Involutive Int32
-instance Involutive Int64
-
-instance Involutive Natural
-instance Involutive Word
-instance Involutive Word8
-instance Involutive Word16
-instance Involutive Word32
-instance Involutive Word64
-
-instance Involutive ()
-instance (Involutive a, Involutive b) => Involutive (a, b)
-instance (Involutive a, Involutive b, Involutive c) => Involutive (a, b, c)
-instance (Involutive a, Involutive b, Involutive c, Involutive d) => Involutive (a, b, c, d)
-instance (Involutive a, Involutive b, Involutive c, Involutive d, Involutive e) => Involutive (a, b, c, d, e)
+import Numeric.Algebra.Involutive
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
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.4.0
+version:       0.5.0
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -19,78 +19,66 @@
 
 library
   build-depends: 
+    array >= 0.3.0.2 && < 0.4,
     base >= 4 && < 4.4,
+    distributive >= 0.2 && < 0.3,
     transformers >= 0.2.0 && < 0.3,
     tagged >= 0.2.2 && < 0.3,
     categories >= 0.58.0 && < 0.59,
     containers >= 0.3.0.0 && < 0.5,
+    keys >= 1.8 && < 1.9,
     mtl >= 2.0 && < 2.1,
     semigroups >= 0.5 && < 0.6,
     semigroupoids >= 1.2.2 && < 1.3,
-    reflection >= 0.4 && < 0.5,
-    representable-tries >= 1.8 && < 1.9,
+    representable-functors >= 1.8 && < 1.9,
+    representable-tries >= 1.8.1 && < 1.9,
     void >= 0.5.4 && < 0.6
 
+-- reflection >= 0.4 && < 0.5,
   exposed-modules:
-    Numeric.Addition
-    Numeric.Addition.Abelian
-    Numeric.Addition.Partitionable
-    Numeric.Addition.Idempotent
-    Numeric.Algebra.Free
-    Numeric.Algebra.Free.Class
-    Numeric.Algebra.Free.Unital
-    Numeric.Algebra.Free.Hopf
-    Numeric.Band
+    Numeric.Algebra
     Numeric.Band.Rectangular
-    Numeric.Band.Class
-    Numeric.Decidable.Zero
-    Numeric.Decidable.Units
-    Numeric.Decidable.Associates
+    Numeric.Covector
     Numeric.Exp
-    Numeric.Functional.Linear
-    Numeric.Functional.Antilinear
-    Numeric.Group
-    Numeric.Group.Additive
-    Numeric.Group.Multiplicative
-    Numeric.Module
-    Numeric.Monoid
-    Numeric.Monoid.Additive
-    Numeric.Monoid.Multiplicative
     Numeric.Log
-    Numeric.Module.Class
-    Numeric.Multiplication
-    Numeric.Multiplication.Commutative
-    Numeric.Multiplication.Involutive
-    Numeric.Multiplication.Factorable
-    Numeric.Map.Linear
-    Numeric.Natural
+    Numeric.Map
+    Numeric.Module.Complex
+    Numeric.Module.Quaternion
     Numeric.Natural.Internal
-    Numeric.Order
-    Numeric.Order.Additive
-    Numeric.Order.Class
-    Numeric.Polynomial.Basis.Power
-    Numeric.Rig
-    Numeric.Rig.Class
-    Numeric.Rig.Ordered
-    Numeric.Rig.Characteristic
-    Numeric.Rng
-    Numeric.Rng.Class
     Numeric.Rng.Zero
-    Numeric.Ring
-    Numeric.Ring.Class
     Numeric.Ring.Rng
     Numeric.Ring.Opposite
     Numeric.Ring.Endomorphism
-    Numeric.Semigroup
-    Numeric.Semigroup.Additive
-    Numeric.Semigroup.Multiplicative
-    Numeric.Semiring
-    Numeric.Semiring.Class
-    Numeric.Semiring.Integral
-    Numeric.Semiring.Involutive
+    Numeric.Algebra.Geometric
 
   other-modules:
-    Numeric.Semiring.Internal
-    Numeric.Monoid.Multiplicative.Internal
+    Numeric.Additive.Class
+    Numeric.Additive.Group
+    Numeric.Algebra.Class
+    Numeric.Algebra.Involutive
+    Numeric.Algebra.Idempotent
+    Numeric.Algebra.Division
+    Numeric.Algebra.Unital
+    Numeric.Algebra.Commutative
+    Numeric.Algebra.Factorable
+    Numeric.Algebra.Hopf
+    Numeric.Natural
+    Numeric.Decidable.Zero
+    Numeric.Decidable.Units
+    Numeric.Decidable.Associates
+    Numeric.Module.Class
+    Numeric.Module.Representable
+    Numeric.Semiring.Integral
+    Numeric.Semiring.Involutive
+    Numeric.Band.Class
+    Numeric.Dioid.Class
+    Numeric.Quadrance.Class
+    Numeric.Rig.Class
+    Numeric.Rng.Class
+    Numeric.Ring.Class
+    Numeric.Rig.Ordered
+    Numeric.Rig.Characteristic
+    Numeric.Order.Class
+    Numeric.Order.Additive
 
   ghc-options: -Wall