diff --git a/Numeric/Additive/Class.hs b/Numeric/Additive/Class.hs
deleted file mode 100644
--- a/Numeric/Additive/Class.hs
+++ /dev/null
@@ -1,226 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module Numeric.Additive.Class
-  ( 
-  -- * Additive Semigroups
-    Additive(..)
-  , sum1
-  -- * Additive Abelian semigroups
-  , Abelian
-  -- * Additive Monoids
-  , Idempotent
-  , sinnum1pIdempotent
-  -- * Partitionable semigroups
-  , Partitionable(..)
-  ) where
-
-import Data.Int
-import Data.Word
-import Data.Foldable hiding (concat)
-import Data.Semigroup.Foldable
-import Data.Key
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
--- import Data.Foldable hiding (concat)
-import Numeric.Natural.Internal
-import Prelude (fmap,(-),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)
--- > sinnum 1 a = a
--- > sinnum (2 * n) a = sinnum n a + sinnum n a
--- > sinnum (2 * n + 1) a = sinnum n a + sinnum n a + a
-class Additive r where
-  (+) :: r -> r -> r
-
-  -- | sinnum1p n r = sinnum (1 + n) r
-  sinnum1p :: Whole n => n -> r -> r
-  sinnum1p 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 
-  sinnum1p n f e = sinnum1p n (f e)
-  sumWith1 f xs e = sumWith1 (`f` e) xs
-
-instance (HasTrie b, Additive r) => Additive (b :->: r) where
-  (+) = zipWith (+)
-  sinnum1p = fmap . sinnum1p
-  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs
-
-instance Additive Bool where
-  (+) = (||)
-  sinnum1p _ a = a
-
-instance Additive Natural where
-  (+) = (Prelude.+)
-  sinnum1p n r = (1 Prelude.+ toNatural n) * r
-
-instance Additive Integer where 
-  (+) = (Prelude.+)
-  sinnum1p n r = (1 Prelude.+ toInteger n) * r
-
-instance Additive Int where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int8 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int16 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int32 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Int64 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word8 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word16 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word32 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive Word64 where
-  (+) = (Prelude.+)
-  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
-
-instance Additive () where
-  _ + _ = ()
-  sinnum1p _ _ = () 
-  sumWith1 _ _ = ()
-
-instance (Additive a, Additive b) => Additive (a,b) where
-  (a,b) + (i,j) = (a + i, b + j)
-  sinnum1p n (a,b) = (sinnum1p n a, sinnum1p 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)
-  sinnum1p n (a,b,c) = (sinnum1p n a, sinnum1p n b, sinnum1p 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)
-  sinnum1p n (a,b,c,d) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p 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)
-  sinnum1p n (a,b,c,d,e) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p n d, sinnum1p 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 (HasTrie e, 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
-
-sinnum1pIdempotent :: Natural -> r -> r
-sinnum1pIdempotent _ r = r
-
-instance Idempotent ()
-instance Idempotent Bool
-instance Idempotent r => Idempotent (e -> r)
-instance (HasTrie e, 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
deleted file mode 100644
--- a/Numeric/Additive/Group.hs
+++ /dev/null
@@ -1,149 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeOperators #-}
-module Numeric.Additive.Group
-  ( -- * Additive Groups
-    Group(..)
-  ) where
-
-import Data.Int
-import Data.Word
-import Data.Key
-import Data.Functor.Representable.Trie
-import Prelude hiding ((*), (+), (-), negate, subtract,zipWith)
-import qualified Prelude
-import Numeric.Additive.Class
-import Numeric.Algebra.Class
-
-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 (HasTrie e, Group r) => Group (e :->: r) where
-  (-) = zipWith (-)
-  negate = fmap negate
-  subtract = zipWith subtract
-  times = fmap . times
-
-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
deleted file mode 100644
--- a/Numeric/Algebra.hs
+++ /dev/null
@@ -1,171 +0,0 @@
-module Numeric.Algebra
-  ( 
-  -- * Additive
-
-  -- ** additive semigroups
-    Additive(..)
-  , sum1
-  -- ** additive Abelian semigroups
-  , Abelian
-  -- ** additive idempotent semigroups
-  , Idempotent
-  , sinnum1pIdempotent
-  , sinnumIdempotent
-  -- ** 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(..)
-  -- ** Division Rings
-  , LocalRing
-  , DivisionRing
-  , Field
-
-  -- * 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
-  , CocommutativeCoalgebra
-  -- ** division algebras
-  , DivisionAlgebra(..)
-  -- ** Hopf alegebras
-  , HopfAlgebra(..)
-
-  -- * Ring Properties
-  -- ** Characteristic
-  , Characteristic(..)
-  , charInt, charWord
-  -- ** Order
-  , Order(..)
-  , OrderedRig
-  , AdditiveOrder
-  , LocallyFiniteOrder
-
-  , DecidableZero
-  , DecidableUnits
-  , DecidableAssociates
-
-  -- * Natural numbers
-  , Natural
-  , Whole(toNatural)
-
-  -- * Representable Additive
-  , addRep, sinnum1pRep
-  -- * Representable Monoidal
-  , zeroRep, sinnumRep
-  -- * 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.Order.LocallyFinite
-import Numeric.Quadrance.Class
-import Numeric.Rig.Class
-import Numeric.Rig.Characteristic
-import Numeric.Rig.Ordered
-import Numeric.Rng.Class
-import Numeric.Ring.Class
-import Numeric.Ring.Local
-import Numeric.Ring.Division
-import Numeric.Field.Class
diff --git a/Numeric/Algebra/Class.hs b/Numeric/Algebra/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Class.hs
+++ /dev/null
@@ -1,600 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}
-module Numeric.Algebra.Class 
-  (
-  -- * Multiplicative Semigroups
-    Multiplicative(..)
-  , pow1pIntegral
-  , product1
-  -- * Semirings
-  , Semiring
-  -- * Left and Right Modules
-  , LeftModule(..)
-  , RightModule(..)
-  , Module
-  -- * Additive Monoids
-  , Monoidal(..)
-  , sum
-  , sinnumIdempotent
-  -- * Associative algebras
-  , Algebra(..)
-  -- * Coassociative coalgebras
-  , Coalgebra(..)
-  ) where
-
-import Control.Applicative
-import Data.Foldable hiding (sum, concat)
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Int
-import Data.IntMap (IntMap)
-import Data.IntSet (IntSet)
-import Data.Key
-import Data.Map (Map)
-import Data.Monoid (mappend)
--- import Data.Semigroup.Foldable
-import Data.Sequence hiding (reverse,index)
-import Data.Semigroup.Foldable
-import Data.Set (Set)
-import Data.Word
-import Numeric.Additive.Class
-import Numeric.Natural.Internal
-import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)
-import qualified Data.IntMap as IntMap
-import qualified Data.IntSet as IntSet
-import qualified Data.Map as Map
-import qualified Data.Sequence as Seq
-import qualified Data.Set as Set
-import qualified Prelude
-
-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)
-
-instance Algebra r a => Multiplicative (a -> r) where
-  f * g = mult $ \a b -> f a * g b
-instance (HasTrie a, Algebra r a) => Multiplicative (a :->: r) where
-  f * g = tabulate $ mult $ \a b -> index f a * index g b
-
--- | 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)
-instance Algebra r a => Semiring (a -> r) 
-instance (HasTrie a, Algebra r a) => Semiring (a :->: r) 
-
--- | 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
-
--- 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)
-
-instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where
-  comult k f g = k (f * g)
-
--- instance Coalgebra () c where comult _ _ _ = ()
--- 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 (HasTrie e, LeftModule r m) => LeftModule r (e :->: m) where 
-  (.*) m f = tabulate $ \e -> m .* index 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 (HasTrie e, RightModule r m) => RightModule r (e :->: m) where 
-  (*.) f m = tabulate $ \e -> index 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
-
-  sinnum :: Whole n => n -> m -> m
-  sinnum 0 _  = zero
-  sinnum 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
-
-sinnumIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r
-sinnumIdempotent 0 _ = zero
-sinnumIdempotent _ x = x
-
-instance Monoidal Bool where 
-  zero = False
-  sinnum 0 _ = False
-  sinnum _ r = r
-
-instance Monoidal Natural where
-  zero = 0
-  sinnum n r = toNatural n * r
-
-instance Monoidal Integer where 
-  zero = 0
-  sinnum n r = toInteger n * r
-
-instance Monoidal Int where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Int8 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Int16 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Int32 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Int64 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Word where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Word8 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Word16 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Word32 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal Word64 where 
-  zero = 0
-  sinnum n r = fromIntegral n * r
-
-instance Monoidal r => Monoidal (e -> r) where
-  zero = const zero
-  sumWith f xs e = sumWith (`f` e) xs
-  sinnum n r e = sinnum n (r e)
-
-instance (HasTrie e, Monoidal r) => Monoidal (e :->: r) where
-  zero = pure zero
-  sumWith f xs = tabulate $ \e -> sumWith (\a -> index (f a) e) xs
-  sinnum n r = tabulate $ sinnum n . index r
-
-instance Monoidal () where 
-  zero = ()
-  sinnum _ () = ()
-  sumWith _ _ = ()
-
-instance (Monoidal a, Monoidal b) => Monoidal (a,b) where
-  zero = (zero,zero)
-  sinnum n (a,b) = (sinnum n a, sinnum n b)
-
-instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where
-  zero = (zero,zero,zero)
-  sinnum n (a,b,c) = (sinnum n a, sinnum n b, sinnum n c)
-
-instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where
-  zero = (zero,zero,zero,zero)
-  sinnum n (a,b,c,d) = (sinnum n a, sinnum n b, sinnum n c, sinnum 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)
-  sinnum n (a,b,c,d,e) = (sinnum n a, sinnum n b, sinnum n c, sinnum n d, sinnum n e)
-
diff --git a/Numeric/Algebra/Commutative.hs b/Numeric/Algebra/Commutative.hs
deleted file mode 100644
--- a/Numeric/Algebra/Commutative.hs
+++ /dev/null
@@ -1,187 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, TypeOperators #-}
-module Numeric.Algebra.Commutative 
-  ( Commutative
-  , CommutativeAlgebra
-  , CocommutativeCoalgebra
-  , CommutativeBialgebra
-  ) where
-
-import Data.Functor.Representable.Trie
-import Data.Int
-import Data.IntSet (IntSet)
-import Data.IntMap (IntMap)
-import Data.Set (Set)
-import Data.Map (Map)
-import Data.Word
-import Numeric.Additive.Class
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Natural
-import Prelude (Bool, Ord, Integer)
-
-
-
--- | 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)
-
-instance CommutativeAlgebra r a => Commutative (a -> r)
-
-instance ( HasTrie a
-         , CommutativeAlgebra r a
-         ) => Commutative (a :->: r) 
-
-
-
-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)
-
-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)
-
-
-
-class Coalgebra r c => CocommutativeCoalgebra r c
-
-instance CommutativeAlgebra r m => CocommutativeCoalgebra r (m -> r)
-
-instance ( HasTrie m
-         , CommutativeAlgebra r m
-         ) => CocommutativeCoalgebra r (m :->: r)
-
-instance (Commutative r, Semiring r) => CocommutativeCoalgebra r ()
-
-instance ( CocommutativeCoalgebra r a
-         , CocommutativeCoalgebra r b
-         ) => CocommutativeCoalgebra r (a,b)
-
-instance ( CocommutativeCoalgebra r a
-         , CocommutativeCoalgebra r b
-         , CocommutativeCoalgebra r c
-         ) => CocommutativeCoalgebra r (a,b,c)
-
-instance ( CocommutativeCoalgebra r a
-         , CocommutativeCoalgebra r b
-         , CocommutativeCoalgebra r c
-         , CocommutativeCoalgebra r d
-         ) => CocommutativeCoalgebra r (a,b,c,d)
-
-instance ( CocommutativeCoalgebra r a
-         , CocommutativeCoalgebra r b
-         , CocommutativeCoalgebra r c
-         , CocommutativeCoalgebra r d
-         , CocommutativeCoalgebra r e
-         ) => CocommutativeCoalgebra r (a,b,c,d,e)
-
-instance ( Commutative r
-         , Semiring r
-         , Ord a) => CocommutativeCoalgebra r (Set a)
-
-instance ( Commutative r
-         , Semiring r
-         ) => CocommutativeCoalgebra r IntSet
-
-instance ( Commutative r
-         , Semiring r
-         , Ord a
-         , Abelian b
-         ) => CocommutativeCoalgebra r (Map a b)
-
-instance ( Commutative r
-         , Semiring r
-         , Abelian b
-         ) => CocommutativeCoalgebra r (IntMap b)
-
-
-
-class ( Bialgebra r h
-      , CommutativeAlgebra r h
-      , CocommutativeCoalgebra r h
-      ) => CommutativeBialgebra r h
-
-instance ( Bialgebra r h
-         , CommutativeAlgebra r h
-         , CocommutativeCoalgebra r h
-         ) => CommutativeBialgebra r h
diff --git a/Numeric/Algebra/Complex.hs b/Numeric/Algebra/Complex.hs
deleted file mode 100644
--- a/Numeric/Algebra/Complex.hs
+++ /dev/null
@@ -1,252 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses
-           , FlexibleInstances
-           , TypeFamilies
-           , UndecidableInstances
-           , DeriveDataTypeable
-           , TypeOperators #-}
-module Numeric.Algebra.Complex
-  ( Distinguished(..)
-  , Complicated(..)
-  , ComplexBasis(..)
-  , Complex(..)
-  , realPart
-  , imagPart
-  , uncomplicate
-  ) 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 hiding (index)
-import Data.Key
-import Data.Semigroup
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Complex.Class
-import Numeric.Algebra.Quaternion.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
-
--- complex basis
-data ComplexBasis = E | I deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Complex a = Complex a a deriving (Eq,Show,Read,Data,Typeable)
-
-realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
-realPart f = index f E 
-
-imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
-imagPart f = index f I
-
-instance Distinguished ComplexBasis where
-  e = E
-  
-instance Complicated ComplexBasis where
-  i = I
-
-instance Rig r => Distinguished (Complex r) where
-  e = Complex one zero
-
-instance Rig r => Complicated (Complex r) where
-  i = Complex zero one
-
-instance Rig r => Distinguished (ComplexBasis -> r) where
-  e E = one
-  e _ = zero
-  
-instance Rig r => Complicated (ComplexBasis -> r) where
-  i I = one
-  i _ = zero 
-
-instance Rig r => Distinguished (ComplexBasis :->: r) where
-  e = Trie e
-  
-instance Rig r => Complicated (ComplexBasis :->: r) where
-  i = Trie 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 
-  sinnum1p = sinnum1pRep
-
-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
-  sinnum = sinnumRep
-
-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
-
--- the trivial coalgebra
-instance Rng k => Coalgebra k ComplexBasis where
-  comult f E E = f E
-  comult f I I = f I
-  comult _ _ _ = zero
-
-instance Rng k => CounitalCoalgebra k ComplexBasis where
-  counit f = f E + f I
-
-instance Rng k => Bialgebra k ComplexBasis 
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where
-  inv f = f' where
-    afe = adjoint (f E)
-    nfi = negate (f I)
-    f' E = afe
-    f' I = nfi
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where
-  coinv = inv
-
-instance (InvolutiveSemiring k, 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)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Complex r) where
-  quadrance n = realPart $ adjoint n * n
-
-instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Complex r) where
-  recip q@(Complex a b) = Complex (qq \\ a) (qq \\ b)
-    where qq = quadrance q
-
--- | half of the Cayley-Dickson quaternion isomorphism 
-uncomplicate :: Hamiltonian q => ComplexBasis -> ComplexBasis -> q
-uncomplicate E E = e
-uncomplicate I E = i
-uncomplicate E I = j
-uncomplicate I I = k
-
diff --git a/Numeric/Algebra/Complex/Class.hs b/Numeric/Algebra/Complex/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Complex/Class.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Numeric.Algebra.Complex.Class
-  ( Complicated(..)
-  ) where
-
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Covector
-import Prelude (return)
-
-class Distinguished r => Complicated r where
-  i :: r
-
-instance Complicated a => Complicated (Covector r a) where
-  i = return i
diff --git a/Numeric/Algebra/Distinguished/Class.hs b/Numeric/Algebra/Distinguished/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Distinguished/Class.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Numeric.Algebra.Distinguished.Class
-  ( Distinguished(..)
-  ) where
-
-import Numeric.Covector
-
--- a basis with a distinguished point
-class Distinguished t where
-  e :: t
-
-instance Distinguished a => Distinguished (Covector r a) where
-  e = return e
diff --git a/Numeric/Algebra/Division.hs b/Numeric/Algebra/Division.hs
deleted file mode 100644
--- a/Numeric/Algebra/Division.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Algebra.Division
-  ( Division(..)
-  , DivisionAlgebra(..)
-  ) 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
-
diff --git a/Numeric/Algebra/Dual.hs b/Numeric/Algebra/Dual.hs
deleted file mode 100644
--- a/Numeric/Algebra/Dual.hs
+++ /dev/null
@@ -1,224 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Algebra.Dual
-  ( Distinguished(..)
-  , Infinitesimal(..)
-  , DualBasis(..)
-  , Dual(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Semigroup hiding (Dual)
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Dual.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
-
--- | dual number basis, D^2 = 0. D /= 0.
-data DualBasis = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Dual a = Dual a a deriving (Eq,Show,Read,Data,Typeable)
-
-instance Distinguished DualBasis where
-  e = E
-
-instance Infinitesimal DualBasis where
-  d = D
-
-instance Rig r => Distinguished (Dual r) where
-  e = Dual one zero
-
-instance Rig r => Infinitesimal (Dual r) where
-  d = Dual zero one
-  
-instance Rig r => Distinguished (DualBasis -> r) where
-  e E = one
-  e _ = zero
-
-instance Rig r => Infinitesimal (DualBasis -> r) where
-  d D = one
-  d _       = zero 
-
-type instance Key Dual = DualBasis
-
-instance Representable Dual where
-  tabulate f = Dual (f E) (f D)
-
-instance Indexable Dual where
-  index (Dual a _ ) E = a
-  index (Dual _ b ) D = b
-
-instance Lookup Dual where
-  lookup = lookupDefault
-
-instance Adjustable Dual where
-  adjust f E (Dual a b) = Dual (f a) b
-  adjust f D (Dual a b) = Dual a (f b)
-
-instance Distributive Dual where
-  distribute = distributeRep 
-
-instance Functor Dual where
-  fmap f (Dual a b) = Dual (f a) (f b)
-
-instance Zip Dual where
-  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Dual where
-  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)
-
-instance Keyed Dual where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Dual where
-  (<.>) = apRep
-
-instance Applicative Dual where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Dual where
-  (>>-) = bindRep
-
-instance Monad Dual where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader DualBasis Dual where
-  ask = askRep
-  local = localRep
-
-instance Foldable Dual where
-  foldMap f (Dual a b) = f a `mappend` f b
-
-instance FoldableWithKey Dual where
-  foldMapWithKey f (Dual a b) = f E a `mappend` f D b
-
-instance Traversable Dual where
-  traverse f (Dual a b) = Dual <$> f a <*> f b
-
-instance TraversableWithKey Dual where
-  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b
-
-instance Foldable1 Dual where
-  foldMap1 f (Dual a b) = f a <> f b
-
-instance FoldableWithKey1 Dual where
-  foldMapWithKey1 f (Dual a b) = f E a <> f D b
-
-instance Traversable1 Dual where
-  traverse1 f (Dual a b) = Dual <$> f a <.> f b
-
-instance TraversableWithKey1 Dual where
-  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b
-
-instance HasTrie DualBasis where
-  type BaseTrie DualBasis = Dual
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Dual r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-instance LeftModule r s => LeftModule r (Dual s) where
-  r .* Dual a b = Dual (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Dual s) where
-  Dual a b *. r = Dual (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Dual r) where
-  zero = zeroRep
-  sinnum = sinnumRep
-
-instance Group r => Group (Dual r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Dual r)
-
-instance Idempotent r => Idempotent (Dual r)
-
-instance Partitionable r => Partitionable (Dual r) where
-  partitionWith f (Dual a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Dual a1 b1) (Dual a2 b2)) b) a
-
-instance Rng k => Algebra k DualBasis where
-  mult f = f' where
-    fe = f E E
-    fd = f E D + f D E
-    f' E = fe
-    f' D = fd
-
-instance Rng k => UnitalAlgebra k DualBasis where
-  unit x E = x
-  unit _ _ = zero
-
--- the trivial coalgebra
-instance Rng k => Coalgebra k DualBasis where
-  comult f E E = f E
-  comult f D D = f D
-  comult _ _ _ = zero
-
-instance Rng k => CounitalCoalgebra k DualBasis where
-  counit f = f E + f D
-
-instance Rng k => Bialgebra k DualBasis 
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis where
-  inv f = f' where
-    afe = adjoint (f E)
-    nfd = negate (f D)
-    f' E = afe
-    f' D = nfd
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis where
-  coinv = inv
-
-instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis where
-  antipode = inv
-
-instance (Commutative r, Rng r) => Multiplicative (Dual r) where
-  (*) = mulRep
-
-instance (TriviallyInvolutive r, Rng r) => Commutative (Dual r)
-
-instance (Commutative r, Rng r) => Semiring (Dual r)
-
-instance (Commutative r, Ring r) => Unital (Dual r) where
-  one = oneRep
-
-instance (Commutative r, Ring r) => Rig (Dual r) where
-  fromNatural n = Dual (fromNatural n) zero
-
-instance (Commutative r, Ring r) => Ring (Dual r) where
-  fromInteger n = Dual (fromInteger n) zero
-
-instance (Commutative r, Rng r) => LeftModule (Dual r) (Dual r) where (.*) = (*)
-instance (Commutative r, Rng r) => RightModule (Dual r) (Dual r) where (*.) = (*)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual r) where
-  adjoint (Dual a b) = Dual (adjoint a) (negate b)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual r)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual r) where
-  quadrance n = case adjoint n * n of
-    Dual a _ -> a
-
-instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual r) where
-  recip q@(Dual a b) = Dual (qq \\ a) (qq \\ b)
-    where qq = quadrance q
diff --git a/Numeric/Algebra/Dual/Class.hs b/Numeric/Algebra/Dual/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Dual/Class.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Numeric.Algebra.Dual.Class
-  ( Infinitesimal(..)
-  ) where
-
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Covector
-
-class Distinguished t => Infinitesimal t where
-  d :: t
-
-instance Infinitesimal a => Infinitesimal (Covector r a) where
-  d = return d
diff --git a/Numeric/Algebra/Factorable.hs b/Numeric/Algebra/Factorable.hs
deleted file mode 100644
--- a/Numeric/Algebra/Factorable.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-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/Hopf.hs b/Numeric/Algebra/Hopf.hs
deleted file mode 100644
--- a/Numeric/Algebra/Hopf.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# 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/Hyperbolic.hs b/Numeric/Algebra/Hyperbolic.hs
deleted file mode 100644
--- a/Numeric/Algebra/Hyperbolic.hs
+++ /dev/null
@@ -1,222 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Algebra.Hyperbolic
-  ( Hyperbolic(..)
-  , HyperBasis'(..)
-  , Hyper'(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Semigroup
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Coalgebra.Hyperbolic.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
-
--- the dual hyperbolic basis
-data HyperBasis' = Cosh' | Sinh' deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Hyper' a = Hyper' a a deriving (Eq,Show,Read,Data,Typeable)
-
-instance Hyperbolic HyperBasis' where
-  cosh = Cosh'
-  sinh = Sinh'
-
-instance Rig r => Hyperbolic (Hyper' r) where
-  cosh = Hyper' one zero
-  sinh = Hyper' zero one
-  
-instance Rig r => Hyperbolic (HyperBasis' -> r) where
-  cosh Sinh' = zero
-  cosh Cosh' = one
-  sinh Sinh' = one
-  sinh Cosh' = zero
-
-type instance Key Hyper' = HyperBasis'
-
-instance Representable Hyper' where
-  tabulate f = Hyper' (f Cosh') (f Sinh')
-
-instance Indexable Hyper' where
-  index (Hyper' a _ ) Cosh' = a
-  index (Hyper' _ b ) Sinh' = b
-
-instance Lookup Hyper' where
-  lookup = lookupDefault
-
-instance Adjustable Hyper' where
-  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b
-  adjust f Sinh' (Hyper' a b) = Hyper' a (f b)
-
-instance Distributive Hyper' where
-  distribute = distributeRep 
-
-instance Functor Hyper' where
-  fmap f (Hyper' a b) = Hyper' (f a) (f b)
-
-instance Zip Hyper' where
-  zipWith f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Hyper' where
-  zipWithKey f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f Cosh' a1 a2) (f Sinh' b1 b2)
-
-instance Keyed Hyper' where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Hyper' where
-  (<.>) = apRep
-
-instance Applicative Hyper' where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Hyper' where
-  (>>-) = bindRep
-
-instance Monad Hyper' where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader HyperBasis' Hyper' where
-  ask = askRep
-  local = localRep
-
-instance Foldable Hyper' where
-  foldMap f (Hyper' a b) = f a `mappend` f b
-
-instance FoldableWithKey Hyper' where
-  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' b
-
-instance Traversable Hyper' where
-  traverse f (Hyper' a b) = Hyper' <$> f a <*> f b
-
-instance TraversableWithKey Hyper' where
-  traverseWithKey f (Hyper' a b) = Hyper' <$> f Cosh' a <*> f Sinh' b
-
-instance Foldable1 Hyper' where
-  foldMap1 f (Hyper' a b) = f a <> f b
-
-instance FoldableWithKey1 Hyper' where
-  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' b
-
-instance Traversable1 Hyper' where
-  traverse1 f (Hyper' a b) = Hyper' <$> f a <.> f b
-
-instance TraversableWithKey1 Hyper' where
-  traverseWithKey1 f (Hyper' a b) = Hyper' <$> f Cosh' a <.> f Sinh' b
-
-instance HasTrie HyperBasis' where
-  type BaseTrie HyperBasis' = Hyper'
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Hyper' r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-instance LeftModule r s => LeftModule r (Hyper' s) where
-  r .* Hyper' a b = Hyper' (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Hyper' s) where
-  Hyper' a b *. r = Hyper' (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Hyper' r) where
-  zero = zeroRep
-  sinnum = sinnumRep
-
-instance Group r => Group (Hyper' r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Hyper' r)
-
-instance Idempotent r => Idempotent (Hyper' r)
-
-instance Partitionable r => Partitionable (Hyper' r) where
-  partitionWith f (Hyper' a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Hyper' a1 b1) (Hyper' a2 b2)) b) a
-
--- the dual hyperbolic trigonometric algebra
-instance (Commutative k, Semiring k) => Algebra k HyperBasis' where
-  mult f = f' where
-    fs = f Sinh' Cosh' + f Cosh' Sinh'
-    fc = f Cosh' Cosh' + f Sinh' Sinh'
-    f' Sinh' = fs
-    f' Cosh' = fc
-
-instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis' where
-  unit _ Sinh' = zero
-  unit x Cosh' = x
-
--- the diagonal coalgebra
-instance (Commutative k, Monoidal k, Semiring k) => Coalgebra k HyperBasis' where
-  comult f = f' where
-     fs = f Sinh'
-     fc = f Cosh'
-     f' Sinh' Sinh' = fs
-     f' Sinh' Cosh' = zero
-     f' Cosh' Sinh' = zero
-     f' Cosh' Cosh' = fc
-
-instance (Commutative k, Monoidal k, Semiring k) => CounitalCoalgebra k HyperBasis' where
-  counit f = f Cosh' + f Sinh'
-
-instance (Commutative k, Monoidal k, Semiring k) => Bialgebra k HyperBasis'
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis' where
-  inv f = f' where
-    afc = adjoint (f Cosh')
-    nfs = negate (f Sinh')
-    f' Cosh' = afc
-    f' Sinh' = nfs
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis' where
-  coinv = inv
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis' where
-  antipode = inv
-
-instance (Commutative k, Semiring k) => Multiplicative (Hyper' k) where
-  (*) = mulRep
-
-instance (Commutative k, Semiring k) => Commutative (Hyper' k)
-
-instance (Commutative k, Semiring k) => Semiring (Hyper' k)
-
-instance (Commutative k, Rig k) => Unital (Hyper' k) where
-  one = Hyper' one zero
-
-instance (Commutative r, Rig r) => Rig (Hyper' r) where
-  fromNatural n = Hyper' (fromNatural n) zero
-
-instance (Commutative r, Ring r) => Ring (Hyper' r) where
-  fromInteger n = Hyper' (fromInteger n) zero
-
-instance (Commutative r, Semiring r) => LeftModule (Hyper' r) (Hyper' r) where (.*) = (*)
-instance (Commutative r, Semiring r) => RightModule (Hyper' r) (Hyper' r) where (*.) = (*)
-
-instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveMultiplication (Hyper' r) where
-  adjoint (Hyper' a b) = Hyper' (adjoint a) (negate b)
-
-instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveSemiring (Hyper' r)
-
-instance (Commutative r, InvolutiveSemiring r, Rng r) => Quadrance r (Hyper' r) where
-  quadrance n = case adjoint n * n of
-    Hyper' a _ -> a
-
-instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Hyper' r) where
-  recip q@(Hyper' a b) = Hyper' (qq \\ a) (qq \\ b)
-    where qq = quadrance q
-
diff --git a/Numeric/Algebra/Idempotent.hs b/Numeric/Algebra/Idempotent.hs
deleted file mode 100644
--- a/Numeric/Algebra/Idempotent.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# 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/Incidence.hs b/Numeric/Algebra/Incidence.hs
deleted file mode 100644
--- a/Numeric/Algebra/Incidence.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses
-           , FlexibleInstances
-           , UndecidableInstances
-           , DeriveDataTypeable
-           #-}
-
-module Numeric.Algebra.Incidence
-  ( Interval(..)
-  , zeta
-  , moebius
-  ) where
-
-import Data.Data
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Algebra.Commutative
-import Numeric.Ring.Class
-import Numeric.Order.Class
-import Numeric.Order.LocallyFinite
-
--- the basis for an incidence algebra
-data Interval a = Interval a a deriving (Eq,Ord,Show,Read,Data,Typeable)
-
-instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => Algebra r (Interval a) where
-  mult f (Interval a c) = sumWith (\b -> f (Interval a b) (Interval b c)) $ range a c
-  
-instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => UnitalAlgebra r (Interval a) where
-  unit r (Interval a b) 
-    | a ~~ b = r
-    | otherwise = zero
-
-zeta :: Unital r => Interval a -> r
-zeta = const one
-
-moebius :: (Ring r, LocallyFiniteOrder a) => Interval a -> r
-moebius (Interval a b) = moebiusInversion a b
diff --git a/Numeric/Algebra/Involutive.hs b/Numeric/Algebra/Involutive.hs
deleted file mode 100644
--- a/Numeric/Algebra/Involutive.hs
+++ /dev/null
@@ -1,377 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-}
-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.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Key
-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)
-
-instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where
-  adjoint = inv
-
-instance (HasTrie h, InvolutiveAlgebra r h) => InvolutiveMultiplication (h :->: r) where
-  adjoint = tabulate . inv . index
-
-
-
--- | adjoint (x + y) = adjoint x + adjoint y
-class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r
-
-instance InvolutiveSemiring ()
-instance InvolutiveSemiring Bool
-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 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 Bool
-instance TriviallyInvolutive Int
-instance TriviallyInvolutive Integer
-instance TriviallyInvolutive Int8
-instance TriviallyInvolutive Int16
-instance TriviallyInvolutive Int32
-instance TriviallyInvolutive Int64
-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)
-
-instance ( TriviallyInvolutive r
-         , TriviallyInvolutiveAlgebra r a
-         ) => TriviallyInvolutive (a -> r)
-
-instance ( HasTrie a
-         , TriviallyInvolutive r
-         , TriviallyInvolutiveAlgebra r a
-         ) => TriviallyInvolutive (a :->: r)
-
-
-
--- inv is an associative algebra homomorphism
-class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where
-  inv :: (a -> r) -> a -> r
-
-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
-
-
-
-class ( CommutativeAlgebra r a
-      , TriviallyInvolutive r
-      , 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)
-
-
-
-class ( InvolutiveSemiring r
-      , Coalgebra r c
-      ) => InvolutiveCoalgebra r c where
-  coinv :: (c -> r) -> c -> r
-
-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
-
-
-
-class ( CocommutativeCoalgebra r a
-      , TriviallyInvolutive r
-      , InvolutiveCoalgebra r a
-      ) => TriviallyInvolutiveCoalgebra r a
-
-instance ( TriviallyInvolutive r
-         , InvolutiveSemiring r
-         ) => TriviallyInvolutiveCoalgebra r ()
-
-instance ( TriviallyInvolutiveCoalgebra r a
-         , TriviallyInvolutiveCoalgebra r b
-         ) => TriviallyInvolutiveCoalgebra r (a, b)
-
-instance ( TriviallyInvolutiveCoalgebra r a
-         , TriviallyInvolutiveCoalgebra r b
-         , TriviallyInvolutiveCoalgebra r c
-         ) => TriviallyInvolutiveCoalgebra r (a, b, c)
-
-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)
-
-
-
-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/Quaternion.hs b/Numeric/Algebra/Quaternion.hs
deleted file mode 100644
--- a/Numeric/Algebra/Quaternion.hs
+++ /dev/null
@@ -1,334 +0,0 @@
-{-# LANGUAGE FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , UndecidableInstances
-           , DeriveDataTypeable
-           , TypeOperators #-}
-module Numeric.Algebra.Quaternion 
-  ( Distinguished(..)
-  , Complicated(..)
-  , Hamiltonian(..)
-  , QuaternionBasis(..)
-  , Quaternion(..)
-  , complicate
-  , vectorPart
-  , scalarPart
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Ix hiding (index)
-import Data.Key
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Traversable
-import Data.Semigroup
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Numeric.Algebra
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Complex.Class
-import Numeric.Algebra.Quaternion.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
-
-instance Distinguished QuaternionBasis where
-  e = E
-
-instance Complicated QuaternionBasis where
-  i = I
-
-instance Hamiltonian QuaternionBasis where
-  j = J
-  k = K
-
-instance Rig r => Distinguished (Quaternion r) where
-  e = Quaternion one zero zero zero
-
-instance Rig r => Complicated (Quaternion r) where
-  i = Quaternion zero one zero zero
-
-instance Rig r => Hamiltonian (Quaternion r) where
-  j = Quaternion zero zero one zero
-  k = Quaternion one zero zero one 
-
-instance Rig r => Distinguished (QuaternionBasis :->: r) where
-  e = Trie e
-
-instance Rig r => Complicated (QuaternionBasis :->: r) where
-  i = Trie i
-
-instance Rig r => Hamiltonian (QuaternionBasis :->: r) where
-  j = Trie j
-  k = Trie k
-
-instance Rig r => Distinguished (QuaternionBasis -> r) where
-  e E = one 
-  e _ = zero
-
-instance Rig r => Complicated (QuaternionBasis -> r) where
-  i I = one
-  i _ = zero
-  
-instance Rig r => Hamiltonian (QuaternionBasis -> r) where
-  j J = one
-  j _ = zero
-
-  k K = one
-  k _ = zero
-
--- quaternion basis
-data QuaternionBasis = E | I | J | K deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
-
-data Quaternion a = Quaternion a a a a deriving (Eq,Show,Read,Data,Typeable)
-
-type instance Key Quaternion = QuaternionBasis
-
-instance Representable Quaternion where
-  tabulate f = Quaternion (f E) (f I) (f J) (f K)
-
-instance Indexable Quaternion where
-  index (Quaternion a _ _ _) E = a
-  index (Quaternion _ b _ _) I = b
-  index (Quaternion _ _ c _) J = c
-  index (Quaternion _ _ _ d) K = d
-
-instance Lookup Quaternion where
-  lookup = lookupDefault
-
-instance Adjustable Quaternion where
-  adjust f E (Quaternion a b c d) = Quaternion (f a) b c d
-  adjust f I (Quaternion a b c d) = Quaternion a (f b) c d
-  adjust f J (Quaternion a b c d) = Quaternion a b (f c) d
-  adjust f K (Quaternion a b c d) = Quaternion a b c (f d)
-
-instance Distributive Quaternion where
-  distribute = distributeRep 
-
-instance Functor Quaternion where
-  fmap = fmapRep
-
-instance Zip Quaternion where
-  zipWith f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = 
-    Quaternion (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)
-
-instance ZipWithKey Quaternion where
-  zipWithKey f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = 
-    Quaternion (f E a1 a2) (f I b1 b2) (f J c1 c2) (f K d1 d2)
-
-instance Keyed Quaternion where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Quaternion where
-  (<.>) = apRep
-
-instance Applicative Quaternion where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Quaternion where
-  (>>-) = bindRep
-
-instance Monad Quaternion where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader QuaternionBasis Quaternion where
-  ask = askRep
-  local = localRep
-
-instance Foldable Quaternion where
-  foldMap f (Quaternion a b c d) = 
-    f a `mappend` f b `mappend` f c `mappend` f d
-
-instance FoldableWithKey Quaternion where
-  foldMapWithKey f (Quaternion a b c d) = 
-    f E a `mappend` f I b `mappend` f J c `mappend` f K d
-
-instance Traversable Quaternion where
-  traverse f (Quaternion a b c d) = 
-    Quaternion <$> f a <*> f b <*> f c <*> f d
-
-instance TraversableWithKey Quaternion where
-  traverseWithKey f (Quaternion a b c d) = 
-    Quaternion <$> f E a <*> f I b <*> f J c <*> f K d
-
-instance Foldable1 Quaternion where
-  foldMap1 f (Quaternion a b c d) = 
-    f a <> f b <> f c <> f d
-
-instance FoldableWithKey1 Quaternion where
-  foldMapWithKey1 f (Quaternion a b c d) = 
-    f E a <> f I b <> f J c <> f K d
-
-instance Traversable1 Quaternion where
-  traverse1 f (Quaternion a b c d) = 
-    Quaternion <$> f a <.> f b <.> f c <.> f d
-
-instance TraversableWithKey1 Quaternion where
-  traverseWithKey1 f (Quaternion a b c d) = 
-    Quaternion <$> f E a <.> f I b <.> f J c <.> f K d
-
-instance HasTrie QuaternionBasis where
-  type BaseTrie QuaternionBasis = Quaternion
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Quaternion r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-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
-  sinnum = sinnumRep
-
-instance Group r => Group (Quaternion r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Quaternion r)
-
-instance Idempotent r => Idempotent (Quaternion r)
-
-instance Partitionable r => Partitionable (Quaternion r) where
-  partitionWith f (Quaternion a b c d) = id =<<
-    partitionWith (\a1 a2 -> id =<< 
-    partitionWith (\b1 b2 -> id =<< 
-    partitionWith (\c1 c2 -> 
-    partitionWith (\d1 d2 -> f (Quaternion a1 b1 c1 d1) 
-                               (Quaternion a2 b2 c2 d2)
-                  ) d) c) b) a
-
--- | the quaternion algebra
-instance (TriviallyInvolutive r, Rng r) => Algebra r QuaternionBasis where
-  mult f = f' where
-    fe = f E E - (f I I + f J J + f K K)
-    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
-
--- | the trivial diagonal coalgebra
-instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
-  comult f = f' where
-    fe = f E
-    fi = f I
-    fj = f J
-    fk = f K
-    f' E E = fe
-    f' I I = fi
-    f' J J = fj
-    f' K K = fk
-    f' _ _ = zero
-
-instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
-  counit f = f E + f I + f J + f K
-
-{-
--- dual quaternion comultiplication
-instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
-  comult f = f' where
-    fe = f E
-    fi = f I
-    fj = f J
-    fk = f K
-    fe' = negate fe
-    fi' = negate fi
-    fj' = negate fj
-    fk' = negate fk
-    f' E E = fe
-    f' E I = fi
-    f' E J = fj
-    f' E K = fk
-    f' I E = fi
-    f' I I = fe'
-    f' I J = fk
-    f' I K = fj'
-    f' J E = fj
-    f' J I = fk'
-    f' J J = fe'
-    f' J K = fi
-    f' K E = fk
-    f' K I = fj
-    f' K J = fi'
-    f' K K = fe'
-
-instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
-  counit f = f E
--}
-
-instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis 
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where
-  inv f E = f E
-  inv f b = negate (f b)
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where
-  coinv = inv
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis where
-  antipode = inv
-
-instance (TriviallyInvolutive r, 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 :: Complicated c => QuaternionBasis -> (c,c)
-complicate E = (e, e)
-complicate I = (i, e) 
-complicate J = (e, i)
-complicate K = (i, i)
-
-scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r
-scalarPart f = index f E
-
-vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)
-vectorPart f = (index f I, index f J, index f K)
-
-instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where
-  quadrance n = scalarPart (adjoint n * n)
-
-instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion r) where
-  recip q@(Quaternion a b c d) = Quaternion (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
-    where qq = quadrance q
diff --git a/Numeric/Algebra/Quaternion/Class.hs b/Numeric/Algebra/Quaternion/Class.hs
deleted file mode 100644
--- a/Numeric/Algebra/Quaternion/Class.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Numeric.Algebra.Quaternion.Class
-  ( Hamiltonian(..)
-  ) where
-
-import Numeric.Algebra.Complex.Class
-import Numeric.Covector
-
-class Complicated t => Hamiltonian t where
-  j :: t
-  k :: t
-
-instance Hamiltonian a => Hamiltonian (Covector r a) where
-  j = return j
-  k = return k
diff --git a/Numeric/Algebra/Unital.hs b/Numeric/Algebra/Unital.hs
deleted file mode 100644
--- a/Numeric/Algebra/Unital.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# 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/Class.hs b/Numeric/Band/Class.hs
deleted file mode 100644
--- a/Numeric/Band/Class.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Numeric.Band.Class
-  ( Band
-  , pow1pBand
-  , powBand
-  ) where
-
-import Numeric.Algebra.Idempotent
diff --git a/Numeric/Band/Rectangular.hs b/Numeric/Band/Rectangular.hs
deleted file mode 100644
--- a/Numeric/Band/Rectangular.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Numeric.Band.Rectangular 
-  ( Rect(..)
-  ) where
-
-import Numeric.Algebra.Class
-import Numeric.Algebra.Idempotent
-import Data.Semigroupoid
-
--- | a rectangular band is a nowhere commutative semigroup.
--- That is to say, if ab = ba then a = b. From this it follows
--- classically that aa = a and that such a band is isomorphic 
--- to the following structure
-data Rect i j = Rect i j deriving (Eq,Ord,Show,Read)
-
-instance Semigroupoid Rect where
-  Rect _ i `o` Rect j _ = Rect j i
-
-instance Multiplicative (Rect i j) where
-  Rect i _ * Rect _ j = Rect i j
-
-instance Band (Rect i j)
diff --git a/Numeric/Coalgebra/Categorical.hs b/Numeric/Coalgebra/Categorical.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Categorical.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, PatternGuards #-}
-module Numeric.Coalgebra.Categorical 
-  ( Morphism(..)
-  ) where
-
-import Data.Data
-import Numeric.Partial.Semigroup
-import Numeric.Partial.Monoid
-import Numeric.Partial.Group
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Algebra.Commutative
-
--- the dual categorical algebra
-newtype Morphism a = Morphism a deriving (Eq,Ord,Show,Read,PartialSemigroup,PartialMonoid,PartialGroup,Data,Typeable)
-
-instance (Commutative r, Monoidal r, Semiring r, PartialSemigroup a) => Coalgebra r (Morphism a) where
-  comult f a b 
-    | Just c <- padd a b = f c
-    | otherwise = zero
-
-instance (Commutative r, Monoidal r, Semiring r, PartialMonoid a) => CounitalCoalgebra r (Morphism a) where
-  counit f = f pzero
diff --git a/Numeric/Coalgebra/Dual.hs b/Numeric/Coalgebra/Dual.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Dual.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Coalgebra.Dual
-  ( Distinguished(..)
-  , Infinitesimal(..)
-  , DualBasis'(..)
-  , Dual'(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Semigroup
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Dual.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
-
--- | dual number basis, D^2 = 0. D /= 0.
-data DualBasis' = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Dual' a = Dual' a a deriving (Eq,Show,Read,Data,Typeable)
-
-instance Distinguished DualBasis' where
-  e = E
-
-instance Infinitesimal DualBasis' where
-  d = D
-
-instance Rig r => Distinguished (Dual' r) where
-  e = Dual' one zero
-
-instance Rig r => Infinitesimal (Dual' r) where
-  d = Dual' zero one
-  
-instance Rig r => Distinguished (DualBasis' -> r) where
-  e E = one
-  e _ = zero
-
-instance Rig r => Infinitesimal (DualBasis' -> r) where
-  d D = one
-  d _       = zero 
-
-type instance Key Dual' = DualBasis'
-
-instance Representable Dual' where
-  tabulate f = Dual' (f E) (f D)
-
-instance Indexable Dual' where
-  index (Dual' a _ ) E = a
-  index (Dual' _ b ) D = b
-
-instance Lookup Dual' where
-  lookup = lookupDefault
-
-instance Adjustable Dual' where
-  adjust f E (Dual' a b) = Dual' (f a) b
-  adjust f D (Dual' a b) = Dual' a (f b)
-
-instance Distributive Dual' where
-  distribute = distributeRep 
-
-instance Functor Dual' where
-  fmap f (Dual' a b) = Dual' (f a) (f b)
-
-instance Zip Dual' where
-  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Dual' where
-  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)
-
-instance Keyed Dual' where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Dual' where
-  (<.>) = apRep
-
-instance Applicative Dual' where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Dual' where
-  (>>-) = bindRep
-
-instance Monad Dual' where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader DualBasis' Dual' where
-  ask = askRep
-  local = localRep
-
-instance Foldable Dual' where
-  foldMap f (Dual' a b) = f a `mappend` f b
-
-instance FoldableWithKey Dual' where
-  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b
-
-instance Traversable Dual' where
-  traverse f (Dual' a b) = Dual' <$> f a <*> f b
-
-instance TraversableWithKey Dual' where
-  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b
-
-instance Foldable1 Dual' where
-  foldMap1 f (Dual' a b) = f a <> f b
-
-instance FoldableWithKey1 Dual' where
-  foldMapWithKey1 f (Dual' a b) = f E a <> f D b
-
-instance Traversable1 Dual' where
-  traverse1 f (Dual' a b) = Dual' <$> f a <.> f b
-
-instance TraversableWithKey1 Dual' where
-  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b
-
-instance HasTrie DualBasis' where
-  type BaseTrie DualBasis' = Dual'
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Dual' r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-instance LeftModule r s => LeftModule r (Dual' s) where
-  r .* Dual' a b = Dual' (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Dual' s) where
-  Dual' a b *. r = Dual' (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Dual' r) where
-  zero = zeroRep
-  sinnum = sinnumRep
-
-instance Group r => Group (Dual' r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Dual' r)
-
-instance Idempotent r => Idempotent (Dual' r)
-
-instance Partitionable r => Partitionable (Dual' r) where
-  partitionWith f (Dual' a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Dual' a1 b1) (Dual' a2 b2)) b) a
-
-instance Semiring k => Algebra k DualBasis' where
-  mult f = f' where
-    fe = f E E
-    fd = f D D
-    f' E = fe
-    f' D = fd
-
-instance Semiring k => UnitalAlgebra k DualBasis' where
-  unit = const
-
--- the trivial coalgebra
-instance Rng k => Coalgebra k DualBasis' where
-  comult f = f' where
-     fe = f E
-     fd = f D
-     f' E E = fe
-     f' E D = fd
-     f' D E = fd
-     f' D D = zero
-
-instance Rng k => CounitalCoalgebra k DualBasis' where
-  counit f = f E
-
-instance Rng k => Bialgebra k DualBasis' 
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis' where
-  inv f = f' where
-    afe = adjoint (f E)
-    nfd = negate (f D)
-    f' E = afe
-    f' D = nfd
-
-instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis' where
-  coinv = inv
-
-instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis' where
-  antipode = inv
-
-instance (Commutative r, Rng r) => Multiplicative (Dual' r) where
-  (*) = mulRep
-
-instance (TriviallyInvolutive r, Rng r) => Commutative (Dual' r)
-
-instance (Commutative r, Rng r) => Semiring (Dual' r)
-
-instance (Commutative r, Ring r) => Unital (Dual' r) where
-  one = oneRep
-
-instance (Commutative r, Ring r) => Rig (Dual' r) where
-  fromNatural n = Dual' (fromNatural n) zero
-
-instance (Commutative r, Ring r) => Ring (Dual' r) where
-  fromInteger n = Dual' (fromInteger n) zero
-
-instance (Commutative r, Rng r) => LeftModule (Dual' r) (Dual' r) where (.*) = (*)
-instance (Commutative r, Rng r) => RightModule (Dual' r) (Dual' r) where (*.) = (*)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual' r) where
-  adjoint (Dual' a b) = Dual' (adjoint a) (negate b)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual' r)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual' r) where
-  quadrance n = case adjoint n * n of
-    Dual' a _ -> a
-
-instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual' r) where
-  recip q@(Dual' a b) = Dual' (qq \\ a) (qq \\ b)
-    where qq = quadrance q
diff --git a/Numeric/Coalgebra/Geometric.hs b/Numeric/Coalgebra/Geometric.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Geometric.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-{-# LANGUAGE 
-    MultiParamTypeClasses, 
-    GeneralizedNewtypeDeriving, 
-    BangPatterns,
-    TypeOperators,
-    DeriveDataTypeable,
-    FlexibleInstances,
-    TypeFamilies,
-    PatternGuards,
-    UndecidableInstances,
-    ScopedTypeVariables #-}
-
-module Numeric.Coalgebra.Geometric
-  ( 
-  -- * Geometric coalgebra primitives
-    BasisCoblade(..)
-  , Comultivector
-  -- * Operations over an eigenbasis
-  , Eigenbasis(..)
-  , Eigenmetric(..)
-  , Euclidean(..)
-  -- * Grade
-  , grade
-  , filterGrade
-  -- * Inversions
-  , reverse
-  , gradeInversion
-  , cliffordConjugate
-  -- * Products
-  , geometric
-  , outer
-  -- * Inner products
-  , contractL
-  , contractR
-  , hestenes
-  , dot
-  , liftProduct
-  ) where
-
-import Control.Monad (mfilter)
-import Data.Bits
-import Data.Functor.Representable.Trie
-import Data.Word
-import Data.Data
-import Data.Ix
-import Data.Array.Unboxed
-import Numeric.Algebra
-import Prelude hiding ((-),(*),(+),negate,reverse)
-
--- a basis vector for a simple geometric coalgebra with the Euclidean inner product
-newtype BasisCoblade m = BasisCoblade { runBasisCoblade :: Word64 } deriving 
-  ( Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral
-  , Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal
-  , Multiplicative,Unital,Commutative
-  , Semiring,Rig
-  , DecidableZero,DecidableAssociates,DecidableUnits
-  )
-
-instance HasTrie (BasisCoblade m) where
-  type BaseTrie (BasisCoblade m) = BaseTrie Word64
-  embedKey = embedKey . runBasisCoblade
-  projectKey = BasisCoblade . projectKey
-
--- A metric space over an eigenbasis
-class Eigenbasis m where
-  euclidean     :: proxy m -> Bool
-  antiEuclidean :: proxy m -> Bool
-  v             :: m -> BasisCoblade m
-  e             :: Int -> m
-
--- assuming n /= 0, find the index of the least significant set bit in a basis blade
-lsb :: BasisCoblade m -> Int
-lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58
-  where 
-    -- a 64 bit deBruijn multiplication table
-    ix :: UArray (BasisCoblade m) Word8
-    ix = listArray (0, 63)
-      [ 63,  0, 58,  1, 59, 47, 53,  2
-      , 60, 39, 48, 27, 54, 33, 42,  3
-      , 61, 51, 37, 40, 49, 18, 28, 20
-      , 55, 30, 34, 11, 43, 14, 22,  4
-      , 62, 57, 46, 52, 38, 26, 32, 41
-      , 50, 36, 17, 19, 29, 10, 13, 21
-      , 56, 45, 25, 31, 35, 16,  9, 12
-      , 44, 24, 15,  8, 23,  7,  6,  5
-      ]
-
-class (Ring r, Eigenbasis m) => Eigenmetric r m where
-  metric :: m -> r
-
-type Comultivector r m = Covector r (BasisCoblade m)
-
--- Euclidean basis, we can work with basis vectors for euclidean spaces of up to 64 dimensions without 
--- expanding the representation of our basis vectors
-newtype Euclidean = Euclidean Int deriving 
-  ( Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral
-  , Data,Typeable
-  , Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group
-  , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative
-  , Semiring,Rig,Ring
-  )
-
-instance HasTrie Euclidean where
-  type BaseTrie Euclidean = BaseTrie Int
-  embedKey (Euclidean i) = embedKey i
-  projectKey = Euclidean . projectKey
-
-instance Eigenbasis Euclidean where
-  euclidean _ = True
-  antiEuclidean _ = False
-  v n = shiftL 1 (fromIntegral n)
-  e = fromIntegral
-
-instance Ring r => Eigenmetric r Euclidean where
-  metric _ = one
-
-grade :: BasisCoblade m -> Int
-grade = fromIntegral . count 5 . count 4 . count 3 . count 2 . count 1 . count 0 where 
-  count c x = (x .&. mask) + (shiftR x p .&. mask) where 
-    p = shiftL 1 c
-    mask = (-1) `div` (shiftL 1 p + 1)
-
-m1powTimes :: (Bits n, Group r) => n -> r -> r
-m1powTimes n r 
-  | (n .&. 1) == 0 = r
-  | otherwise      = negate r
-
-reorder :: Group r => BasisCoblade m -> BasisCoblade m -> r -> r
-reorder a0 b = m1powTimes $ go 0 (shiftR a0 1)
-  where
-    go !acc 0 = acc
-    go acc a = go (acc + grade (a .&. b)) (shiftR a 1)
-
--- <A>_k
-filterGrade :: Monoidal r => BasisCoblade m -> Int -> Comultivector r m
-filterGrade b k | grade b == k = zero
-                | otherwise    = return b
-
-instance Eigenmetric r m => Coalgebra r (BasisCoblade m) where
-  comult f n m = scale (n .&. m) $ reorder n m $ f $ xor n m where
-    scale b
-      | euclidean n = id
-      | otherwise   = (go one b *)
-    go :: Eigenmetric r m => r -> BasisCoblade m -> r
-    go acc 0 = acc
-    go acc n' | b <- lsb n'
-              , m' <- metric (e b :: m)
-              = go (acc*m') (clearBit n' b)
-
-instance Eigenmetric r m => CounitalCoalgebra r (BasisCoblade m) where
-  counit f = f (BasisCoblade zero)
-
--- instance Group r => InvertibleModule r BasisCoblade where
-  
--- reversion (A~) is an involution for the outer product
-reverse :: Group r => BasisCoblade m -> Comultivector r m
-reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where
-  g = grade b
-
-cliffordConjugate :: Group r => BasisCoblade m -> Comultivector r m
-cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where
-  g = grade b
-
--- A^
-gradeInversion :: Group r => BasisCoblade m -> Comultivector r m
-gradeInversion b = grade b `m1powTimes` return b
-
-geometric :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m  
-geometric = multM
-
-outer :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
-outer m n | m .&. n == 0 = geometric m n 
-          | otherwise    = zero
-
--- A _| B
--- grade (A _| B) = grade B - grade A
-contractL :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m 
-contractL a b 
-  | ga Prelude.> gb   = zero
-  | otherwise = mfilter (\r -> grade r == gb - ga) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
--- A |_ B
--- grade (A |_ B) = grade A - grade B
-contractR :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
-contractR a b 
-  | ga Prelude.< gb   = zero
-  | otherwise = mfilter (\r -> grade r == ga - gb) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
--- the modified Hestenes' product
-dot :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
-dot a b = mfilter (\r -> grade r == abs(grade a - grade b)) (geometric a b)
-
--- Hestenes' inner product
--- if 0 /= grade a <= grade b then 
--- dot a b = hestenes a b = leftContract a b
-hestenes :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
-hestenes a b
-  | ga == 0 || gb == 0 = zero
-  | otherwise = mfilter (\r -> grade r == abs(ga - gb)) (geometric a b)
-  where
-    ga = grade a
-    gb = grade b
-
-liftProduct :: (BasisCoblade m -> BasisCoblade m -> Comultivector r m) -> Comultivector r m -> Comultivector r m -> Comultivector r m
-liftProduct f ma mb = do
-  a <- ma
-  b <- mb
-  f a b
diff --git a/Numeric/Coalgebra/Hyperbolic.hs b/Numeric/Coalgebra/Hyperbolic.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Hyperbolic.hs
+++ /dev/null
@@ -1,212 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
-module Numeric.Coalgebra.Hyperbolic 
-  ( Hyperbolic(..)
-  , HyperBasis(..)
-  , Hyper(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Semigroup
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Coalgebra.Hyperbolic.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, cosh, sinh)
-
--- complex basis
-data HyperBasis = Cosh | Sinh deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)
-
-instance Hyperbolic HyperBasis where
-  cosh = Cosh
-  sinh = Sinh
-
-instance Rig r => Hyperbolic (Hyper r) where
-  cosh = Hyper one zero
-  sinh = Hyper zero one
-  
-instance Rig r => Hyperbolic (HyperBasis -> r) where
-  cosh Sinh = zero
-  cosh Cosh = one
-  sinh Sinh = one
-  sinh Cosh = zero
-
-type instance Key Hyper = HyperBasis
-
-instance Representable Hyper where
-  tabulate f = Hyper (f Cosh) (f Sinh)
-
-instance Indexable Hyper where
-  index (Hyper a _ ) Cosh = a
-  index (Hyper _ b ) Sinh = b
-
-instance Lookup Hyper where
-  lookup = lookupDefault
-
-instance Adjustable Hyper where
-  adjust f Cosh (Hyper a b) = Hyper (f a) b
-  adjust f Sinh (Hyper a b) = Hyper a (f b)
-
-instance Distributive Hyper where
-  distribute = distributeRep 
-
-instance Functor Hyper where
-  fmap f (Hyper a b) = Hyper (f a) (f b)
-
-instance Zip Hyper where
-  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Hyper where
-  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f Cosh a1 a2) (f Sinh b1 b2)
-
-instance Keyed Hyper where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Hyper where
-  (<.>) = apRep
-
-instance Applicative Hyper where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Hyper where
-  (>>-) = bindRep
-
-instance Monad Hyper where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader HyperBasis Hyper where
-  ask = askRep
-  local = localRep
-
-instance Foldable Hyper where
-  foldMap f (Hyper a b) = f a `mappend` f b
-
-instance FoldableWithKey Hyper where
-  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh b
-
-instance Traversable Hyper where
-  traverse f (Hyper a b) = Hyper <$> f a <*> f b
-
-instance TraversableWithKey Hyper where
-  traverseWithKey f (Hyper a b) = Hyper <$> f Cosh a <*> f Sinh b
-
-instance Foldable1 Hyper where
-  foldMap1 f (Hyper a b) = f a <> f b
-
-instance FoldableWithKey1 Hyper where
-  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh b
-
-instance Traversable1 Hyper where
-  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b
-
-instance TraversableWithKey1 Hyper where
-  traverseWithKey1 f (Hyper a b) = Hyper <$> f Cosh a <.> f Sinh b
-
-instance HasTrie HyperBasis where
-  type BaseTrie HyperBasis = Hyper
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Hyper r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-instance LeftModule r s => LeftModule r (Hyper s) where
-  r .* Hyper a b = Hyper (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Hyper s) where
-  Hyper a b *. r = Hyper (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Hyper r) where
-  zero = zeroRep
-  sinnum = sinnumRep
-
-instance Group r => Group (Hyper r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Hyper r)
-
-instance Idempotent r => Idempotent (Hyper r)
-
-instance Partitionable r => Partitionable (Hyper r) where
-  partitionWith f (Hyper a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a
-
--- | the trivial diagonal algebra
-instance Semiring k => Algebra k HyperBasis where
-  mult f = f' where
-    fs = f Sinh Sinh
-    fc = f Cosh Cosh
-    f' Sinh = fs
-    f' Cosh = fc
-
-instance Semiring k => UnitalAlgebra k HyperBasis where
-  unit = const
-
--- | the hyperbolic trigonometric coalgebra
-instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where
-  comult f = f' where
-     fs = f Sinh
-     fc = f Cosh
-     f' Sinh Sinh = fc
-     f' Sinh Cosh = fs 
-     f' Cosh Sinh = fs
-     f' Cosh Cosh = fc
-
-instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where
-  counit f = f Cosh
-
-instance (Commutative k, Semiring k) => Bialgebra k HyperBasis
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis where
-  inv f = f' where
-    afc = adjoint (f Cosh)
-    nfs = negate (f Sinh)
-    f' Cosh = afc
-    f' Sinh = nfs
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis where
-  coinv = inv
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis where
-  antipode = inv
-
-instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where
-  (*) = mulRep
-
-instance (Commutative k, Semiring k) => Commutative (Hyper k)
-
-instance (Commutative k, Semiring k) => Semiring (Hyper k)
-
-instance (Commutative k, Rig k) => Unital (Hyper k) where
-  one = Hyper one zero
-
-instance (Commutative r, Rig r) => Rig (Hyper r) where
-  fromNatural n = Hyper (fromNatural n) zero
-
-instance (Commutative r, Ring r) => Ring (Hyper r) where
-  fromInteger n = Hyper (fromInteger n) zero
-
-instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)
-instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)
-
-instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveMultiplication (Hyper r) where
-  adjoint (Hyper a b) = Hyper (adjoint a) (negate b)
-
-instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
diff --git a/Numeric/Coalgebra/Hyperbolic/Class.hs b/Numeric/Coalgebra/Hyperbolic/Class.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Hyperbolic/Class.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Numeric.Coalgebra.Hyperbolic.Class
-  ( Hyperbolic(..)
-  ) where
-
-import Prelude (return)
-import Numeric.Covector
-
-class Hyperbolic r where
-  cosh :: r
-  sinh :: r
-
-instance Hyperbolic a => Hyperbolic (Covector r a) where
-  cosh = return cosh
-  sinh = return sinh
diff --git a/Numeric/Coalgebra/Incidence.hs b/Numeric/Coalgebra/Incidence.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Incidence.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses
-           , FlexibleInstances
-           , UndecidableInstances
-           , DeriveDataTypeable
-           #-}
-
-module Numeric.Coalgebra.Incidence
-  ( Interval'(..)
-  , zeta'
-  , moebius'
-  ) where
-
-import Data.Data
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Algebra.Commutative
-import Numeric.Ring.Class
-import Numeric.Order.LocallyFinite
-
--- | the dual incidence algebra basis
-data Interval' a = Interval' a a deriving (Eq,Ord,Show,Read,Data,Typeable)
-
-instance (Eq a, Commutative r, Monoidal r, Semiring r) => Coalgebra r (Interval' a) where
-  comult f (Interval' a b) (Interval' b' c) 
-    | b == b' = f (Interval' a c)
-    | otherwise = zero
-
-instance (Eq a, Bounded a, Commutative r, Monoidal r, Semiring r) => CounitalCoalgebra r (Interval' a) where
-  counit f = f (Interval' minBound maxBound)
-  
-zeta' :: Unital r => Interval' a -> r
-zeta' = const one
-
-moebius' :: (Ring r, LocallyFiniteOrder a) => Interval' a -> r
-moebius' (Interval' a b) = moebiusInversion a b
diff --git a/Numeric/Coalgebra/Quaternion.hs b/Numeric/Coalgebra/Quaternion.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Quaternion.hs
+++ /dev/null
@@ -1,316 +0,0 @@
-{-# LANGUAGE FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , UndecidableInstances
-           , DeriveDataTypeable
-           , TypeOperators #-}
-module Numeric.Coalgebra.Quaternion
-  ( Distinguished(..)
-  , Complicated(..)
-  , Hamiltonian(..)
-  , QuaternionBasis'(..)
-  , Quaternion'(..)
-  , complicate'
-  , vectorPart'
-  , scalarPart'
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Ix hiding (index)
-import Data.Key
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Traversable
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Semigroup
-import Numeric.Algebra
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Complex.Class
-import Numeric.Algebra.Quaternion.Class
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
-
-instance Distinguished QuaternionBasis' where
-  e = E'
-
-instance Complicated QuaternionBasis' where
-  i = I'
-
-instance Hamiltonian QuaternionBasis' where
-  j = J'
-  k = K'
-
-instance Rig r => Distinguished (Quaternion' r) where
-  e = Quaternion' one zero zero zero
-
-instance Rig r => Complicated (Quaternion' r) where
-  i = Quaternion' zero one zero zero
-
-instance Rig r => Hamiltonian (Quaternion' r) where
-  j = Quaternion' zero zero one zero
-  k = Quaternion' one zero zero one
-
-instance Rig r => Distinguished (QuaternionBasis' :->: r) where
-  e = Trie e
-
-instance Rig r => Complicated (QuaternionBasis' :->: r) where
-  i = Trie i
-
-instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where
-  j = Trie j
-  k = Trie k
-
-instance Rig r => Distinguished (QuaternionBasis' -> r) where
-  e E' = one
-  e _ = zero
-
-instance Rig r => Complicated (QuaternionBasis' -> r) where
-  i I' = one
-  i _ = zero
-
-instance Rig r => Hamiltonian (QuaternionBasis' -> r) where
-  j J' = one
-  j _ = zero
-
-  k K' = one
-  k _ = zero
-
--- quaternion basis
-data QuaternionBasis' = E' | I' | J' | K' deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
-
-data Quaternion' a = Quaternion' a a a a deriving (Eq,Show,Read,Data,Typeable)
-
-type instance Key Quaternion' = QuaternionBasis'
-
-instance Representable Quaternion' where
-  tabulate f = Quaternion' (f E') (f I') (f J') (f K')
-
-instance Indexable Quaternion' where
-  index (Quaternion' a _ _ _) E' = a
-  index (Quaternion' _ b _ _) I' = b
-  index (Quaternion' _ _ c _) J' = c
-  index (Quaternion' _ _ _ d) K' = d
-
-instance Lookup Quaternion' where
-  lookup = lookupDefault
-
-instance Adjustable Quaternion' where
-  adjust f E' (Quaternion' a b c d) = Quaternion' (f a) b c d
-  adjust f I' (Quaternion' a b c d) = Quaternion' a (f b) c d
-  adjust f J' (Quaternion' a b c d) = Quaternion' a b (f c) d
-  adjust f K' (Quaternion' a b c d) = Quaternion' a b c (f d)
-
-instance Distributive Quaternion' where
-  distribute = distributeRep
-
-instance Functor Quaternion' where
-  fmap = fmapRep
-
-instance Zip Quaternion' where
-  zipWith f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) =
-    Quaternion' (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)
-
-instance ZipWithKey Quaternion' where
-  zipWithKey f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) =
-    Quaternion' (f E' a1 a2) (f I' b1 b2) (f J' c1 c2) (f K' d1 d2)
-
-instance Keyed Quaternion' where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Quaternion' where
-  (<.>) = apRep
-
-instance Applicative Quaternion' where
-  pure = pureRep
-  (<*>) = apRep
-
-instance Bind Quaternion' where
-  (>>-) = bindRep
-
-instance Monad Quaternion' where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader QuaternionBasis' Quaternion' where
-  ask = askRep
-  local = localRep
-
-instance Foldable Quaternion' where
-  foldMap f (Quaternion' a b c d) =
-    f a `mappend` f b `mappend` f c `mappend` f d
-
-instance FoldableWithKey Quaternion' where
-  foldMapWithKey f (Quaternion' a b c d) =
-    f E' a `mappend` f I' b `mappend` f J' c `mappend` f K' d
-
-instance Traversable Quaternion' where
-  traverse f (Quaternion' a b c d) =
-    Quaternion' <$> f a <*> f b <*> f c <*> f d
-
-instance TraversableWithKey Quaternion' where
-  traverseWithKey f (Quaternion' a b c d) =
-    Quaternion' <$> f E' a <*> f I' b <*> f J' c <*> f K' d
-
-instance Foldable1 Quaternion' where
-  foldMap1 f (Quaternion' a b c d) =
-    f a <> f b <> f c <> f d
-
-instance FoldableWithKey1 Quaternion' where
-  foldMapWithKey1 f (Quaternion' a b c d) =
-    f E' a <> f I' b <> f J' c <> f K' d
-
-instance Traversable1 Quaternion' where
-  traverse1 f (Quaternion' a b c d) =
-    Quaternion' <$> f a <.> f b <.> f c <.> f d
-
-instance TraversableWithKey1 Quaternion' where
-  traverseWithKey1 f (Quaternion' a b c d) =
-    Quaternion' <$> f E' a <.> f I' b <.> f J' c <.> f K' d
-
-instance HasTrie QuaternionBasis' where
-  type BaseTrie QuaternionBasis' = Quaternion'
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Quaternion' r) where
-  (+) = addRep
-  sinnum1p = sinnum1pRep
-
-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
-  sinnum = sinnumRep
-
-instance Group r => Group (Quaternion' r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Quaternion' r)
-
-instance Idempotent r => Idempotent (Quaternion' r)
-
-instance Partitionable r => Partitionable (Quaternion' r) where
-  partitionWith f (Quaternion' a b c d) = id =<<
-    partitionWith (\a1 a2 -> id =<<
-    partitionWith (\b1 b2 -> id =<<
-    partitionWith (\c1 c2 ->
-    partitionWith (\d1 d2 -> f (Quaternion' a1 b1 c1 d1)
-                               (Quaternion' a2 b2 c2 d2)
-                  ) d) c) b) a
-
--- | the trivial diagonal algebra
-instance (TriviallyInvolutive r, Semiring r) => Algebra r QuaternionBasis' where
-  mult f = f' where
-    fe = f E' E'
-    fi = f I' I'
-    fj = f J' J'
-    fk = f K' K'
-    f' E' = fe
-    f' I' = fi
-    f' J' = fj
-    f' K' = fk
-
-instance (TriviallyInvolutive r, Semiring r) => UnitalAlgebra r QuaternionBasis' where
-  unit = const
-
-
--- | dual quaternion comultiplication
-instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis' where
-  comult f = f' where
-    fe = f E'
-    fi = f I'
-    fj = f J'
-    fk = f K'
-    fe' = negate fe
-    fi' = negate fi
-    fj' = negate fj
-    fk' = negate fk
-    f' E' E' = fe
-    f' E' I' = fi
-    f' E' J' = fj
-    f' E' K' = fk
-    f' I' E' = fi
-    f' I' I' = fe'
-    f' I' J' = fk
-    f' I' K' = fj'
-    f' J' E' = fj
-    f' J' I' = fk'
-    f' J' J' = fe'
-    f' J' K' = fi
-    f' K' E' = fk
-    f' K' I' = fj
-    f' K' J' = fi'
-    f' K' K' = fe'
-
-instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis' where
-  counit f = f E'
-
-instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis'
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis' where
-  inv f E' = f E'
-  inv f b = negate (f b)
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis' where
-  coinv = inv
-
-instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis' where
-  antipode = inv
-
-instance (TriviallyInvolutive r, Semiring r) => Multiplicative (Quaternion' r) where
-  (*) = mulRep
-
-instance (TriviallyInvolutive r, Semiring r) => Semiring (Quaternion' r)
-
-instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion' r) where
-  one = oneRep
-
-instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion' r) where
-  fromNatural n = Quaternion' (fromNatural n) zero zero zero
-
-instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion' r) where
-  fromInteger n = Quaternion' (fromInteger n) zero zero zero
-
-instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion' r) (Quaternion' r) where
-  (.*) = (*)
-instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion' r) (Quaternion' r) where
-  (*.) = (*)
-
-instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion' r) where
-  -- without trivial involution, multiplication fails associativity, and we'd need to
-  -- support weaker multiplicative properties like Alternative and PowerAssociative
-  adjoint (Quaternion' a b c d) = Quaternion' a (negate b) (negate c) (negate d)
-
--- | Cayley-Dickson quaternion isomorphism (one way)
-complicate' :: Complicated c => QuaternionBasis' -> (c , c)
-complicate' E' = (e, e)
-complicate' I' = (i, e)
-complicate' J' = (e, i)
-complicate' K' = (i, i)
-
-scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r
-scalarPart' f = index f E'
-
-vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)
-vectorPart' f = (index f I', index f J', index f K')
-
-instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where
-  quadrance n = scalarPart' (adjoint n * n)
-
-instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion' r) where
-  recip q@(Quaternion' a b c d) = Quaternion' (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
-    where qq = quadrance q
diff --git a/Numeric/Coalgebra/Trigonometric.hs b/Numeric/Coalgebra/Trigonometric.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Trigonometric.hs
+++ /dev/null
@@ -1,250 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses
-           , FlexibleInstances
-           , TypeFamilies
-           , UndecidableInstances
-           , DeriveDataTypeable
-           , TypeOperators #-}
-module Numeric.Coalgebra.Trigonometric 
-  ( Trigonometric(..)
-  , TrigBasis(..)
-  , Trig(..)
-  ) where
-
-import Control.Applicative
-import Control.Monad.Reader.Class
-import Data.Data
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Ix
-import Data.Key
-import Data.Semigroup.Traversable
-import Data.Semigroup.Foldable
-import Data.Semigroup
-import Data.Traversable
-import Numeric.Algebra
-import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)
-import Numeric.Algebra.Distinguished.Class
-import Numeric.Algebra.Complex.Class
-import Numeric.Coalgebra.Trigonometric.Class
-
--- the dual complex basis
-data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
-data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)
-
-instance Distinguished TrigBasis where
-  e = Cos
-
-instance Complicated TrigBasis where
-  i = Sin
-
-instance Trigonometric TrigBasis where
-  cos = Cos
-  sin = Sin
-
-instance Rig r => Distinguished (Trig r) where
-  e = Trig one zero
-
-instance Rig r => Complicated (Trig r) where
-  i = Trig zero one
-
-instance Rig r => Trigonometric (Trig r) where
-  cos = Trig one zero
-  sin = Trig zero one
-
-instance Rig r => Distinguished (TrigBasis -> r) where
-  e = cos
-
-instance Rig r => Complicated (TrigBasis -> r) where
-  i = sin
-  
-instance Rig r => Trigonometric (TrigBasis -> r) where
-  cos Sin = zero
-  cos Cos = one
-
-  sin Sin = one
-  sin Cos = zero
-
-instance Rig r => Trigonometric (TrigBasis :->: r) where
-  cos = Trie cos
-  sin = Trie sin
-
-instance Rig r => Distinguished (TrigBasis :->: r) where
-  e = Trie e
-
-instance Rig r => Complicated (TrigBasis :->: r) where
-  i = Trie i
-  
-type instance Key Trig = TrigBasis
-
-instance Representable Trig where
-  tabulate f = Trig (f Cos) (f Sin)
-
-instance Indexable Trig where
-  index (Trig a _ ) Cos = a
-  index (Trig _ b ) Sin = b
-
-instance Lookup Trig where
-  lookup = lookupDefault
-
-instance Adjustable Trig where
-  adjust f Cos (Trig a b) = Trig (f a) b
-  adjust f Sin (Trig a b) = Trig a (f b)
-
-instance Distributive Trig where
-  distribute = distributeRep 
-
-instance Functor Trig where
-  fmap f (Trig a b) = Trig (f a) (f b)
-
-instance Zip Trig where
-  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)
-
-instance ZipWithKey Trig where
-  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f Cos a1 a2) (f Sin b1 b2)
-
-instance Keyed Trig where
-  mapWithKey = mapWithKeyRep
-
-instance Apply Trig where
-  (<.>) = apRep
-
-instance Applicative Trig where
-  pure = pureRep
-  (<*>) = apRep 
-
-instance Bind Trig where
-  (>>-) = bindRep
-
-instance Monad Trig where
-  return = pureRep
-  (>>=) = bindRep
-
-instance MonadReader TrigBasis Trig where
-  ask = askRep
-  local = localRep
-
-instance Foldable Trig where
-  foldMap f (Trig a b) = f a `mappend` f b
-
-instance FoldableWithKey Trig where
-  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin b
-
-instance Traversable Trig where
-  traverse f (Trig a b) = Trig <$> f a <*> f b
-
-instance TraversableWithKey Trig where
-  traverseWithKey f (Trig a b) = Trig <$> f Cos a <*> f Sin b
-
-instance Foldable1 Trig where
-  foldMap1 f (Trig a b) = f a <> f b
-
-instance FoldableWithKey1 Trig where
-  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin b
-
-instance Traversable1 Trig where
-  traverse1 f (Trig a b) = Trig <$> f a <.> f b
-
-instance TraversableWithKey1 Trig where
-  traverseWithKey1 f (Trig a b) = Trig <$> f Cos a <.> f Sin b
-
-instance HasTrie TrigBasis where
-  type BaseTrie TrigBasis = Trig
-  embedKey = id
-  projectKey = id
-
-instance Additive r => Additive (Trig r) where
-  (+) = addRep 
-  sinnum1p = sinnum1pRep
-
-instance LeftModule r s => LeftModule r (Trig s) where
-  r .* Trig a b = Trig (r .* a) (r .* b)
-
-instance RightModule r s => RightModule r (Trig s) where
-  Trig a b *. r = Trig (a *. r) (b *. r)
-
-instance Monoidal r => Monoidal (Trig r) where
-  zero = zeroRep
-  sinnum = sinnumRep
-
-instance Group r => Group (Trig r) where
-  (-) = minusRep
-  negate = negateRep
-  subtract = subtractRep
-  times = timesRep
-
-instance Abelian r => Abelian (Trig r)
-
-instance Idempotent r => Idempotent (Trig r)
-
-instance Partitionable r => Partitionable (Trig r) where
-  partitionWith f (Trig a b) = id =<<
-    partitionWith (\a1 a2 -> 
-    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a
-
--- the diagonal algebra
-instance (Commutative k, Rng k) => Algebra k TrigBasis where
-  mult f = f' where
-    fc = f Cos Cos
-    fs = f Sin Sin
-    f' Cos = fc
-    f' Sin = fs
-
--- 
-instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where
-  unit = const
-
--- The trigonometric coalgebra
-instance (Commutative k, Rng k) => Coalgebra k TrigBasis where
-  comult f = f' where
-     fs = f Sin
-     fc = f Cos
-     fc' = negate fc
-     f' Sin Sin = fc'
-     f' Sin Cos = fs 
-     f' Cos Sin = fs
-     f' Cos Cos = fc
-
-instance (Commutative k, Rng k) => Bialgebra k TrigBasis
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where
-  inv f = f' where
-    afc = adjoint (f Cos)
-    nfs = negate (f Sin)
-    f' Cos = afc
-    f' Sin = nfs
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where
-  coinv = inv
-
-instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where
-  antipode = inv
-
-instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where
-  counit f = f Cos
-
-instance (Commutative k, Rng k) => Multiplicative (Trig k) where
-  (*) = mulRep
-
-instance (Commutative k, Rng k) => Commutative (Trig k)
-
-instance (Commutative k, Rng k) => Semiring (Trig k)
-
-instance (Commutative k, Ring k) => Unital (Trig k) where
-  one = Trig one zero
-
-instance (Commutative r, Ring r) => Rig (Trig r) where
-  fromNatural n = Trig (fromNatural n) zero
-
-instance (Commutative r, Ring r) => Ring (Trig r) where
-  fromInteger n = Trig (fromInteger n) zero
-
-instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)
-instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)
-
-instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where
-  adjoint (Trig a b) = Trig (adjoint a) (negate b)
-
-instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
diff --git a/Numeric/Coalgebra/Trigonometric/Class.hs b/Numeric/Coalgebra/Trigonometric/Class.hs
deleted file mode 100644
--- a/Numeric/Coalgebra/Trigonometric/Class.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Numeric.Coalgebra.Trigonometric.Class
-  ( Trigonometric(..)
-  ) where
-
-import Prelude (return)
-import Numeric.Covector
-
-class Trigonometric r where
-  cos :: r
-  sin :: r
-
-instance Trigonometric a => Trigonometric (Covector r a) where
-  cos = return cos
-  sin = return sin
diff --git a/Numeric/Covector.hs b/Numeric/Covector.hs
deleted file mode 100644
--- a/Numeric/Covector.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-{-# LANGUAGE 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.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
-  sinnum1p n (Covector m) = Covector $ sinnum1p n m
-
-instance Coalgebra r m => Multiplicative (Covector r m) where
-  Covector f * Covector g = Covector $ \k -> f (\m -> g (comult k m))
-
-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
-  sinnum n (Covector m) = Covector (sinnum 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
deleted file mode 100644
--- a/Numeric/Decidable/Associates.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-module Numeric.Decidable.Associates 
-  ( DecidableAssociates(..)
-  , isAssociateIntegral
-  , isAssociateWhole
-  ) where
-
-import Data.Function (on)
-import Data.Int
-import Data.Word
-import Numeric.Algebra.Unital
-import Numeric.Natural.Internal
-
-isAssociateIntegral :: (Eq n, Num n) => n -> n -> Bool
-isAssociateIntegral = (==) `on` abs
-
-isAssociateWhole :: Eq n => n -> n -> Bool
-isAssociateWhole = (==)
-
-class Unital r => DecidableAssociates r where
-  -- | b is an associate of a if there exists a unit u such that b = a*u
-  --
-  -- This relationship is symmetric because if u is a unit, u^-1 exists and is a unit, so
-  -- 
-  -- > b*u^-1 = a*u*u^-1 = a
-  isAssociate :: r -> r -> Bool
-
-instance DecidableAssociates Bool where isAssociate = (==)
-instance DecidableAssociates Integer where isAssociate = isAssociateIntegral
-instance DecidableAssociates Int where isAssociate = isAssociateIntegral
-instance DecidableAssociates Int8 where isAssociate = isAssociateIntegral
-instance DecidableAssociates Int16 where isAssociate = isAssociateIntegral
-instance DecidableAssociates Int32 where isAssociate = isAssociateIntegral
-instance DecidableAssociates Int64 where isAssociate = isAssociateIntegral
-
-instance DecidableAssociates Natural where isAssociate = isAssociateWhole
-instance DecidableAssociates Word where isAssociate = isAssociateWhole
-instance DecidableAssociates Word8 where isAssociate = isAssociateWhole
-instance DecidableAssociates Word16 where isAssociate = isAssociateWhole
-instance DecidableAssociates Word32 where isAssociate = isAssociateWhole
-instance DecidableAssociates Word64 where isAssociate = isAssociateWhole
-
-instance DecidableAssociates () where isAssociate _ _ = True
-
-instance (DecidableAssociates a, DecidableAssociates b) => DecidableAssociates (a, b) where
-  isAssociate (a,b) (i,j) = isAssociate a i && isAssociate b j
-
-instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c) => DecidableAssociates (a, b, c) where
-  isAssociate (a,b,c) (i,j,k) = isAssociate a i && isAssociate b j && isAssociate c k
-
-instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d) => DecidableAssociates (a, b, c, d) where
-  isAssociate (a,b,c,d) (i,j,k,l) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l
-
-instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d, DecidableAssociates e) => DecidableAssociates (a, b, c, d, e) where
-  isAssociate (a,b,c,d,e) (i,j,k,l,m) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l && isAssociate e m
diff --git a/Numeric/Decidable/Units.hs b/Numeric/Decidable/Units.hs
deleted file mode 100644
--- a/Numeric/Decidable/Units.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-module Numeric.Decidable.Units 
-  ( DecidableUnits(..)
-  , recipUnitIntegral
-  , recipUnitWhole
-  ) where
-
-import Data.Maybe (isJust)
-import Data.Int
-import Data.Word
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Natural.Internal
-import Control.Applicative
-import Prelude hiding ((*))
-
-class Unital r => DecidableUnits r where
-  recipUnit :: r -> Maybe r
-
-  isUnit :: DecidableUnits r => r -> Bool
-  isUnit = isJust . recipUnit
-
-  (^?) :: Integral n => r -> n -> Maybe r
-  x0 ^? y0 = case compare y0 0 of
-    LT -> fmap (`f` negate y0) (recipUnit x0)
-    EQ -> Just one
-    GT -> Just (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)
-
-recipUnitIntegral :: Integral r => r -> Maybe r
-recipUnitIntegral a@1 = Just a
-recipUnitIntegral a@(-1) = Just a
-recipUnitIntegral _ = Nothing
-
-recipUnitWhole :: Integral r => r -> Maybe r
-recipUnitWhole a@1 = Just a
-recipUnitWhole _ = Nothing
-
-instance DecidableUnits Bool where 
-  recipUnit False = Nothing
-  recipUnit True = Just True
-instance DecidableUnits Integer where recipUnit = recipUnitIntegral
-instance DecidableUnits Int where recipUnit = recipUnitIntegral
-instance DecidableUnits Int8 where recipUnit = recipUnitIntegral
-instance DecidableUnits Int16 where recipUnit = recipUnitIntegral
-instance DecidableUnits Int32 where recipUnit = recipUnitIntegral
-instance DecidableUnits Int64 where recipUnit = recipUnitIntegral
-instance DecidableUnits Natural where recipUnit = recipUnitWhole
-instance DecidableUnits Word where recipUnit = recipUnitWhole
-instance DecidableUnits Word8 where recipUnit = recipUnitWhole
-instance DecidableUnits Word16 where recipUnit = recipUnitWhole
-instance DecidableUnits Word32 where recipUnit = recipUnitWhole
-instance DecidableUnits Word64 where recipUnit = recipUnitWhole
-instance DecidableUnits () where recipUnit _ = Just ()
-
-instance (DecidableUnits a, DecidableUnits b) => DecidableUnits (a, b) where
-  recipUnit (a,b) = (,) <$> recipUnit a <*> recipUnit b
-
-instance (DecidableUnits a, DecidableUnits b, DecidableUnits c) => DecidableUnits (a, b, c) where
-  recipUnit (a,b,c) = (,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c
-
-instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d) => DecidableUnits (a, b, c, d) where
-  recipUnit (a,b,c,d) = (,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d
-
-instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d, DecidableUnits e) => DecidableUnits (a, b, c, d, e) where
-  recipUnit (a,b,c,d,e) = (,,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d <*> recipUnit e
diff --git a/Numeric/Decidable/Zero.hs b/Numeric/Decidable/Zero.hs
deleted file mode 100644
--- a/Numeric/Decidable/Zero.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-module Numeric.Decidable.Zero 
-  ( DecidableZero(..)
-  ) where
-
-import Numeric.Algebra.Class
-import Data.Int
-import Data.Word
-import Numeric.Natural.Internal
-
-class Monoidal r => DecidableZero r where
-  isZero :: r -> Bool
-
-instance DecidableZero Bool where isZero = not
-instance DecidableZero Integer where isZero = (0==)
-instance DecidableZero Int where isZero = (0==)
-instance DecidableZero Int8 where isZero = (0==)
-instance DecidableZero Int16 where isZero = (0==)
-instance DecidableZero Int32 where isZero = (0==)
-instance DecidableZero Int64 where isZero = (0==)
-
-instance DecidableZero Natural where isZero = (0==)
-instance DecidableZero Word where isZero = (0==)
-instance DecidableZero Word8 where isZero = (0==)
-instance DecidableZero Word16 where isZero = (0==)
-instance DecidableZero Word32 where isZero = (0==)
-instance DecidableZero Word64 where isZero = (0==)
-
-instance DecidableZero () where isZero _ = True
-
-instance (DecidableZero a, DecidableZero b) => DecidableZero (a, b) where
-  isZero (a,b) = isZero a && isZero b
-
-instance (DecidableZero a, DecidableZero b, DecidableZero c) => DecidableZero (a, b, c) where
-  isZero (a,b,c) = isZero a && isZero b && isZero c
-
-instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d) => DecidableZero (a, b, c, d) where
-  isZero (a,b,c,d) = isZero a && isZero b && isZero c && isZero d
-
-instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d, DecidableZero e) => DecidableZero (a, b, c, d, e) where
-  isZero (a,b,c,d,e) = isZero a && isZero b && isZero c && isZero d && isZero e
diff --git a/Numeric/Dioid/Class.hs b/Numeric/Dioid/Class.hs
deleted file mode 100644
--- a/Numeric/Dioid/Class.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/Numeric/Exp.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Numeric.Exp
-  ( Exp(..)
-  ) where
-
-import Data.Function (on)
-import Numeric.Algebra
-
-import Prelude hiding ((+),(-),negate,replicate,subtract)
-
-newtype Exp r = Exp { runExp :: r } 
-
-instance Additive r => Multiplicative (Exp r) where
-  Exp a * Exp b = Exp (a + b)
-  productWith1 f = Exp . sumWith1 (runExp . f)
-  pow1p (Exp m) n = Exp (sinnum1p n m)
-
-instance Monoidal r => Unital (Exp r) where
-  one = Exp zero
-  pow (Exp m) n = Exp (sinnum n m)
-  productWith f = Exp . sumWith (runExp . f)
-
-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)
-  Exp m ^ n = Exp (times n m)
-
-instance Abelian r => Commutative (Exp r)
-
-instance Idempotent r => Band (Exp r)
-
-instance Partitionable r => Factorable (Exp r) where
-  factorWith f = partitionWith (f `on` Exp) . runExp
diff --git a/Numeric/Field/Class.hs b/Numeric/Field/Class.hs
deleted file mode 100644
--- a/Numeric/Field/Class.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
-module Numeric.Field.Class 
-  ( Field
-  ) where
-
-import Numeric.Ring.Division
-import Numeric.Algebra.Commutative
-
-class (Commutative r, DivisionRing r) => Field r
-instance (Commutative r, DivisionRing r) => Field r
diff --git a/Numeric/Log.hs b/Numeric/Log.hs
deleted file mode 100644
--- a/Numeric/Log.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-module Numeric.Log 
-  ( Log(..)
-  ) where
-
-import Data.Function (on)
-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)
-  sinnum1p n (Log m) = Log (pow1p m n)
-
-instance Unital r => LeftModule Natural (Log r) where
-  n .* Log m = Log (pow m n)
-
-instance Unital r => RightModule Natural (Log r) where
-  Log m *. n = Log (pow m n)
-
-instance Unital r => Monoidal (Log r) where
-  zero = Log one
-  sinnum n (Log m) = Log (pow m n)
-  sumWith f = Log . productWith (runLog . f)
-
-instance Division r => LeftModule Integer (Log r) where
-  n .* Log m = Log (m ^ n)
-
-instance Division r => RightModule Integer (Log r) where
-  Log m *. n = Log (m ^ n)
-
-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)
-  times n (Log m) = Log (m ^ n)
-
-instance Commutative r => Abelian (Log r)
-
-instance Band r => Idempotent (Log r)
-
-instance Factorable r => Partitionable (Log r) where
-  partitionWith f = factorWith (f `on` Log) . runLog
diff --git a/Numeric/Map.hs b/Numeric/Map.hs
deleted file mode 100644
--- a/Numeric/Map.hs
+++ /dev/null
@@ -1,294 +0,0 @@
-{-# 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
-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)
-instance QFunctor (,) (Map r) (Map r)
-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
-  disassociate = arr disassociate
-
-instance Braided (Map r) (,) where
-  braid = arr braid
-
-instance Symmetric (Map r) (,)
-
-instance C.Monoidal (Map r) (,) where
-  type Id (Map r) (,) = ()
-  idl = arr C.idl
-  idr = arr C.idr
-  coidl = arr C.coidl
-  coidr = arr C.coidr
-
-instance Cartesian (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)
-instance QFunctor Either (Map r) (Map r)
-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
-  disassociate = arr disassociate
-
-instance Braided (Map r) Either where
-  braid = arr braid
-
-instance Symmetric (Map r) Either
-
-instance CoCartesian (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.Monoidal (Map r) Either where
-  type Id (Map r) Either = Void
-  idl = arr C.idl
-  idr = arr C.idr
-  coidl = arr C.coidl
-  coidr = arr C.coidr
-
-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
-  sinnum1p n (Map m) = Map $ sinnum1p 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
-  sinnum n (Map m) = Map $ sinnum 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/Module/Class.hs b/Numeric/Module/Class.hs
deleted file mode 100644
--- a/Numeric/Module/Class.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Numeric.Module.Class
-  (  
-  -- * Module over semirings
-    LeftModule(..)
-  , RightModule(..)
-  , Module
-  ) where
-
-import Numeric.Algebra.Class
diff --git a/Numeric/Module/Representable.hs b/Numeric/Module/Representable.hs
deleted file mode 100644
--- a/Numeric/Module/Representable.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}
-module Numeric.Module.Representable 
-  ( 
-  -- * Representable Additive
-    addRep, sinnum1pRep
-  -- * Representable Monoidal
-  , zeroRep, sinnumRep
-  -- * 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.sinnum1p` default definition
-sinnum1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r
-sinnum1pRep = fmap . sinnum1p
-
--- | `Monoidal.zero` default definition
-zeroRep :: (Applicative m, Monoidal r) => m r 
-zeroRep = pure zero
-
--- | `Monoidal.sinnum` default definition
-sinnumRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r
-sinnumRep = fmap . sinnum
-
--- | `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/Order/Additive.hs b/Numeric/Order/Additive.hs
deleted file mode 100644
--- a/Numeric/Order/Additive.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Numeric.Order.Additive
-  ( AdditiveOrder
-  ) where
-
-import Numeric.Natural.Internal
-import Numeric.Additive.Class
-import Numeric.Order.Class
-
--- An additive semigroup with a partial order (<=)
-
--- | z + x <= z + y = x <= y = x + z <= y + z
-class (Additive r, Order r) => AdditiveOrder r
-
-instance AdditiveOrder Integer
-instance AdditiveOrder Natural
-instance AdditiveOrder Bool
-instance AdditiveOrder ()
-instance (AdditiveOrder a, AdditiveOrder b) => AdditiveOrder (a,b)
-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c) => AdditiveOrder (a,b,c)
-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d) => AdditiveOrder (a,b,c,d)
-instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d, AdditiveOrder e) => AdditiveOrder (a,b,c,d,e)
diff --git a/Numeric/Order/Class.hs b/Numeric/Order/Class.hs
deleted file mode 100644
--- a/Numeric/Order/Class.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-module Numeric.Order.Class 
-  ( Order(..)
-  , orderOrd
-  ) where
-
-import Data.Int
-import Data.Word
-import Data.Set
-import Numeric.Natural.Internal
-
--- a partial order (a, <=)
-class Order a where
-  (<~) :: a -> a -> Bool
-  a <~ b = maybe False (<= EQ) (order a b)
-
-  (<) :: a -> a -> Bool
-  a < b = order a b == Just LT
-
-  (>~) :: a -> a -> Bool
-  a >~ b = b <~ a
-
-  (>) :: a -> a -> Bool
-  a > b = order a b == Just GT
-
-  (~~) :: a -> a -> Bool
-  a ~~ b = order a b == Just EQ
-
-  (/~) :: a -> a -> Bool
-  a /~ b = order a b /= Just EQ
-
-  order :: a -> a -> Maybe Ordering
-  order a b 
-    | a <~ b = Just $ if b <~ a 
-               then EQ
-               else LT
-    | b <~ a = Just GT
-    | otherwise = Nothing
-
-  comparable :: a -> a -> Bool
-  comparable a b = maybe False (const True) (order a b)
-
-
-orderOrd :: Ord a => a -> a -> Maybe Ordering
-orderOrd a b = Just (compare a b)
-
-instance Order Bool where order = orderOrd 
-instance Order Integer where order = orderOrd 
-instance Order Int where order = orderOrd 
-instance Order Int8 where order = orderOrd 
-instance Order Int16 where order = orderOrd 
-instance Order Int32 where order = orderOrd 
-instance Order Int64 where order = orderOrd 
-instance Order Natural where order = orderOrd 
-instance Order Word where order = orderOrd
-instance Order Word8 where order = orderOrd
-instance Order Word16 where order = orderOrd
-instance Order Word32 where order = orderOrd
-instance Order Word64 where order = orderOrd
-instance Ord a => Order (Set a) where
-  (<~) = isSubsetOf
-
-instance Order () where 
-  order _ _ = Just EQ
-  _ <~ _ = True
-  comparable _ _ = True
-
-instance (Order a, Order b) => Order (a, b) where 
-  (a,b) <~ (i,j) = a <~ i && b <~ j
-
-instance (Order a, Order b, Order c) => Order (a, b, c) where 
-  (a,b,c) <~ (i,j,k) = a <~ i && b <~ j && c <~ k
-
-instance (Order a, Order b, Order c, Order d) => Order (a, b, c, d) where 
-  (a,b,c,d) <~ (i,j,k,l) = a <~ i && b <~ j && c <~ k && d <~ l
-
-instance (Order a, Order b, Order c, Order d, Order e) => Order (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
diff --git a/Numeric/Order/LocallyFinite.hs b/Numeric/Order/LocallyFinite.hs
deleted file mode 100644
--- a/Numeric/Order/LocallyFinite.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-module Numeric.Order.LocallyFinite 
-  ( LocallyFiniteOrder(..)
-  ) where
-
-import Control.Applicative
-import Numeric.Additive.Class
-import Numeric.Additive.Group
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Numeric.Order.Class
-import Numeric.Natural.Internal
-import Numeric.Rig.Class
-import Numeric.Ring.Class
-import Data.Int
-import Data.Bits
-import Data.Word
-import Data.Set (Set)
-import qualified Data.Set as Set
-import qualified Data.Ix as Ix
-import Prelude hiding ((*),(+),fromIntegral,(<),negate,(-))
-
-class Order a => LocallyFiniteOrder a where
-  range :: a -> a -> [a]
-  rangeSize :: a -> a -> Natural
-
-  -- moebiusInversion inversion
-  moebiusInversion :: Ring r => a -> a -> r
-  moebiusInversion x y = case order x y of
-    Just EQ -> one
-    Just LT -> sumWith (\z -> if z < y then moebiusInversion x z else zero) $ range x y
-    _  -> zero 
-
-instance LocallyFiniteOrder Natural where
-  range = curry Ix.range
-  rangeSize a b 
-    | a <= b = Natural (runNatural b - runNatural a + 1)
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | unsafePred y == x -> negate one 
-     _ -> zero
-
-instance LocallyFiniteOrder Integer where
-  range = curry Ix.range
-  rangeSize a b 
-    | a <= b = Natural (b - a + 1)
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance Ord a => LocallyFiniteOrder (Set a) where
-  range a b 
-    | Set.isSubsetOf a b = go a $ Set.toList $ Set.difference b a
-    | otherwise = []
-    where 
-      go _ [] = []
-      go s (x:xs) = do
-        s' <- [s, Set.insert x s]
-        go s' xs
-  rangeSize a b 
-    | Set.isSubsetOf a b = fromNatural $ shiftL 1 $ Set.size b - Set.size a
-    | otherwise = zero
-  moebiusInversion a b 
-    | Set.isSubsetOf a b = 
-      if (Set.size b - Set.size a) .&. 1 == 0 
-      then one 
-      else negate one
-    | otherwise          = zero
-
-instance LocallyFiniteOrder Bool where
-  range False False = [False]
-  range False True  = [False, True]
-  range True  False = []
-  range True  True  = [True]
-  rangeSize False False = 1
-  rangeSize False True  = 2
-  rangeSize True  False = 0 
-  rangeSize True  True  = 1
-  moebiusInversion False False = one
-  moebiusInversion False True  = negate one 
-  moebiusInversion True  False = zero
-  moebiusInversion True  True  = one
-
-
-instance LocallyFiniteOrder Int where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Int8 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Int16 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Int32 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Int64 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Word where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Word8 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Word16 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Word32 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder Word64 where
-  range = curry Ix.range
-  rangeSize a b
-    | a <= b = Natural $ fromIntegral $ b - a + 1
-    | otherwise = 0
-  moebiusInversion x y = case compare x y of
-     EQ -> one
-     LT | y - 1 == x -> negate one 
-     _  -> zero
-
-instance LocallyFiniteOrder () where
-  range _ _ = [()]
-  rangeSize _ _ = 1
-  moebiusInversion _ _ = one
-
-instance ( LocallyFiniteOrder a
-         , LocallyFiniteOrder b
-         ) => LocallyFiniteOrder (a,b) where
-  range (a,b) (i,j) = (,) <$> range a i <*> range b j
-  rangeSize (a,b) (i,j) = rangeSize a i * rangeSize b j
-  -- TODO: check this against the default definition above
-  moebiusInversion (a,b) (i,j) = moebiusInversion a i * moebiusInversion b j
-
-instance ( LocallyFiniteOrder a
-         , LocallyFiniteOrder b
-         , LocallyFiniteOrder c
-         ) => LocallyFiniteOrder (a,b,c) where
-  range (a,b,c) (i,j,k) = (,,) <$> range  a i <*> range b j <*> range c k
-  rangeSize (a,b,c) (i,j,k) = rangeSize a i * rangeSize b j * rangeSize c k
-  moebiusInversion (a,b,c) (i,j,k) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k
-
-
-instance ( LocallyFiniteOrder a
-         , LocallyFiniteOrder b
-         , LocallyFiniteOrder c
-         , LocallyFiniteOrder d
-         ) => LocallyFiniteOrder (a,b,c,d) where
-  range (a,b,c,d) (i,j,k,l) = (,,,) <$> range  a i <*> range b j <*> range c k <*> range d l
-  rangeSize (a,b,c,d) (i,j,k,l) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l
-  moebiusInversion (a,b,c,d) (i,j,k,l) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l
-
-instance ( LocallyFiniteOrder a
-         , LocallyFiniteOrder b
-         , LocallyFiniteOrder c
-         , LocallyFiniteOrder d
-         , LocallyFiniteOrder e
-         ) => LocallyFiniteOrder (a, b, c, d, e) where
-  range (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> range  a i <*> range b j <*> range c k <*> range d l <*> range e m
-  rangeSize (a,b,c,d,e) (i,j,k,l,m) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l * rangeSize e m
-  moebiusInversion (a,b,c,d,e) (i,j,k,l,m) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l * moebiusInversion e m
-
diff --git a/Numeric/Partial/Group.hs b/Numeric/Partial/Group.hs
deleted file mode 100644
--- a/Numeric/Partial/Group.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-module Numeric.Partial.Group
-  ( PartialGroup(..)
-  ) where
-
-import Control.Applicative
-import Data.Int
-import Data.Word
-import Numeric.Partial.Semigroup
-import Numeric.Partial.Monoid
-import Numeric.Natural
-
-class PartialMonoid a => PartialGroup a where
-  pnegate :: a -> Maybe a
-  pnegate = pminus pzero
-
-  pminus :: a -> a -> Maybe a
-  pminus a b = padd a =<< pnegate b 
-
-  psubtract :: a -> a -> Maybe a
-  psubtract a b = pnegate a >>= (`padd` b)
-
-instance PartialGroup Int where
-  pnegate = Just . negate
-
-instance PartialGroup Integer where
-  pnegate = Just . negate
-
-instance PartialGroup Int8 where
-  pnegate = Just . negate
-
-instance PartialGroup Int16 where
-  pnegate = Just . negate
-
-instance PartialGroup Int32 where
-  pnegate = Just . negate
-
-instance PartialGroup Int64 where
-  pnegate = Just . negate
-
-instance PartialGroup Word where
-  pnegate = Just . negate
-
-instance PartialGroup Word8 where
-  pnegate = Just . negate
-
-instance PartialGroup Word16 where
-  pnegate = Just . negate
-
-instance PartialGroup Word32 where
-  pnegate = Just . negate
-
-instance PartialGroup Word64 where
-  pnegate = Just . negate
-
-instance PartialGroup Natural where
-  pnegate 0 = Just 0
-  pnegate _ = Nothing
-  pminus a b 
-    | a < b = Nothing
-    | otherwise = Just (a - b)
-  psubtract a b 
-    | a > b = Nothing
-    | otherwise = Just (b - a)
-
-instance PartialGroup () where
-  pnegate _ = Just () 
-  pminus _ _ = Just ()
-  psubtract _ _ = Just ()
-
-instance (PartialGroup a, PartialGroup b) => PartialGroup (a, b) where
-  pnegate (a, b) = (,) <$> pnegate a <*> pnegate b
-  pminus (a, b) (i, j) = (,) <$> pminus a i <*> pminus b j
-  psubtract (a, b) (i, j) = (,) <$> psubtract a i <*> psubtract b j
-
-instance (PartialGroup a, PartialGroup b, PartialGroup c) => PartialGroup (a, b, c) where
-  pnegate (a, b, c) = (,,) <$> pnegate a <*> pnegate b <*> pnegate c
-  pminus (a, b, c) (i, j, k) = (,,) <$> pminus a i <*> pminus b j <*> pminus c k
-  psubtract (a, b, c) (i, j, k) = (,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k
-
-instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d) => PartialGroup (a, b, c, d) where
-  pnegate (a, b, c, d) = (,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d
-  pminus (a, b, c, d) (i, j, k, l) = (,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l
-  psubtract (a, b, c, d) (i, j, k, l) = (,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l
-
-instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d, PartialGroup e) => PartialGroup (a, b, c, d, e) where
-  pnegate (a, b, c, d, e) = (,,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d <*> pnegate e
-  pminus (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l <*> pminus e m
-  psubtract (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l <*> psubtract e m
diff --git a/Numeric/Partial/Monoid.hs b/Numeric/Partial/Monoid.hs
deleted file mode 100644
--- a/Numeric/Partial/Monoid.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-module Numeric.Partial.Monoid
-  ( PartialMonoid(..)
-  ) where
-
-import Numeric.Partial.Semigroup
-import Data.Int
-import Data.Word
-import Numeric.Natural.Internal
-
-class PartialSemigroup a => PartialMonoid a where
-  pzero :: a
-
-instance PartialMonoid Bool where
-  pzero = False
-
-instance PartialMonoid Int where
-  pzero = 0
-
-instance PartialMonoid Integer where
-  pzero = 0
-
-instance PartialMonoid Natural where
-  pzero = 0
-
-instance PartialMonoid Int8 where
-  pzero = 0
-
-instance PartialMonoid Int16 where
-  pzero = 0
-
-instance PartialMonoid Int32 where
-  pzero = 0
-
-instance PartialMonoid Int64 where
-  pzero = 0
-
-instance PartialMonoid Word where
-  pzero = 0
-
-instance PartialMonoid Word8 where
-  pzero = 0
-
-instance PartialMonoid Word16 where
-  pzero = 0
-
-instance PartialMonoid Word32 where
-  pzero = 0
-
-instance PartialMonoid Word64 where
-  pzero = 0
-
-instance PartialMonoid () where
-  pzero = () 
-
-instance PartialSemigroup a => PartialMonoid (Maybe a) where
-  pzero = Nothing
-
-instance (PartialMonoid a, PartialMonoid b) => PartialMonoid (a, b) where
-  pzero = (pzero, pzero)
-
-instance (PartialMonoid a, PartialMonoid b, PartialMonoid c) => PartialMonoid (a, b, c) where
-  pzero = (pzero, pzero, pzero)
-
-instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d) => PartialMonoid (a, b, c, d) where
-  pzero = (pzero, pzero, pzero, pzero)
-
-instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d, PartialMonoid e) => PartialMonoid (a, b, c, d, e) where
-  pzero = (pzero, pzero, pzero, pzero, pzero)
diff --git a/Numeric/Partial/Semigroup.hs b/Numeric/Partial/Semigroup.hs
deleted file mode 100644
--- a/Numeric/Partial/Semigroup.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module Numeric.Partial.Semigroup
-  ( PartialSemigroup(..)
-  ) where
-
-import Control.Applicative
-import Data.Word
-import Data.Int
-import Numeric.Natural.Internal
-
-class PartialSemigroup a where
-  padd :: a -> a -> Maybe a
-
-paddNum :: Num a => a -> a -> Maybe a
-paddNum a b = Just (a + b)
-
-
-instance PartialSemigroup Int where
-  padd = paddNum
-
-instance PartialSemigroup Integer where
-  padd = paddNum
-
-instance PartialSemigroup Natural where
-  padd = paddNum
-
-instance PartialSemigroup Int8 where
-  padd = paddNum
-
-instance PartialSemigroup Int16 where
-  padd = paddNum
-
-instance PartialSemigroup Int32 where
-  padd = paddNum
-
-instance PartialSemigroup Int64 where
-  padd = paddNum
-
-instance PartialSemigroup Word where
-  padd = paddNum
-
-instance PartialSemigroup Word8 where
-  padd = paddNum
-
-instance PartialSemigroup Word16 where
-  padd = paddNum
-
-instance PartialSemigroup Word32 where
-  padd = paddNum
-
-instance PartialSemigroup Word64 where
-  padd = paddNum
-
-instance PartialSemigroup a => PartialSemigroup (Maybe a) where
-  padd ma mb = Just $ do
-   a <- ma
-   b <- mb
-   padd a b
-
-instance PartialSemigroup Bool where
-  padd a b = Just (a || b)
-
-instance PartialSemigroup () where
-  padd _ _ = Just ()
-
-instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (a, b) where
-  padd (a,b) (i,j) = (,) <$> padd a i <*> padd b j
-
-instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c) => PartialSemigroup (a, b, c) where
-  padd (a,b,c) (i,j,k) = (,,) <$> padd a i <*> padd b j <*> padd c k
-
-instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d) => PartialSemigroup (a, b, c, d) where
-  padd (a,b,c,d) (i,j,k,l) = (,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l
-
-instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d, PartialSemigroup e) => PartialSemigroup (a, b, c, d, e) where
-  padd (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l <*> padd e m
-
-instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (Either a b) where
-  padd (Left a) (Left b) = Left <$> padd a b
-  padd (Right a) (Right b) = Right <$> padd a b
-  padd _ _ = Nothing
diff --git a/Numeric/Quadrance/Class.hs b/Numeric/Quadrance/Class.hs
deleted file mode 100644
--- a/Numeric/Quadrance/Class.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, 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/Characteristic.hs b/Numeric/Rig/Characteristic.hs
deleted file mode 100644
--- a/Numeric/Rig/Characteristic.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-module Numeric.Rig.Characteristic
-  ( Characteristic(..)
-  , charInt
-  , charWord
-  ) where
-
-import Data.Int
-import Data.Word
-import Numeric.Rig.Class
-import Numeric.Natural.Internal
-import Prelude hiding ((^))
-
-data Proxy p = Proxy
-
-class Rig r => Characteristic r where
-  char :: proxy r -> Natural
-
-charInt :: (Integral s, Bounded s) => proxy s -> Natural
-charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2
-
-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
-instance Characteristic Bool where char _ = 0
-instance Characteristic Integer where char _ = 0
-instance Characteristic Natural where char _ = 0
-instance Characteristic Int where char = charInt
-instance Characteristic Int8 where char = charInt
-instance Characteristic Int16 where char = charInt
-instance Characteristic Int32 where char = charInt
-instance Characteristic Int64 where char = charInt
-instance Characteristic Word where char = charWord
-instance Characteristic Word8 where char = charWord
-instance Characteristic Word16 where char = charWord
-instance Characteristic Word32 where char = charWord
-instance Characteristic Word64 where char = charWord
-instance Characteristic () where char _ = 1
-
-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
-    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
-    b :: proxy (a,b,c) -> Proxy b
-    b _ = Proxy
-    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
-    b :: proxy (a,b,c,d) -> Proxy b
-    b _ = Proxy
-    c :: proxy (a,b,c,d) -> Proxy c
-    c _ = Proxy
-    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
-    b :: proxy (a,b,c,d,e) -> Proxy b
-    b _ = Proxy
-    c :: proxy (a,b,c,d,e) -> Proxy c
-    c _ = Proxy
-    d :: proxy (a,b,c,d,e) -> Proxy d
-    d _ = Proxy
-    e :: proxy (a,b,c,d,e) -> Proxy e
-    e _ = Proxy
diff --git a/Numeric/Rig/Class.hs b/Numeric/Rig/Class.hs
deleted file mode 100644
--- a/Numeric/Rig/Class.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module Numeric.Rig.Class
-  ( Rig(..)
-  , fromNaturalNum
-  , fromWhole
-  ) where
-
-import Numeric.Algebra.Class
-import Numeric.Algebra.Unital
-import Data.Int
-import Data.Word
-import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))
-import Numeric.Natural.Internal
-
-fromNaturalNum :: Num r => Natural -> r
-fromNaturalNum (Natural n) = fromInteger n
-
--- | A Ring without (n)egation
-class (Semiring r, Unital r, Monoidal r) => Rig r where
-  fromNatural :: Natural -> r
-  fromNatural n = sinnum n one
-
-fromWhole :: (Whole n, Rig r) => n -> r
-fromWhole = fromNatural . toNatural
--- TODO: optimize
-
-instance Rig Integer where fromNatural = fromNaturalNum
-instance Rig Natural where fromNatural = id
-instance Rig Bool where fromNatural = (/=) 0
-instance Rig Int where fromNatural = fromNaturalNum
-instance Rig Int8 where fromNatural = fromNaturalNum
-instance Rig Int16 where fromNatural = fromNaturalNum
-instance Rig Int32 where fromNatural = fromNaturalNum
-instance Rig Int64 where fromNatural = fromNaturalNum
-instance Rig Word where fromNatural = fromNaturalNum
-instance Rig Word8 where fromNatural = fromNaturalNum
-instance Rig Word16 where fromNatural = fromNaturalNum
-instance Rig Word32 where fromNatural = fromNaturalNum
-instance Rig Word64 where fromNatural = fromNaturalNum
-instance Rig () where fromNatural _ = ()
-instance (Rig a, Rig b) => Rig (a, b) where
-  fromNatural n = (fromNatural n, fromNatural n)
-instance (Rig a, Rig b, Rig c) => Rig (a, b, c) where
-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n)
-instance (Rig a, Rig b, Rig c, Rig d) => Rig (a, b, c, d) where
-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n)
-instance (Rig a, Rig b, Rig c, Rig d, Rig e) => Rig (a, b, c, d, e) where
-  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n, fromNatural n)
diff --git a/Numeric/Rig/Ordered.hs b/Numeric/Rig/Ordered.hs
deleted file mode 100644
--- a/Numeric/Rig/Ordered.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Numeric.Rig.Ordered
-  ( OrderedRig
-  ) where
-
-import Numeric.Rig.Class
-import Numeric.Order.Additive
-import Numeric.Natural.Internal
-
--- x <= y ==> x + z <= y + z
--- 0 <= x && y <= z implies xy <= xz
--- 0 <= x <= 1
-class (AdditiveOrder r, Rig r) => OrderedRig r
-
-instance OrderedRig Integer
-instance OrderedRig Natural
-instance OrderedRig Bool
-instance OrderedRig ()
-instance (OrderedRig a, OrderedRig b) => OrderedRig (a, b) 
-instance (OrderedRig a, OrderedRig b, OrderedRig c) => OrderedRig (a, b, c) 
-instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d) => OrderedRig (a, b, c, d) 
-instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d, OrderedRig e) => OrderedRig (a, b, c, d, e) 
diff --git a/Numeric/Ring/Class.hs b/Numeric/Ring/Class.hs
deleted file mode 100644
--- a/Numeric/Ring/Class.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-module Numeric.Ring.Class
-  ( Ring(..)
-  , fromIntegral
-  ) where
-
-import Data.Int
-import Data.Word
-import Numeric.Rig.Class
-import Numeric.Rng.Class
-import Numeric.Additive.Group
-import Numeric.Algebra.Unital
-import qualified Prelude
-import Prelude (Integral(toInteger), Integer, (.))
-
-class (Rig r, Rng r) => Ring r where
-  fromInteger :: Integer -> r
-  fromInteger n = times n one
-
-fromIntegral :: (Integral n, Ring r) => n -> r
-fromIntegral = fromInteger . toInteger
-
-instance Ring Integer where fromInteger = Prelude.fromInteger
-instance Ring Int     where fromInteger = Prelude.fromInteger
-instance Ring Int8    where fromInteger = Prelude.fromInteger
-instance Ring Int16   where fromInteger = Prelude.fromInteger
-instance Ring Int32   where fromInteger = Prelude.fromInteger
-instance Ring Int64   where fromInteger = Prelude.fromInteger
-instance Ring Word    where fromInteger = Prelude.fromInteger
-instance Ring Word8   where fromInteger = Prelude.fromInteger
-instance Ring Word16  where fromInteger = Prelude.fromInteger
-instance Ring Word32  where fromInteger = Prelude.fromInteger
-instance Ring Word64  where fromInteger = Prelude.fromInteger
-instance Ring () where fromInteger _ = ()
-instance (Ring a, Ring b) => Ring (a, b) where
-  fromInteger n = (fromInteger n, fromInteger n)
-instance (Ring a, Ring b, Ring c) => Ring (a, b, c) where
-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
-instance (Ring a, Ring b, Ring c, Ring d) => Ring (a, b, c, d) where
-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
-instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a, b, c, d, e) where
-  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
diff --git a/Numeric/Ring/Division.hs b/Numeric/Ring/Division.hs
deleted file mode 100644
--- a/Numeric/Ring/Division.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
-module Numeric.Ring.Division
-  ( DivisionRing
-  ) where
-
-import Numeric.Algebra.Division
-import Numeric.Ring.Class
-
-class (Division r, Ring r) => DivisionRing r
-instance (Division r, Ring r) => DivisionRing r
diff --git a/Numeric/Ring/Endomorphism.hs b/Numeric/Ring/Endomorphism.hs
deleted file mode 100644
--- a/Numeric/Ring/Endomorphism.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Ring.Endomorphism 
-  ( End(..)
-  , toEnd
-  , fromEnd
-  , frobenius
-  ) where
-
-import Data.Monoid
-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
--- 
--- http://en.wikipedia.org/wiki/Endomorphism_ring
-newtype End a = End { appEnd :: a -> a }
-instance Monoid (End r) where
-  mappend (End a) (End b) = End (a . b)
-  mempty = End id
-instance Additive r => Additive (End r) where
-  End f + End g = End (f + g)
-instance Abelian r => Abelian (End r)
-instance Monoidal r => Monoidal (End r) where
-  zero = End (const zero)
-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)
-instance Multiplicative (End r) where
-  End f * End g = End (f . g)
-instance Unital (End r) where
-  one = End id
-instance (Abelian r, Commutative r) => Commutative (End r) 
-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 (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.
-toEnd :: Multiplicative r => r -> End r
-toEnd r = End (*r)
-
--- 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/Local.hs b/Numeric/Ring/Local.hs
deleted file mode 100644
--- a/Numeric/Ring/Local.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Numeric.Ring.Local 
-  ( LocalRing 
-  ) where
-
-import Numeric.Ring.Class
-
--- forall x in r, either x or 1 - x is a unit.
--- if a finite sum is a unit then so are some of its terms, so the empty sum is not a unit, and one /= zero.
-class Ring r => LocalRing r
-
diff --git a/Numeric/Ring/Opposite.hs b/Numeric/Ring/Opposite.hs
deleted file mode 100644
--- a/Numeric/Ring/Opposite.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-module Numeric.Ring.Opposite 
-  ( Opposite(..)
-  ) where
-
-import Data.Foldable
-import Data.Function (on)
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Traversable
-import Numeric.Algebra
-import Numeric.Decidable.Associates
-import Numeric.Decidable.Units
-import Numeric.Decidable.Zero
-import Prelude hiding ((-),(+),(*),(/),(^),recip,negate,subtract,replicate)
-
--- | http://en.wikipedia.org/wiki/Opposite_ring
-newtype Opposite r = Opposite { runOpposite :: r } deriving (Show,Read)
-instance Eq r => Eq (Opposite r) where
-  (==) = (==) `on` runOpposite
-instance Ord r => Ord (Opposite r) where
-  compare = compare `on` runOpposite
-instance Functor Opposite where
-  fmap f (Opposite r) = Opposite (f r)
-instance Foldable Opposite where
-  foldMap f (Opposite r) = f r
-instance Traversable Opposite where
-  traverse f (Opposite r) = fmap Opposite (f r)
-instance Foldable1 Opposite where
-  foldMap1 f (Opposite r) = f r
-instance Traversable1 Opposite where
-  traverse1 f (Opposite r) = fmap Opposite (f r)
-instance Additive r => Additive (Opposite r) where
-  Opposite a + Opposite b = Opposite (a + b)
-  sinnum1p n (Opposite a) = Opposite (sinnum1p n a)
-  sumWith1 f = Opposite . sumWith1 (runOpposite . f)
-instance Monoidal r => Monoidal (Opposite r) where
-  zero = Opposite zero
-  sinnum n (Opposite a) = Opposite (sinnum n a)
-  sumWith f = Opposite . sumWith (runOpposite . f)
-instance Semiring r => LeftModule (Opposite r) (Opposite r) where
-  (.*) = (*)
-instance RightModule r s => LeftModule r (Opposite s) where
-  r .* Opposite s = Opposite (s *. r)
-instance LeftModule r s => RightModule r (Opposite s) where
-  Opposite s *. r = Opposite (r .* s)
-instance Semiring r => RightModule (Opposite r) (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)
-  times n (Opposite a) = Opposite (times n a)
-instance Abelian r => Abelian (Opposite r)
-instance DecidableZero r => DecidableZero (Opposite r) where
-  isZero = isZero . runOpposite
-instance DecidableUnits r => DecidableUnits (Opposite r) where
-  recipUnit = fmap Opposite . recipUnit . runOpposite
-instance DecidableAssociates r => DecidableAssociates (Opposite r) where
-  isAssociate (Opposite a) (Opposite b) = isAssociate a b
-instance Multiplicative r => Multiplicative (Opposite r) where
-  Opposite a * Opposite b = Opposite (b * a)
-  pow1p (Opposite a) n = Opposite (pow1p a n)
-instance Commutative r => Commutative (Opposite r)
-instance Idempotent r => Idempotent (Opposite r)
-instance Band r => Band (Opposite r)
-instance Unital r => Unital (Opposite r) where
-  one = Opposite one
-  pow (Opposite a) n = Opposite (pow a n)
-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 Rig r => Rig (Opposite r)
-instance Ring r => Ring (Opposite r)
diff --git a/Numeric/Ring/Rng.hs b/Numeric/Ring/Rng.hs
deleted file mode 100644
--- a/Numeric/Ring/Rng.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Numeric.Ring.Rng
-  ( RngRing(..)
-  , rngRingHom
-  , liftRngHom
-  ) where
-
-import Numeric.Algebra
-import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)
-
--- | The free Ring given a Rng obtained by adjoining Z, such that
--- 
--- > RngRing r = n*1 + r
---
--- This ring is commonly denoted r^.
-data RngRing r = RngRing !Integer r deriving (Show,Read)
-
-instance Abelian r => Additive (RngRing r) where
-  RngRing n a + RngRing m b = RngRing (n + m) (a + b)
-  sinnum1p n (RngRing m a) = RngRing ((1 + toInteger n) * m) (sinnum1p n a)
-
-instance Abelian r => Abelian (RngRing r)
-
-instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where
-  n .* RngRing m a = RngRing (toInteger n * m) (sinnum n a)
-
-instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where
-  RngRing m a *. n = RngRing (toInteger n * m) (sinnum n a)
-
-instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where
-  zero = RngRing 0 zero
-  sinnum n (RngRing m a) = RngRing (toInteger n * m) (sinnum n a)
-
-instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where
-  n .* RngRing m a = RngRing (toInteger n * m) (times n a)
-
-instance (Abelian r, Group r) => RightModule Integer (RngRing r) where
-  RngRing m a *. n = RngRing (toInteger n * m) (times n a)
-
-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)
-  times n (RngRing m a) = RngRing (toInteger n * m) (times n a)
-
-instance Rng r => Multiplicative (RngRing r) where
-  RngRing n a * RngRing m b = RngRing (n*m) (times n b + times m a + a * b)
-
-instance (Commutative r, Rng r) => Commutative (RngRing r)
-
-instance Rng s => LeftModule (RngRing s) (RngRing s) where
-  (.*) = (*) 
-
-instance Rng s => RightModule (RngRing s) (RngRing s) where
-  (*.) = (*) 
-
-instance Rng r => Unital (RngRing r) where
-  one = RngRing 1 zero
-
-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 => Rig (RngRing r)
-
-instance Rng r => Ring (RngRing r)
-
--- | The rng homomorphism from r to RngRing r
-rngRingHom :: r -> RngRing r
-rngRingHom = RngRing 0
-
--- | given a rng homomorphism from a rng r into a ring s, liftRngHom yields a ring homomorphism from the ring `r^` into `s`.
-liftRngHom :: Ring s => (r -> s) -> RngRing r -> s
-liftRngHom g (RngRing n a) = times n one + g a
diff --git a/Numeric/Rng/Class.hs b/Numeric/Rng/Class.hs
deleted file mode 100644
--- a/Numeric/Rng/Class.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
-module Numeric.Rng.Class
-  ( Rng
-  ) where
-
-import Numeric.Additive.Group
-import Numeric.Algebra.Class
-
--- | A Ring without an /i/dentity.
-
-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
deleted file mode 100644
--- a/Numeric/Rng/Zero.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-module Numeric.Rng.Zero
-  ( ZeroRng(..)
-  ) where
-
-import Numeric.Algebra
-import Data.Foldable (toList)
-import Prelude hiding ((+),(-),negate,subtract,replicate)
-
--- *** The Zero Rng for an Abelian Group, adding the trivial product
---
--- > _ * _ = zero 
---
--- which distributes over (+)
-
--- ZeroRng/runZeroRng witness an additive Abelian group isomorphism to the zero rng.
-newtype ZeroRng r = ZeroRng { runZeroRng :: r } deriving (Eq,Ord,Show,Read)
-
-instance Additive r => Additive (ZeroRng r) where
-  ZeroRng a + ZeroRng b = ZeroRng (a + b)
-  sumWith1 f = ZeroRng . sumWith1 (runZeroRng . f)
-
-instance Idempotent r => Idempotent (ZeroRng r)
-
-instance Abelian r => Abelian (ZeroRng r)
-
-instance Monoidal r => Monoidal (ZeroRng r) where
-  zero = ZeroRng zero
-  sumWith f = ZeroRng . sumWith (runZeroRng . f)
-  sinnum n (ZeroRng a) = ZeroRng (sinnum n a)
-  
-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 Monoidal r => Multiplicative (ZeroRng r) where
-  _ * _ = zero
-  productWith1 f as = case toList as of
-    [] -> error "productWith1: empty Foldable1"
-    [a] -> f a
-    _   -> zero
-
-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
-  (.*) = sinnum
-instance Monoidal r => RightModule Natural (ZeroRng r) where
-  m *. n = sinnum n m
-instance Group r => LeftModule Integer (ZeroRng r) where
-  (.*) = times
-instance Group r => RightModule Integer (ZeroRng r) where
-  m *. n = times n m
diff --git a/Numeric/Semiring/Integral.hs b/Numeric/Semiring/Integral.hs
deleted file mode 100644
--- a/Numeric/Semiring/Integral.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Numeric.Semiring.Integral 
-  ( IntegralSemiring
-  ) where
-
-import Numeric.Algebra.Class
-import Numeric.Natural.Internal
-
--- | 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
-instance IntegralSemiring Bool
diff --git a/Numeric/Semiring/Involutive.hs b/Numeric/Semiring/Involutive.hs
deleted file mode 100644
--- a/Numeric/Semiring/Involutive.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Numeric.Semiring.Involutive 
-  ( InvolutiveSemiring
-  ) where
-
-import Numeric.Algebra.Involutive
diff --git a/algebra.cabal b/algebra.cabal
--- a/algebra.cabal
+++ b/algebra.cabal
@@ -1,6 +1,6 @@
 name:          algebra
 category:      Math, Algebra
-version:       2.1.1.2
+version:       3.0
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -20,6 +20,8 @@
   location: git://github.com/ekmett/algebra.git
 
 library
+  hs-source-dirs: src
+
   other-extensions:
     TypeOperators
     MultiParamTypeClasses
@@ -36,18 +38,18 @@
 
   build-depends:
     array                   >= 0.3.0.2 && < 0.5,
-    base                    >= 4       && < 5,
+    base                    == 4.*,
     distributive            >= 0.2.2   && < 0.3,
     transformers            >= 0.2     && < 0.4,
     tagged                  >= 0.4.2   && < 0.5,
     categories              >= 1.0     && < 1.1,
     containers              >= 0.3     && < 0.6,
-    keys                    >= 2.1.3.1 && < 2.2,
+    keys                    == 3.0.*,
     mtl                     >= 2.0.1   && < 2.2,
     semigroups              >= 0.8.3.1 && < 0.9,
-    semigroupoids           >= 1.3.1.2 && < 1.4,
-    representable-functors  >= 2.4.0.1 && < 2.5,
-    representable-tries     >= 2.4.0.1 && < 2.5,
+    semigroupoids           == 3.0.*,
+    representable-functors  == 3.0.*,
+    representable-tries     == 3.0.*,
     void                    >= 0.5.5.1 && < 0.6
 
   exposed-modules:
diff --git a/src/Numeric/Additive/Class.hs b/src/Numeric/Additive/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Additive/Class.hs
@@ -0,0 +1,226 @@
+{-# LANGUAGE TypeOperators #-}
+module Numeric.Additive.Class
+  ( 
+  -- * Additive Semigroups
+    Additive(..)
+  , sum1
+  -- * Additive Abelian semigroups
+  , Abelian
+  -- * Additive Monoids
+  , Idempotent
+  , sinnum1pIdempotent
+  -- * Partitionable semigroups
+  , Partitionable(..)
+  ) where
+
+import Data.Int
+import Data.Word
+import Data.Foldable hiding (concat)
+import Data.Semigroup.Foldable
+import Data.Key
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+-- import Data.Foldable hiding (concat)
+import Numeric.Natural.Internal
+import Prelude (fmap,(-),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)
+-- > sinnum 1 a = a
+-- > sinnum (2 * n) a = sinnum n a + sinnum n a
+-- > sinnum (2 * n + 1) a = sinnum n a + sinnum n a + a
+class Additive r where
+  (+) :: r -> r -> r
+
+  -- | sinnum1p n r = sinnum (1 + n) r
+  sinnum1p :: Whole n => n -> r -> r
+  sinnum1p 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 
+  sinnum1p n f e = sinnum1p n (f e)
+  sumWith1 f xs e = sumWith1 (`f` e) xs
+
+instance (HasTrie b, Additive r) => Additive (b :->: r) where
+  (+) = zipWith (+)
+  sinnum1p = fmap . sinnum1p
+  sumWith1 f xs = tabulate $ \e -> sumWith1 (\a -> index (f a) e) xs
+
+instance Additive Bool where
+  (+) = (||)
+  sinnum1p _ a = a
+
+instance Additive Natural where
+  (+) = (Prelude.+)
+  sinnum1p n r = (1 Prelude.+ toNatural n) * r
+
+instance Additive Integer where 
+  (+) = (Prelude.+)
+  sinnum1p n r = (1 Prelude.+ toInteger n) * r
+
+instance Additive Int where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int8 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int16 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int32 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Int64 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word8 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word16 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word32 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive Word64 where
+  (+) = (Prelude.+)
+  sinnum1p n r = fromIntegral (1 Prelude.+ n) * r
+
+instance Additive () where
+  _ + _ = ()
+  sinnum1p _ _ = () 
+  sumWith1 _ _ = ()
+
+instance (Additive a, Additive b) => Additive (a,b) where
+  (a,b) + (i,j) = (a + i, b + j)
+  sinnum1p n (a,b) = (sinnum1p n a, sinnum1p 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)
+  sinnum1p n (a,b,c) = (sinnum1p n a, sinnum1p n b, sinnum1p 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)
+  sinnum1p n (a,b,c,d) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p 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)
+  sinnum1p n (a,b,c,d,e) = (sinnum1p n a, sinnum1p n b, sinnum1p n c, sinnum1p n d, sinnum1p 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 (HasTrie e, 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
+
+sinnum1pIdempotent :: Natural -> r -> r
+sinnum1pIdempotent _ r = r
+
+instance Idempotent ()
+instance Idempotent Bool
+instance Idempotent r => Idempotent (e -> r)
+instance (HasTrie e, 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/src/Numeric/Additive/Group.hs b/src/Numeric/Additive/Group.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Additive/Group.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeOperators #-}
+module Numeric.Additive.Group
+  ( -- * Additive Groups
+    Group(..)
+  ) where
+
+import Data.Int
+import Data.Word
+import Data.Key
+import Data.Functor.Representable.Trie
+import Prelude hiding ((*), (+), (-), negate, subtract,zipWith)
+import qualified Prelude
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+
+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 (HasTrie e, Group r) => Group (e :->: r) where
+  (-) = zipWith (-)
+  negate = fmap negate
+  subtract = zipWith subtract
+  times = fmap . times
+
+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/src/Numeric/Algebra.hs b/src/Numeric/Algebra.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra.hs
@@ -0,0 +1,171 @@
+module Numeric.Algebra
+  ( 
+  -- * Additive
+
+  -- ** additive semigroups
+    Additive(..)
+  , sum1
+  -- ** additive Abelian semigroups
+  , Abelian
+  -- ** additive idempotent semigroups
+  , Idempotent
+  , sinnum1pIdempotent
+  , sinnumIdempotent
+  -- ** 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(..)
+  -- ** Division Rings
+  , LocalRing
+  , DivisionRing
+  , Field
+
+  -- * 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
+  , CocommutativeCoalgebra
+  -- ** division algebras
+  , DivisionAlgebra(..)
+  -- ** Hopf alegebras
+  , HopfAlgebra(..)
+
+  -- * Ring Properties
+  -- ** Characteristic
+  , Characteristic(..)
+  , charInt, charWord
+  -- ** Order
+  , Order(..)
+  , OrderedRig
+  , AdditiveOrder
+  , LocallyFiniteOrder
+
+  , DecidableZero
+  , DecidableUnits
+  , DecidableAssociates
+
+  -- * Natural numbers
+  , Natural
+  , Whole(toNatural)
+
+  -- * Representable Additive
+  , addRep, sinnum1pRep
+  -- * Representable Monoidal
+  , zeroRep, sinnumRep
+  -- * 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.Order.LocallyFinite
+import Numeric.Quadrance.Class
+import Numeric.Rig.Class
+import Numeric.Rig.Characteristic
+import Numeric.Rig.Ordered
+import Numeric.Rng.Class
+import Numeric.Ring.Class
+import Numeric.Ring.Local
+import Numeric.Ring.Division
+import Numeric.Field.Class
diff --git a/src/Numeric/Algebra/Class.hs b/src/Numeric/Algebra/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Class.hs
@@ -0,0 +1,600 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}
+module Numeric.Algebra.Class 
+  (
+  -- * Multiplicative Semigroups
+    Multiplicative(..)
+  , pow1pIntegral
+  , product1
+  -- * Semirings
+  , Semiring
+  -- * Left and Right Modules
+  , LeftModule(..)
+  , RightModule(..)
+  , Module
+  -- * Additive Monoids
+  , Monoidal(..)
+  , sum
+  , sinnumIdempotent
+  -- * Associative algebras
+  , Algebra(..)
+  -- * Coassociative coalgebras
+  , Coalgebra(..)
+  ) where
+
+import Control.Applicative
+import Data.Foldable hiding (sum, concat)
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Int
+import Data.IntMap (IntMap)
+import Data.IntSet (IntSet)
+import Data.Key
+import Data.Map (Map)
+import Data.Monoid (mappend)
+-- import Data.Semigroup.Foldable
+import Data.Sequence hiding (reverse,index)
+import Data.Semigroup.Foldable
+import Data.Set (Set)
+import Data.Word
+import Numeric.Additive.Class
+import Numeric.Natural.Internal
+import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat)
+import qualified Data.IntMap as IntMap
+import qualified Data.IntSet as IntSet
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import qualified Prelude
+
+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)
+
+instance Algebra r a => Multiplicative (a -> r) where
+  f * g = mult $ \a b -> f a * g b
+instance (HasTrie a, Algebra r a) => Multiplicative (a :->: r) where
+  f * g = tabulate $ mult $ \a b -> index f a * index g b
+
+-- | 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)
+instance Algebra r a => Semiring (a -> r) 
+instance (HasTrie a, Algebra r a) => Semiring (a :->: r) 
+
+-- | 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
+
+-- 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)
+
+instance (HasTrie m, Algebra r m) => Coalgebra r (m :->: r) where
+  comult k f g = k (f * g)
+
+-- instance Coalgebra () c where comult _ _ _ = ()
+-- 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 (HasTrie e, LeftModule r m) => LeftModule r (e :->: m) where 
+  (.*) m f = tabulate $ \e -> m .* index 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 (HasTrie e, RightModule r m) => RightModule r (e :->: m) where 
+  (*.) f m = tabulate $ \e -> index 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
+
+  sinnum :: Whole n => n -> m -> m
+  sinnum 0 _  = zero
+  sinnum 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
+
+sinnumIdempotent :: (Integral n, Idempotent r, Monoidal r) => n -> r -> r
+sinnumIdempotent 0 _ = zero
+sinnumIdempotent _ x = x
+
+instance Monoidal Bool where 
+  zero = False
+  sinnum 0 _ = False
+  sinnum _ r = r
+
+instance Monoidal Natural where
+  zero = 0
+  sinnum n r = toNatural n * r
+
+instance Monoidal Integer where 
+  zero = 0
+  sinnum n r = toInteger n * r
+
+instance Monoidal Int where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Int8 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Int16 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Int32 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Int64 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Word where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Word8 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Word16 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Word32 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal Word64 where 
+  zero = 0
+  sinnum n r = fromIntegral n * r
+
+instance Monoidal r => Monoidal (e -> r) where
+  zero = const zero
+  sumWith f xs e = sumWith (`f` e) xs
+  sinnum n r e = sinnum n (r e)
+
+instance (HasTrie e, Monoidal r) => Monoidal (e :->: r) where
+  zero = pure zero
+  sumWith f xs = tabulate $ \e -> sumWith (\a -> index (f a) e) xs
+  sinnum n r = tabulate $ sinnum n . index r
+
+instance Monoidal () where 
+  zero = ()
+  sinnum _ () = ()
+  sumWith _ _ = ()
+
+instance (Monoidal a, Monoidal b) => Monoidal (a,b) where
+  zero = (zero,zero)
+  sinnum n (a,b) = (sinnum n a, sinnum n b)
+
+instance (Monoidal a, Monoidal b, Monoidal c) => Monoidal (a,b,c) where
+  zero = (zero,zero,zero)
+  sinnum n (a,b,c) = (sinnum n a, sinnum n b, sinnum n c)
+
+instance (Monoidal a, Monoidal b, Monoidal c, Monoidal d) => Monoidal (a,b,c,d) where
+  zero = (zero,zero,zero,zero)
+  sinnum n (a,b,c,d) = (sinnum n a, sinnum n b, sinnum n c, sinnum 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)
+  sinnum n (a,b,c,d,e) = (sinnum n a, sinnum n b, sinnum n c, sinnum n d, sinnum n e)
+
diff --git a/src/Numeric/Algebra/Commutative.hs b/src/Numeric/Algebra/Commutative.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Commutative.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances, TypeOperators #-}
+module Numeric.Algebra.Commutative 
+  ( Commutative
+  , CommutativeAlgebra
+  , CocommutativeCoalgebra
+  , CommutativeBialgebra
+  ) where
+
+import Data.Functor.Representable.Trie
+import Data.Int
+import Data.IntSet (IntSet)
+import Data.IntMap (IntMap)
+import Data.Set (Set)
+import Data.Map (Map)
+import Data.Word
+import Numeric.Additive.Class
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Natural
+import Prelude (Bool, Ord, Integer)
+
+
+
+-- | 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)
+
+instance CommutativeAlgebra r a => Commutative (a -> r)
+
+instance ( HasTrie a
+         , CommutativeAlgebra r a
+         ) => Commutative (a :->: r) 
+
+
+
+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)
+
+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)
+
+
+
+class Coalgebra r c => CocommutativeCoalgebra r c
+
+instance CommutativeAlgebra r m => CocommutativeCoalgebra r (m -> r)
+
+instance ( HasTrie m
+         , CommutativeAlgebra r m
+         ) => CocommutativeCoalgebra r (m :->: r)
+
+instance (Commutative r, Semiring r) => CocommutativeCoalgebra r ()
+
+instance ( CocommutativeCoalgebra r a
+         , CocommutativeCoalgebra r b
+         ) => CocommutativeCoalgebra r (a,b)
+
+instance ( CocommutativeCoalgebra r a
+         , CocommutativeCoalgebra r b
+         , CocommutativeCoalgebra r c
+         ) => CocommutativeCoalgebra r (a,b,c)
+
+instance ( CocommutativeCoalgebra r a
+         , CocommutativeCoalgebra r b
+         , CocommutativeCoalgebra r c
+         , CocommutativeCoalgebra r d
+         ) => CocommutativeCoalgebra r (a,b,c,d)
+
+instance ( CocommutativeCoalgebra r a
+         , CocommutativeCoalgebra r b
+         , CocommutativeCoalgebra r c
+         , CocommutativeCoalgebra r d
+         , CocommutativeCoalgebra r e
+         ) => CocommutativeCoalgebra r (a,b,c,d,e)
+
+instance ( Commutative r
+         , Semiring r
+         , Ord a) => CocommutativeCoalgebra r (Set a)
+
+instance ( Commutative r
+         , Semiring r
+         ) => CocommutativeCoalgebra r IntSet
+
+instance ( Commutative r
+         , Semiring r
+         , Ord a
+         , Abelian b
+         ) => CocommutativeCoalgebra r (Map a b)
+
+instance ( Commutative r
+         , Semiring r
+         , Abelian b
+         ) => CocommutativeCoalgebra r (IntMap b)
+
+
+
+class ( Bialgebra r h
+      , CommutativeAlgebra r h
+      , CocommutativeCoalgebra r h
+      ) => CommutativeBialgebra r h
+
+instance ( Bialgebra r h
+         , CommutativeAlgebra r h
+         , CocommutativeCoalgebra r h
+         ) => CommutativeBialgebra r h
diff --git a/src/Numeric/Algebra/Complex.hs b/src/Numeric/Algebra/Complex.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Complex.hs
@@ -0,0 +1,252 @@
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Algebra.Complex
+  ( Distinguished(..)
+  , Complicated(..)
+  , ComplexBasis(..)
+  , Complex(..)
+  , realPart
+  , imagPart
+  , uncomplicate
+  ) 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 hiding (index)
+import Data.Key
+import Data.Semigroup
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
+
+-- complex basis
+data ComplexBasis = E | I deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Complex a = Complex a a deriving (Eq,Show,Read,Data,Typeable)
+
+realPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
+realPart f = index f E 
+
+imagPart :: (Representable f, Key f ~ ComplexBasis) => f a -> a
+imagPart f = index f I
+
+instance Distinguished ComplexBasis where
+  e = E
+  
+instance Complicated ComplexBasis where
+  i = I
+
+instance Rig r => Distinguished (Complex r) where
+  e = Complex one zero
+
+instance Rig r => Complicated (Complex r) where
+  i = Complex zero one
+
+instance Rig r => Distinguished (ComplexBasis -> r) where
+  e E = one
+  e _ = zero
+  
+instance Rig r => Complicated (ComplexBasis -> r) where
+  i I = one
+  i _ = zero 
+
+instance Rig r => Distinguished (ComplexBasis :->: r) where
+  e = Trie e
+  
+instance Rig r => Complicated (ComplexBasis :->: r) where
+  i = Trie 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 
+  sinnum1p = sinnum1pRep
+
+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
+  sinnum = sinnumRep
+
+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
+
+-- the trivial coalgebra
+instance Rng k => Coalgebra k ComplexBasis where
+  comult f E E = f E
+  comult f I I = f I
+  comult _ _ _ = zero
+
+instance Rng k => CounitalCoalgebra k ComplexBasis where
+  counit f = f E + f I
+
+instance Rng k => Bialgebra k ComplexBasis 
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k ComplexBasis where
+  inv f = f' where
+    afe = adjoint (f E)
+    nfi = negate (f I)
+    f' E = afe
+    f' I = nfi
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k ComplexBasis where
+  coinv = inv
+
+instance (InvolutiveSemiring k, 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)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Complex r) where
+  quadrance n = realPart $ adjoint n * n
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Complex r) where
+  recip q@(Complex a b) = Complex (qq \\ a) (qq \\ b)
+    where qq = quadrance q
+
+-- | half of the Cayley-Dickson quaternion isomorphism 
+uncomplicate :: Hamiltonian q => ComplexBasis -> ComplexBasis -> q
+uncomplicate E E = e
+uncomplicate I E = i
+uncomplicate E I = j
+uncomplicate I I = k
+
diff --git a/src/Numeric/Algebra/Complex/Class.hs b/src/Numeric/Algebra/Complex/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Complex/Class.hs
@@ -0,0 +1,13 @@
+module Numeric.Algebra.Complex.Class
+  ( Complicated(..)
+  ) where
+
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Covector
+import Prelude (return)
+
+class Distinguished r => Complicated r where
+  i :: r
+
+instance Complicated a => Complicated (Covector r a) where
+  i = return i
diff --git a/src/Numeric/Algebra/Distinguished/Class.hs b/src/Numeric/Algebra/Distinguished/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Distinguished/Class.hs
@@ -0,0 +1,12 @@
+module Numeric.Algebra.Distinguished.Class
+  ( Distinguished(..)
+  ) where
+
+import Numeric.Covector
+
+-- a basis with a distinguished point
+class Distinguished t where
+  e :: t
+
+instance Distinguished a => Distinguished (Covector r a) where
+  e = return e
diff --git a/src/Numeric/Algebra/Division.hs b/src/Numeric/Algebra/Division.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Division.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Algebra.Division
+  ( Division(..)
+  , DivisionAlgebra(..)
+  ) 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
+
diff --git a/src/Numeric/Algebra/Dual.hs b/src/Numeric/Algebra/Dual.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Dual.hs
@@ -0,0 +1,224 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Algebra.Dual
+  ( Distinguished(..)
+  , Infinitesimal(..)
+  , DualBasis(..)
+  , Dual(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Semigroup hiding (Dual)
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Dual.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
+
+-- | dual number basis, D^2 = 0. D /= 0.
+data DualBasis = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Dual a = Dual a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished DualBasis where
+  e = E
+
+instance Infinitesimal DualBasis where
+  d = D
+
+instance Rig r => Distinguished (Dual r) where
+  e = Dual one zero
+
+instance Rig r => Infinitesimal (Dual r) where
+  d = Dual zero one
+  
+instance Rig r => Distinguished (DualBasis -> r) where
+  e E = one
+  e _ = zero
+
+instance Rig r => Infinitesimal (DualBasis -> r) where
+  d D = one
+  d _       = zero 
+
+type instance Key Dual = DualBasis
+
+instance Representable Dual where
+  tabulate f = Dual (f E) (f D)
+
+instance Indexable Dual where
+  index (Dual a _ ) E = a
+  index (Dual _ b ) D = b
+
+instance Lookup Dual where
+  lookup = lookupDefault
+
+instance Adjustable Dual where
+  adjust f E (Dual a b) = Dual (f a) b
+  adjust f D (Dual a b) = Dual a (f b)
+
+instance Distributive Dual where
+  distribute = distributeRep 
+
+instance Functor Dual where
+  fmap f (Dual a b) = Dual (f a) (f b)
+
+instance Zip Dual where
+  zipWith f (Dual a1 b1) (Dual a2 b2) = Dual (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Dual where
+  zipWithKey f (Dual a1 b1) (Dual a2 b2) = Dual (f E a1 a2) (f D b1 b2)
+
+instance Keyed Dual where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Dual where
+  (<.>) = apRep
+
+instance Applicative Dual where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Dual where
+  (>>-) = bindRep
+
+instance Monad Dual where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader DualBasis Dual where
+  ask = askRep
+  local = localRep
+
+instance Foldable Dual where
+  foldMap f (Dual a b) = f a `mappend` f b
+
+instance FoldableWithKey Dual where
+  foldMapWithKey f (Dual a b) = f E a `mappend` f D b
+
+instance Traversable Dual where
+  traverse f (Dual a b) = Dual <$> f a <*> f b
+
+instance TraversableWithKey Dual where
+  traverseWithKey f (Dual a b) = Dual <$> f E a <*> f D b
+
+instance Foldable1 Dual where
+  foldMap1 f (Dual a b) = f a <> f b
+
+instance FoldableWithKey1 Dual where
+  foldMapWithKey1 f (Dual a b) = f E a <> f D b
+
+instance Traversable1 Dual where
+  traverse1 f (Dual a b) = Dual <$> f a <.> f b
+
+instance TraversableWithKey1 Dual where
+  traverseWithKey1 f (Dual a b) = Dual <$> f E a <.> f D b
+
+instance HasTrie DualBasis where
+  type BaseTrie DualBasis = Dual
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Dual r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+instance LeftModule r s => LeftModule r (Dual s) where
+  r .* Dual a b = Dual (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Dual s) where
+  Dual a b *. r = Dual (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Dual r) where
+  zero = zeroRep
+  sinnum = sinnumRep
+
+instance Group r => Group (Dual r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Dual r)
+
+instance Idempotent r => Idempotent (Dual r)
+
+instance Partitionable r => Partitionable (Dual r) where
+  partitionWith f (Dual a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Dual a1 b1) (Dual a2 b2)) b) a
+
+instance Rng k => Algebra k DualBasis where
+  mult f = f' where
+    fe = f E E
+    fd = f E D + f D E
+    f' E = fe
+    f' D = fd
+
+instance Rng k => UnitalAlgebra k DualBasis where
+  unit x E = x
+  unit _ _ = zero
+
+-- the trivial coalgebra
+instance Rng k => Coalgebra k DualBasis where
+  comult f E E = f E
+  comult f D D = f D
+  comult _ _ _ = zero
+
+instance Rng k => CounitalCoalgebra k DualBasis where
+  counit f = f E + f D
+
+instance Rng k => Bialgebra k DualBasis 
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis where
+  inv f = f' where
+    afe = adjoint (f E)
+    nfd = negate (f D)
+    f' E = afe
+    f' D = nfd
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis where
+  coinv = inv
+
+instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis where
+  antipode = inv
+
+instance (Commutative r, Rng r) => Multiplicative (Dual r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng r) => Commutative (Dual r)
+
+instance (Commutative r, Rng r) => Semiring (Dual r)
+
+instance (Commutative r, Ring r) => Unital (Dual r) where
+  one = oneRep
+
+instance (Commutative r, Ring r) => Rig (Dual r) where
+  fromNatural n = Dual (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Dual r) where
+  fromInteger n = Dual (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Dual r) (Dual r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Dual r) (Dual r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual r) where
+  adjoint (Dual a b) = Dual (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual r)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual r) where
+  quadrance n = case adjoint n * n of
+    Dual a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual r) where
+  recip q@(Dual a b) = Dual (qq \\ a) (qq \\ b)
+    where qq = quadrance q
diff --git a/src/Numeric/Algebra/Dual/Class.hs b/src/Numeric/Algebra/Dual/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Dual/Class.hs
@@ -0,0 +1,12 @@
+module Numeric.Algebra.Dual.Class
+  ( Infinitesimal(..)
+  ) where
+
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Covector
+
+class Distinguished t => Infinitesimal t where
+  d :: t
+
+instance Infinitesimal a => Infinitesimal (Covector r a) where
+  d = return d
diff --git a/src/Numeric/Algebra/Factorable.hs b/src/Numeric/Algebra/Factorable.hs
new file mode 100644
--- /dev/null
+++ b/src/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/src/Numeric/Algebra/Hopf.hs b/src/Numeric/Algebra/Hopf.hs
new file mode 100644
--- /dev/null
+++ b/src/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/src/Numeric/Algebra/Hyperbolic.hs b/src/Numeric/Algebra/Hyperbolic.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Hyperbolic.hs
@@ -0,0 +1,222 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Algebra.Hyperbolic
+  ( Hyperbolic(..)
+  , HyperBasis'(..)
+  , Hyper'(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Coalgebra.Hyperbolic.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+
+-- the dual hyperbolic basis
+data HyperBasis' = Cosh' | Sinh' deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Hyper' a = Hyper' a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Hyperbolic HyperBasis' where
+  cosh = Cosh'
+  sinh = Sinh'
+
+instance Rig r => Hyperbolic (Hyper' r) where
+  cosh = Hyper' one zero
+  sinh = Hyper' zero one
+  
+instance Rig r => Hyperbolic (HyperBasis' -> r) where
+  cosh Sinh' = zero
+  cosh Cosh' = one
+  sinh Sinh' = one
+  sinh Cosh' = zero
+
+type instance Key Hyper' = HyperBasis'
+
+instance Representable Hyper' where
+  tabulate f = Hyper' (f Cosh') (f Sinh')
+
+instance Indexable Hyper' where
+  index (Hyper' a _ ) Cosh' = a
+  index (Hyper' _ b ) Sinh' = b
+
+instance Lookup Hyper' where
+  lookup = lookupDefault
+
+instance Adjustable Hyper' where
+  adjust f Cosh' (Hyper' a b) = Hyper' (f a) b
+  adjust f Sinh' (Hyper' a b) = Hyper' a (f b)
+
+instance Distributive Hyper' where
+  distribute = distributeRep 
+
+instance Functor Hyper' where
+  fmap f (Hyper' a b) = Hyper' (f a) (f b)
+
+instance Zip Hyper' where
+  zipWith f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Hyper' where
+  zipWithKey f (Hyper' a1 b1) (Hyper' a2 b2) = Hyper' (f Cosh' a1 a2) (f Sinh' b1 b2)
+
+instance Keyed Hyper' where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Hyper' where
+  (<.>) = apRep
+
+instance Applicative Hyper' where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Hyper' where
+  (>>-) = bindRep
+
+instance Monad Hyper' where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader HyperBasis' Hyper' where
+  ask = askRep
+  local = localRep
+
+instance Foldable Hyper' where
+  foldMap f (Hyper' a b) = f a `mappend` f b
+
+instance FoldableWithKey Hyper' where
+  foldMapWithKey f (Hyper' a b) = f Cosh' a `mappend` f Sinh' b
+
+instance Traversable Hyper' where
+  traverse f (Hyper' a b) = Hyper' <$> f a <*> f b
+
+instance TraversableWithKey Hyper' where
+  traverseWithKey f (Hyper' a b) = Hyper' <$> f Cosh' a <*> f Sinh' b
+
+instance Foldable1 Hyper' where
+  foldMap1 f (Hyper' a b) = f a <> f b
+
+instance FoldableWithKey1 Hyper' where
+  foldMapWithKey1 f (Hyper' a b) = f Cosh' a <> f Sinh' b
+
+instance Traversable1 Hyper' where
+  traverse1 f (Hyper' a b) = Hyper' <$> f a <.> f b
+
+instance TraversableWithKey1 Hyper' where
+  traverseWithKey1 f (Hyper' a b) = Hyper' <$> f Cosh' a <.> f Sinh' b
+
+instance HasTrie HyperBasis' where
+  type BaseTrie HyperBasis' = Hyper'
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Hyper' r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+instance LeftModule r s => LeftModule r (Hyper' s) where
+  r .* Hyper' a b = Hyper' (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Hyper' s) where
+  Hyper' a b *. r = Hyper' (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Hyper' r) where
+  zero = zeroRep
+  sinnum = sinnumRep
+
+instance Group r => Group (Hyper' r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Hyper' r)
+
+instance Idempotent r => Idempotent (Hyper' r)
+
+instance Partitionable r => Partitionable (Hyper' r) where
+  partitionWith f (Hyper' a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Hyper' a1 b1) (Hyper' a2 b2)) b) a
+
+-- the dual hyperbolic trigonometric algebra
+instance (Commutative k, Semiring k) => Algebra k HyperBasis' where
+  mult f = f' where
+    fs = f Sinh' Cosh' + f Cosh' Sinh'
+    fc = f Cosh' Cosh' + f Sinh' Sinh'
+    f' Sinh' = fs
+    f' Cosh' = fc
+
+instance (Commutative k, Monoidal k, Semiring k) => UnitalAlgebra k HyperBasis' where
+  unit _ Sinh' = zero
+  unit x Cosh' = x
+
+-- the diagonal coalgebra
+instance (Commutative k, Monoidal k, Semiring k) => Coalgebra k HyperBasis' where
+  comult f = f' where
+     fs = f Sinh'
+     fc = f Cosh'
+     f' Sinh' Sinh' = fs
+     f' Sinh' Cosh' = zero
+     f' Cosh' Sinh' = zero
+     f' Cosh' Cosh' = fc
+
+instance (Commutative k, Monoidal k, Semiring k) => CounitalCoalgebra k HyperBasis' where
+  counit f = f Cosh' + f Sinh'
+
+instance (Commutative k, Monoidal k, Semiring k) => Bialgebra k HyperBasis'
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis' where
+  inv f = f' where
+    afc = adjoint (f Cosh')
+    nfs = negate (f Sinh')
+    f' Cosh' = afc
+    f' Sinh' = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis' where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis' where
+  antipode = inv
+
+instance (Commutative k, Semiring k) => Multiplicative (Hyper' k) where
+  (*) = mulRep
+
+instance (Commutative k, Semiring k) => Commutative (Hyper' k)
+
+instance (Commutative k, Semiring k) => Semiring (Hyper' k)
+
+instance (Commutative k, Rig k) => Unital (Hyper' k) where
+  one = Hyper' one zero
+
+instance (Commutative r, Rig r) => Rig (Hyper' r) where
+  fromNatural n = Hyper' (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Hyper' r) where
+  fromInteger n = Hyper' (fromInteger n) zero
+
+instance (Commutative r, Semiring r) => LeftModule (Hyper' r) (Hyper' r) where (.*) = (*)
+instance (Commutative r, Semiring r) => RightModule (Hyper' r) (Hyper' r) where (*.) = (*)
+
+instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveMultiplication (Hyper' r) where
+  adjoint (Hyper' a b) = Hyper' (adjoint a) (negate b)
+
+instance (Commutative r, InvolutiveSemiring r, Rng r) => InvolutiveSemiring (Hyper' r)
+
+instance (Commutative r, InvolutiveSemiring r, Rng r) => Quadrance r (Hyper' r) where
+  quadrance n = case adjoint n * n of
+    Hyper' a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Hyper' r) where
+  recip q@(Hyper' a b) = Hyper' (qq \\ a) (qq \\ b)
+    where qq = quadrance q
+
diff --git a/src/Numeric/Algebra/Idempotent.hs b/src/Numeric/Algebra/Idempotent.hs
new file mode 100644
--- /dev/null
+++ b/src/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/src/Numeric/Algebra/Incidence.hs b/src/Numeric/Algebra/Incidence.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Incidence.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , UndecidableInstances
+           , DeriveDataTypeable
+           #-}
+
+module Numeric.Algebra.Incidence
+  ( Interval(..)
+  , zeta
+  , moebius
+  ) where
+
+import Data.Data
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Algebra.Commutative
+import Numeric.Ring.Class
+import Numeric.Order.Class
+import Numeric.Order.LocallyFinite
+
+-- the basis for an incidence algebra
+data Interval a = Interval a a deriving (Eq,Ord,Show,Read,Data,Typeable)
+
+instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => Algebra r (Interval a) where
+  mult f (Interval a c) = sumWith (\b -> f (Interval a b) (Interval b c)) $ range a c
+  
+instance (Commutative r, Monoidal r, Semiring r, LocallyFiniteOrder a) => UnitalAlgebra r (Interval a) where
+  unit r (Interval a b) 
+    | a ~~ b = r
+    | otherwise = zero
+
+zeta :: Unital r => Interval a -> r
+zeta = const one
+
+moebius :: (Ring r, LocallyFiniteOrder a) => Interval a -> r
+moebius (Interval a b) = moebiusInversion a b
diff --git a/src/Numeric/Algebra/Involutive.hs b/src/Numeric/Algebra/Involutive.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Involutive.hs
@@ -0,0 +1,377 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeOperators #-}
+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.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Key
+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)
+
+instance InvolutiveAlgebra r h => InvolutiveMultiplication (h -> r) where
+  adjoint = inv
+
+instance (HasTrie h, InvolutiveAlgebra r h) => InvolutiveMultiplication (h :->: r) where
+  adjoint = tabulate . inv . index
+
+
+
+-- | adjoint (x + y) = adjoint x + adjoint y
+class (Semiring r, InvolutiveMultiplication r) => InvolutiveSemiring r
+
+instance InvolutiveSemiring ()
+instance InvolutiveSemiring Bool
+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 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 Bool
+instance TriviallyInvolutive Int
+instance TriviallyInvolutive Integer
+instance TriviallyInvolutive Int8
+instance TriviallyInvolutive Int16
+instance TriviallyInvolutive Int32
+instance TriviallyInvolutive Int64
+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)
+
+instance ( TriviallyInvolutive r
+         , TriviallyInvolutiveAlgebra r a
+         ) => TriviallyInvolutive (a -> r)
+
+instance ( HasTrie a
+         , TriviallyInvolutive r
+         , TriviallyInvolutiveAlgebra r a
+         ) => TriviallyInvolutive (a :->: r)
+
+
+
+-- inv is an associative algebra homomorphism
+class (InvolutiveSemiring r, Algebra r a) => InvolutiveAlgebra r a where
+  inv :: (a -> r) -> a -> r
+
+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
+
+
+
+class ( CommutativeAlgebra r a
+      , TriviallyInvolutive r
+      , 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)
+
+
+
+class ( InvolutiveSemiring r
+      , Coalgebra r c
+      ) => InvolutiveCoalgebra r c where
+  coinv :: (c -> r) -> c -> r
+
+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
+
+
+
+class ( CocommutativeCoalgebra r a
+      , TriviallyInvolutive r
+      , InvolutiveCoalgebra r a
+      ) => TriviallyInvolutiveCoalgebra r a
+
+instance ( TriviallyInvolutive r
+         , InvolutiveSemiring r
+         ) => TriviallyInvolutiveCoalgebra r ()
+
+instance ( TriviallyInvolutiveCoalgebra r a
+         , TriviallyInvolutiveCoalgebra r b
+         ) => TriviallyInvolutiveCoalgebra r (a, b)
+
+instance ( TriviallyInvolutiveCoalgebra r a
+         , TriviallyInvolutiveCoalgebra r b
+         , TriviallyInvolutiveCoalgebra r c
+         ) => TriviallyInvolutiveCoalgebra r (a, b, c)
+
+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)
+
+
+
+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/src/Numeric/Algebra/Quaternion.hs b/src/Numeric/Algebra/Quaternion.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Quaternion.hs
@@ -0,0 +1,334 @@
+{-# LANGUAGE FlexibleInstances
+           , MultiParamTypeClasses
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Algebra.Quaternion 
+  ( Distinguished(..)
+  , Complicated(..)
+  , Hamiltonian(..)
+  , QuaternionBasis(..)
+  , Quaternion(..)
+  , complicate
+  , vectorPart
+  , scalarPart
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Ix hiding (index)
+import Data.Key
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+
+instance Distinguished QuaternionBasis where
+  e = E
+
+instance Complicated QuaternionBasis where
+  i = I
+
+instance Hamiltonian QuaternionBasis where
+  j = J
+  k = K
+
+instance Rig r => Distinguished (Quaternion r) where
+  e = Quaternion one zero zero zero
+
+instance Rig r => Complicated (Quaternion r) where
+  i = Quaternion zero one zero zero
+
+instance Rig r => Hamiltonian (Quaternion r) where
+  j = Quaternion zero zero one zero
+  k = Quaternion one zero zero one 
+
+instance Rig r => Distinguished (QuaternionBasis :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (QuaternionBasis :->: r) where
+  i = Trie i
+
+instance Rig r => Hamiltonian (QuaternionBasis :->: r) where
+  j = Trie j
+  k = Trie k
+
+instance Rig r => Distinguished (QuaternionBasis -> r) where
+  e E = one 
+  e _ = zero
+
+instance Rig r => Complicated (QuaternionBasis -> r) where
+  i I = one
+  i _ = zero
+  
+instance Rig r => Hamiltonian (QuaternionBasis -> r) where
+  j J = one
+  j _ = zero
+
+  k K = one
+  k _ = zero
+
+-- quaternion basis
+data QuaternionBasis = E | I | J | K deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
+
+data Quaternion a = Quaternion a a a a deriving (Eq,Show,Read,Data,Typeable)
+
+type instance Key Quaternion = QuaternionBasis
+
+instance Representable Quaternion where
+  tabulate f = Quaternion (f E) (f I) (f J) (f K)
+
+instance Indexable Quaternion where
+  index (Quaternion a _ _ _) E = a
+  index (Quaternion _ b _ _) I = b
+  index (Quaternion _ _ c _) J = c
+  index (Quaternion _ _ _ d) K = d
+
+instance Lookup Quaternion where
+  lookup = lookupDefault
+
+instance Adjustable Quaternion where
+  adjust f E (Quaternion a b c d) = Quaternion (f a) b c d
+  adjust f I (Quaternion a b c d) = Quaternion a (f b) c d
+  adjust f J (Quaternion a b c d) = Quaternion a b (f c) d
+  adjust f K (Quaternion a b c d) = Quaternion a b c (f d)
+
+instance Distributive Quaternion where
+  distribute = distributeRep 
+
+instance Functor Quaternion where
+  fmap = fmapRep
+
+instance Zip Quaternion where
+  zipWith f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = 
+    Quaternion (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)
+
+instance ZipWithKey Quaternion where
+  zipWithKey f (Quaternion a1 b1 c1 d1) (Quaternion a2 b2 c2 d2) = 
+    Quaternion (f E a1 a2) (f I b1 b2) (f J c1 c2) (f K d1 d2)
+
+instance Keyed Quaternion where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Quaternion where
+  (<.>) = apRep
+
+instance Applicative Quaternion where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Quaternion where
+  (>>-) = bindRep
+
+instance Monad Quaternion where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader QuaternionBasis Quaternion where
+  ask = askRep
+  local = localRep
+
+instance Foldable Quaternion where
+  foldMap f (Quaternion a b c d) = 
+    f a `mappend` f b `mappend` f c `mappend` f d
+
+instance FoldableWithKey Quaternion where
+  foldMapWithKey f (Quaternion a b c d) = 
+    f E a `mappend` f I b `mappend` f J c `mappend` f K d
+
+instance Traversable Quaternion where
+  traverse f (Quaternion a b c d) = 
+    Quaternion <$> f a <*> f b <*> f c <*> f d
+
+instance TraversableWithKey Quaternion where
+  traverseWithKey f (Quaternion a b c d) = 
+    Quaternion <$> f E a <*> f I b <*> f J c <*> f K d
+
+instance Foldable1 Quaternion where
+  foldMap1 f (Quaternion a b c d) = 
+    f a <> f b <> f c <> f d
+
+instance FoldableWithKey1 Quaternion where
+  foldMapWithKey1 f (Quaternion a b c d) = 
+    f E a <> f I b <> f J c <> f K d
+
+instance Traversable1 Quaternion where
+  traverse1 f (Quaternion a b c d) = 
+    Quaternion <$> f a <.> f b <.> f c <.> f d
+
+instance TraversableWithKey1 Quaternion where
+  traverseWithKey1 f (Quaternion a b c d) = 
+    Quaternion <$> f E a <.> f I b <.> f J c <.> f K d
+
+instance HasTrie QuaternionBasis where
+  type BaseTrie QuaternionBasis = Quaternion
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Quaternion r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+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
+  sinnum = sinnumRep
+
+instance Group r => Group (Quaternion r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Quaternion r)
+
+instance Idempotent r => Idempotent (Quaternion r)
+
+instance Partitionable r => Partitionable (Quaternion r) where
+  partitionWith f (Quaternion a b c d) = id =<<
+    partitionWith (\a1 a2 -> id =<< 
+    partitionWith (\b1 b2 -> id =<< 
+    partitionWith (\c1 c2 -> 
+    partitionWith (\d1 d2 -> f (Quaternion a1 b1 c1 d1) 
+                               (Quaternion a2 b2 c2 d2)
+                  ) d) c) b) a
+
+-- | the quaternion algebra
+instance (TriviallyInvolutive r, Rng r) => Algebra r QuaternionBasis where
+  mult f = f' where
+    fe = f E E - (f I I + f J J + f K K)
+    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
+
+-- | the trivial diagonal coalgebra
+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
+  comult f = f' where
+    fe = f E
+    fi = f I
+    fj = f J
+    fk = f K
+    f' E E = fe
+    f' I I = fi
+    f' J J = fj
+    f' K K = fk
+    f' _ _ = zero
+
+instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
+  counit f = f E + f I + f J + f K
+
+{-
+-- dual quaternion comultiplication
+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis where
+  comult f = f' where
+    fe = f E
+    fi = f I
+    fj = f J
+    fk = f K
+    fe' = negate fe
+    fi' = negate fi
+    fj' = negate fj
+    fk' = negate fk
+    f' E E = fe
+    f' E I = fi
+    f' E J = fj
+    f' E K = fk
+    f' I E = fi
+    f' I I = fe'
+    f' I J = fk
+    f' I K = fj'
+    f' J E = fj
+    f' J I = fk'
+    f' J J = fe'
+    f' J K = fi
+    f' K E = fk
+    f' K I = fj
+    f' K J = fi'
+    f' K K = fe'
+
+instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis where
+  counit f = f E
+-}
+
+instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis 
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis where
+  inv f E = f E
+  inv f b = negate (f b)
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis where
+  coinv = inv
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis where
+  antipode = inv
+
+instance (TriviallyInvolutive r, 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 :: Complicated c => QuaternionBasis -> (c,c)
+complicate E = (e, e)
+complicate I = (i, e) 
+complicate J = (e, i)
+complicate K = (i, i)
+
+scalarPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> r
+scalarPart f = index f E
+
+vectorPart :: (Representable f, Key f ~ QuaternionBasis) => f r -> (r,r,r)
+vectorPart f = (index f I, index f J, index f K)
+
+instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion r) where
+  quadrance n = scalarPart (adjoint n * n)
+
+instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion r) where
+  recip q@(Quaternion a b c d) = Quaternion (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
+    where qq = quadrance q
diff --git a/src/Numeric/Algebra/Quaternion/Class.hs b/src/Numeric/Algebra/Quaternion/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Algebra/Quaternion/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Algebra.Quaternion.Class
+  ( Hamiltonian(..)
+  ) where
+
+import Numeric.Algebra.Complex.Class
+import Numeric.Covector
+
+class Complicated t => Hamiltonian t where
+  j :: t
+  k :: t
+
+instance Hamiltonian a => Hamiltonian (Covector r a) where
+  j = return j
+  k = return k
diff --git a/src/Numeric/Algebra/Unital.hs b/src/Numeric/Algebra/Unital.hs
new file mode 100644
--- /dev/null
+++ b/src/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/src/Numeric/Band/Class.hs b/src/Numeric/Band/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Band/Class.hs
@@ -0,0 +1,7 @@
+module Numeric.Band.Class
+  ( Band
+  , pow1pBand
+  , powBand
+  ) where
+
+import Numeric.Algebra.Idempotent
diff --git a/src/Numeric/Band/Rectangular.hs b/src/Numeric/Band/Rectangular.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Band/Rectangular.hs
@@ -0,0 +1,21 @@
+module Numeric.Band.Rectangular 
+  ( Rect(..)
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Algebra.Idempotent
+import Data.Semigroupoid
+
+-- | a rectangular band is a nowhere commutative semigroup.
+-- That is to say, if ab = ba then a = b. From this it follows
+-- classically that aa = a and that such a band is isomorphic 
+-- to the following structure
+data Rect i j = Rect i j deriving (Eq,Ord,Show,Read)
+
+instance Semigroupoid Rect where
+  Rect _ i `o` Rect j _ = Rect j i
+
+instance Multiplicative (Rect i j) where
+  Rect i _ * Rect _ j = Rect i j
+
+instance Band (Rect i j)
diff --git a/src/Numeric/Coalgebra/Categorical.hs b/src/Numeric/Coalgebra/Categorical.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Categorical.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, PatternGuards #-}
+module Numeric.Coalgebra.Categorical 
+  ( Morphism(..)
+  ) where
+
+import Data.Data
+import Numeric.Partial.Semigroup
+import Numeric.Partial.Monoid
+import Numeric.Partial.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Algebra.Commutative
+
+-- the dual categorical algebra
+newtype Morphism a = Morphism a deriving (Eq,Ord,Show,Read,PartialSemigroup,PartialMonoid,PartialGroup,Data,Typeable)
+
+instance (Commutative r, Monoidal r, Semiring r, PartialSemigroup a) => Coalgebra r (Morphism a) where
+  comult f a b 
+    | Just c <- padd a b = f c
+    | otherwise = zero
+
+instance (Commutative r, Monoidal r, Semiring r, PartialMonoid a) => CounitalCoalgebra r (Morphism a) where
+  counit f = f pzero
diff --git a/src/Numeric/Coalgebra/Dual.hs b/src/Numeric/Coalgebra/Dual.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Dual.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Coalgebra.Dual
+  ( Distinguished(..)
+  , Infinitesimal(..)
+  , DualBasis'(..)
+  , Dual'(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Dual.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger,recip)
+
+-- | dual number basis, D^2 = 0. D /= 0.
+data DualBasis' = E | D deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Dual' a = Dual' a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished DualBasis' where
+  e = E
+
+instance Infinitesimal DualBasis' where
+  d = D
+
+instance Rig r => Distinguished (Dual' r) where
+  e = Dual' one zero
+
+instance Rig r => Infinitesimal (Dual' r) where
+  d = Dual' zero one
+  
+instance Rig r => Distinguished (DualBasis' -> r) where
+  e E = one
+  e _ = zero
+
+instance Rig r => Infinitesimal (DualBasis' -> r) where
+  d D = one
+  d _       = zero 
+
+type instance Key Dual' = DualBasis'
+
+instance Representable Dual' where
+  tabulate f = Dual' (f E) (f D)
+
+instance Indexable Dual' where
+  index (Dual' a _ ) E = a
+  index (Dual' _ b ) D = b
+
+instance Lookup Dual' where
+  lookup = lookupDefault
+
+instance Adjustable Dual' where
+  adjust f E (Dual' a b) = Dual' (f a) b
+  adjust f D (Dual' a b) = Dual' a (f b)
+
+instance Distributive Dual' where
+  distribute = distributeRep 
+
+instance Functor Dual' where
+  fmap f (Dual' a b) = Dual' (f a) (f b)
+
+instance Zip Dual' where
+  zipWith f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Dual' where
+  zipWithKey f (Dual' a1 b1) (Dual' a2 b2) = Dual' (f E a1 a2) (f D b1 b2)
+
+instance Keyed Dual' where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Dual' where
+  (<.>) = apRep
+
+instance Applicative Dual' where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Dual' where
+  (>>-) = bindRep
+
+instance Monad Dual' where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader DualBasis' Dual' where
+  ask = askRep
+  local = localRep
+
+instance Foldable Dual' where
+  foldMap f (Dual' a b) = f a `mappend` f b
+
+instance FoldableWithKey Dual' where
+  foldMapWithKey f (Dual' a b) = f E a `mappend` f D b
+
+instance Traversable Dual' where
+  traverse f (Dual' a b) = Dual' <$> f a <*> f b
+
+instance TraversableWithKey Dual' where
+  traverseWithKey f (Dual' a b) = Dual' <$> f E a <*> f D b
+
+instance Foldable1 Dual' where
+  foldMap1 f (Dual' a b) = f a <> f b
+
+instance FoldableWithKey1 Dual' where
+  foldMapWithKey1 f (Dual' a b) = f E a <> f D b
+
+instance Traversable1 Dual' where
+  traverse1 f (Dual' a b) = Dual' <$> f a <.> f b
+
+instance TraversableWithKey1 Dual' where
+  traverseWithKey1 f (Dual' a b) = Dual' <$> f E a <.> f D b
+
+instance HasTrie DualBasis' where
+  type BaseTrie DualBasis' = Dual'
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Dual' r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+instance LeftModule r s => LeftModule r (Dual' s) where
+  r .* Dual' a b = Dual' (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Dual' s) where
+  Dual' a b *. r = Dual' (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Dual' r) where
+  zero = zeroRep
+  sinnum = sinnumRep
+
+instance Group r => Group (Dual' r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Dual' r)
+
+instance Idempotent r => Idempotent (Dual' r)
+
+instance Partitionable r => Partitionable (Dual' r) where
+  partitionWith f (Dual' a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Dual' a1 b1) (Dual' a2 b2)) b) a
+
+instance Semiring k => Algebra k DualBasis' where
+  mult f = f' where
+    fe = f E E
+    fd = f D D
+    f' E = fe
+    f' D = fd
+
+instance Semiring k => UnitalAlgebra k DualBasis' where
+  unit = const
+
+-- the trivial coalgebra
+instance Rng k => Coalgebra k DualBasis' where
+  comult f = f' where
+     fe = f E
+     fd = f D
+     f' E E = fe
+     f' E D = fd
+     f' D E = fd
+     f' D D = zero
+
+instance Rng k => CounitalCoalgebra k DualBasis' where
+  counit f = f E
+
+instance Rng k => Bialgebra k DualBasis' 
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveAlgebra k DualBasis' where
+  inv f = f' where
+    afe = adjoint (f E)
+    nfd = negate (f D)
+    f' E = afe
+    f' D = nfd
+
+instance (InvolutiveSemiring k, Rng k) => InvolutiveCoalgebra k DualBasis' where
+  coinv = inv
+
+instance (InvolutiveSemiring k, Rng k) => HopfAlgebra k DualBasis' where
+  antipode = inv
+
+instance (Commutative r, Rng r) => Multiplicative (Dual' r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Rng r) => Commutative (Dual' r)
+
+instance (Commutative r, Rng r) => Semiring (Dual' r)
+
+instance (Commutative r, Ring r) => Unital (Dual' r) where
+  one = oneRep
+
+instance (Commutative r, Ring r) => Rig (Dual' r) where
+  fromNatural n = Dual' (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Dual' r) where
+  fromInteger n = Dual' (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Dual' r) (Dual' r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Dual' r) (Dual' r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveMultiplication (Dual' r) where
+  adjoint (Dual' a b) = Dual' (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Dual' r)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => Quadrance r (Dual' r) where
+  quadrance n = case adjoint n * n of
+    Dual' a _ -> a
+
+instance (Commutative r, InvolutiveSemiring r, DivisionRing r) => Division (Dual' r) where
+  recip q@(Dual' a b) = Dual' (qq \\ a) (qq \\ b)
+    where qq = quadrance q
diff --git a/src/Numeric/Coalgebra/Geometric.hs b/src/Numeric/Coalgebra/Geometric.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Geometric.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE 
+    MultiParamTypeClasses, 
+    GeneralizedNewtypeDeriving, 
+    BangPatterns,
+    TypeOperators,
+    DeriveDataTypeable,
+    FlexibleInstances,
+    TypeFamilies,
+    PatternGuards,
+    UndecidableInstances,
+    ScopedTypeVariables #-}
+
+module Numeric.Coalgebra.Geometric
+  ( 
+  -- * Geometric coalgebra primitives
+    BasisCoblade(..)
+  , Comultivector
+  -- * Operations over an eigenbasis
+  , Eigenbasis(..)
+  , Eigenmetric(..)
+  , Euclidean(..)
+  -- * Grade
+  , grade
+  , filterGrade
+  -- * Inversions
+  , reverse
+  , gradeInversion
+  , cliffordConjugate
+  -- * Products
+  , geometric
+  , outer
+  -- * Inner products
+  , contractL
+  , contractR
+  , hestenes
+  , dot
+  , liftProduct
+  ) where
+
+import Control.Monad (mfilter)
+import Data.Bits
+import Data.Functor.Representable.Trie
+import Data.Word
+import Data.Data
+import Data.Ix
+import Data.Array.Unboxed
+import Numeric.Algebra
+import Prelude hiding ((-),(*),(+),negate,reverse)
+
+-- a basis vector for a simple geometric coalgebra with the Euclidean inner product
+newtype BasisCoblade m = BasisCoblade { runBasisCoblade :: Word64 } deriving 
+  ( Eq,Ord,Num,Bits,Enum,Ix,Bounded,Show,Read,Real,Integral
+  , Additive,Abelian,LeftModule Natural,RightModule Natural,Monoidal
+  , Multiplicative,Unital,Commutative
+  , Semiring,Rig
+  , DecidableZero,DecidableAssociates,DecidableUnits
+  )
+
+instance HasTrie (BasisCoblade m) where
+  type BaseTrie (BasisCoblade m) = BaseTrie Word64
+  embedKey = embedKey . runBasisCoblade
+  projectKey = BasisCoblade . projectKey
+
+-- A metric space over an eigenbasis
+class Eigenbasis m where
+  euclidean     :: proxy m -> Bool
+  antiEuclidean :: proxy m -> Bool
+  v             :: m -> BasisCoblade m
+  e             :: Int -> m
+
+-- assuming n /= 0, find the index of the least significant set bit in a basis blade
+lsb :: BasisCoblade m -> Int
+lsb n = fromIntegral $ ix ! shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58
+  where 
+    -- a 64 bit deBruijn multiplication table
+    ix :: UArray (BasisCoblade m) Word8
+    ix = listArray (0, 63)
+      [ 63,  0, 58,  1, 59, 47, 53,  2
+      , 60, 39, 48, 27, 54, 33, 42,  3
+      , 61, 51, 37, 40, 49, 18, 28, 20
+      , 55, 30, 34, 11, 43, 14, 22,  4
+      , 62, 57, 46, 52, 38, 26, 32, 41
+      , 50, 36, 17, 19, 29, 10, 13, 21
+      , 56, 45, 25, 31, 35, 16,  9, 12
+      , 44, 24, 15,  8, 23,  7,  6,  5
+      ]
+
+class (Ring r, Eigenbasis m) => Eigenmetric r m where
+  metric :: m -> r
+
+type Comultivector r m = Covector r (BasisCoblade m)
+
+-- Euclidean basis, we can work with basis vectors for euclidean spaces of up to 64 dimensions without 
+-- expanding the representation of our basis vectors
+newtype Euclidean = Euclidean Int deriving 
+  ( Eq,Ord,Show,Read,Num,Ix,Enum,Real,Integral
+  , Data,Typeable
+  , Additive,LeftModule Natural,RightModule Natural,Monoidal,Abelian,LeftModule Integer,RightModule Integer,Group
+  , Multiplicative,TriviallyInvolutive,InvolutiveMultiplication,InvolutiveSemiring,Unital,Commutative
+  , Semiring,Rig,Ring
+  )
+
+instance HasTrie Euclidean where
+  type BaseTrie Euclidean = BaseTrie Int
+  embedKey (Euclidean i) = embedKey i
+  projectKey = Euclidean . projectKey
+
+instance Eigenbasis Euclidean where
+  euclidean _ = True
+  antiEuclidean _ = False
+  v n = shiftL 1 (fromIntegral n)
+  e = fromIntegral
+
+instance Ring r => Eigenmetric r Euclidean where
+  metric _ = one
+
+grade :: BasisCoblade m -> Int
+grade = fromIntegral . count 5 . count 4 . count 3 . count 2 . count 1 . count 0 where 
+  count c x = (x .&. mask) + (shiftR x p .&. mask) where 
+    p = shiftL 1 c
+    mask = (-1) `div` (shiftL 1 p + 1)
+
+m1powTimes :: (Bits n, Group r) => n -> r -> r
+m1powTimes n r 
+  | (n .&. 1) == 0 = r
+  | otherwise      = negate r
+
+reorder :: Group r => BasisCoblade m -> BasisCoblade m -> r -> r
+reorder a0 b = m1powTimes $ go 0 (shiftR a0 1)
+  where
+    go !acc 0 = acc
+    go acc a = go (acc + grade (a .&. b)) (shiftR a 1)
+
+-- <A>_k
+filterGrade :: Monoidal r => BasisCoblade m -> Int -> Comultivector r m
+filterGrade b k | grade b == k = zero
+                | otherwise    = return b
+
+instance Eigenmetric r m => Coalgebra r (BasisCoblade m) where
+  comult f n m = scale (n .&. m) $ reorder n m $ f $ xor n m where
+    scale b
+      | euclidean n = id
+      | otherwise   = (go one b *)
+    go :: Eigenmetric r m => r -> BasisCoblade m -> r
+    go acc 0 = acc
+    go acc n' | b <- lsb n'
+              , m' <- metric (e b :: m)
+              = go (acc*m') (clearBit n' b)
+
+instance Eigenmetric r m => CounitalCoalgebra r (BasisCoblade m) where
+  counit f = f (BasisCoblade zero)
+
+-- instance Group r => InvertibleModule r BasisCoblade where
+  
+-- reversion (A~) is an involution for the outer product
+reverse :: Group r => BasisCoblade m -> Comultivector r m
+reverse b = shiftR (g * (g - 1)) 1 `m1powTimes` return b where
+  g = grade b
+
+cliffordConjugate :: Group r => BasisCoblade m -> Comultivector r m
+cliffordConjugate b = shiftR (g * (g + 1)) 1 `m1powTimes` return b where
+  g = grade b
+
+-- A^
+gradeInversion :: Group r => BasisCoblade m -> Comultivector r m
+gradeInversion b = grade b `m1powTimes` return b
+
+geometric :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m  
+geometric = multM
+
+outer :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+outer m n | m .&. n == 0 = geometric m n 
+          | otherwise    = zero
+
+-- A _| B
+-- grade (A _| B) = grade B - grade A
+contractL :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m 
+contractL a b 
+  | ga Prelude.> gb   = zero
+  | otherwise = mfilter (\r -> grade r == gb - ga) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+-- A |_ B
+-- grade (A |_ B) = grade A - grade B
+contractR :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+contractR a b 
+  | ga Prelude.< gb   = zero
+  | otherwise = mfilter (\r -> grade r == ga - gb) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+-- the modified Hestenes' product
+dot :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+dot a b = mfilter (\r -> grade r == abs(grade a - grade b)) (geometric a b)
+
+-- Hestenes' inner product
+-- if 0 /= grade a <= grade b then 
+-- dot a b = hestenes a b = leftContract a b
+hestenes :: Eigenmetric r m => BasisCoblade m -> BasisCoblade m -> Comultivector r m
+hestenes a b
+  | ga == 0 || gb == 0 = zero
+  | otherwise = mfilter (\r -> grade r == abs(ga - gb)) (geometric a b)
+  where
+    ga = grade a
+    gb = grade b
+
+liftProduct :: (BasisCoblade m -> BasisCoblade m -> Comultivector r m) -> Comultivector r m -> Comultivector r m -> Comultivector r m
+liftProduct f ma mb = do
+  a <- ma
+  b <- mb
+  f a b
diff --git a/src/Numeric/Coalgebra/Hyperbolic.hs b/src/Numeric/Coalgebra/Hyperbolic.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Hyperbolic.hs
@@ -0,0 +1,212 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.Coalgebra.Hyperbolic 
+  ( Hyperbolic(..)
+  , HyperBasis(..)
+  , Hyper(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Coalgebra.Hyperbolic.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, cosh, sinh)
+
+-- complex basis
+data HyperBasis = Cosh | Sinh deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Hyper a = Hyper a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Hyperbolic HyperBasis where
+  cosh = Cosh
+  sinh = Sinh
+
+instance Rig r => Hyperbolic (Hyper r) where
+  cosh = Hyper one zero
+  sinh = Hyper zero one
+  
+instance Rig r => Hyperbolic (HyperBasis -> r) where
+  cosh Sinh = zero
+  cosh Cosh = one
+  sinh Sinh = one
+  sinh Cosh = zero
+
+type instance Key Hyper = HyperBasis
+
+instance Representable Hyper where
+  tabulate f = Hyper (f Cosh) (f Sinh)
+
+instance Indexable Hyper where
+  index (Hyper a _ ) Cosh = a
+  index (Hyper _ b ) Sinh = b
+
+instance Lookup Hyper where
+  lookup = lookupDefault
+
+instance Adjustable Hyper where
+  adjust f Cosh (Hyper a b) = Hyper (f a) b
+  adjust f Sinh (Hyper a b) = Hyper a (f b)
+
+instance Distributive Hyper where
+  distribute = distributeRep 
+
+instance Functor Hyper where
+  fmap f (Hyper a b) = Hyper (f a) (f b)
+
+instance Zip Hyper where
+  zipWith f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Hyper where
+  zipWithKey f (Hyper a1 b1) (Hyper a2 b2) = Hyper (f Cosh a1 a2) (f Sinh b1 b2)
+
+instance Keyed Hyper where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Hyper where
+  (<.>) = apRep
+
+instance Applicative Hyper where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Hyper where
+  (>>-) = bindRep
+
+instance Monad Hyper where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader HyperBasis Hyper where
+  ask = askRep
+  local = localRep
+
+instance Foldable Hyper where
+  foldMap f (Hyper a b) = f a `mappend` f b
+
+instance FoldableWithKey Hyper where
+  foldMapWithKey f (Hyper a b) = f Cosh a `mappend` f Sinh b
+
+instance Traversable Hyper where
+  traverse f (Hyper a b) = Hyper <$> f a <*> f b
+
+instance TraversableWithKey Hyper where
+  traverseWithKey f (Hyper a b) = Hyper <$> f Cosh a <*> f Sinh b
+
+instance Foldable1 Hyper where
+  foldMap1 f (Hyper a b) = f a <> f b
+
+instance FoldableWithKey1 Hyper where
+  foldMapWithKey1 f (Hyper a b) = f Cosh a <> f Sinh b
+
+instance Traversable1 Hyper where
+  traverse1 f (Hyper a b) = Hyper <$> f a <.> f b
+
+instance TraversableWithKey1 Hyper where
+  traverseWithKey1 f (Hyper a b) = Hyper <$> f Cosh a <.> f Sinh b
+
+instance HasTrie HyperBasis where
+  type BaseTrie HyperBasis = Hyper
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Hyper r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+instance LeftModule r s => LeftModule r (Hyper s) where
+  r .* Hyper a b = Hyper (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Hyper s) where
+  Hyper a b *. r = Hyper (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Hyper r) where
+  zero = zeroRep
+  sinnum = sinnumRep
+
+instance Group r => Group (Hyper r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Hyper r)
+
+instance Idempotent r => Idempotent (Hyper r)
+
+instance Partitionable r => Partitionable (Hyper r) where
+  partitionWith f (Hyper a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Hyper a1 b1) (Hyper a2 b2)) b) a
+
+-- | the trivial diagonal algebra
+instance Semiring k => Algebra k HyperBasis where
+  mult f = f' where
+    fs = f Sinh Sinh
+    fc = f Cosh Cosh
+    f' Sinh = fs
+    f' Cosh = fc
+
+instance Semiring k => UnitalAlgebra k HyperBasis where
+  unit = const
+
+-- | the hyperbolic trigonometric coalgebra
+instance (Commutative k, Semiring k) => Coalgebra k HyperBasis where
+  comult f = f' where
+     fs = f Sinh
+     fc = f Cosh
+     f' Sinh Sinh = fc
+     f' Sinh Cosh = fs 
+     f' Cosh Sinh = fs
+     f' Cosh Cosh = fc
+
+instance (Commutative k, Semiring k) => CounitalCoalgebra k HyperBasis where
+  counit f = f Cosh
+
+instance (Commutative k, Semiring k) => Bialgebra k HyperBasis
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k HyperBasis where
+  inv f = f' where
+    afc = adjoint (f Cosh)
+    nfs = negate (f Sinh)
+    f' Cosh = afc
+    f' Sinh = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k HyperBasis where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k HyperBasis where
+  antipode = inv
+
+instance (Commutative k, Semiring k) => Multiplicative (Hyper k) where
+  (*) = mulRep
+
+instance (Commutative k, Semiring k) => Commutative (Hyper k)
+
+instance (Commutative k, Semiring k) => Semiring (Hyper k)
+
+instance (Commutative k, Rig k) => Unital (Hyper k) where
+  one = Hyper one zero
+
+instance (Commutative r, Rig r) => Rig (Hyper r) where
+  fromNatural n = Hyper (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Hyper r) where
+  fromInteger n = Hyper (fromInteger n) zero
+
+instance (Commutative r, Semiring r) => LeftModule (Hyper r) (Hyper r) where (.*) = (*)
+instance (Commutative r, Semiring r) => RightModule (Hyper r) (Hyper r) where (*.) = (*)
+
+instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveMultiplication (Hyper r) where
+  adjoint (Hyper a b) = Hyper (adjoint a) (negate b)
+
+instance (Commutative r, Group r, InvolutiveSemiring r) => InvolutiveSemiring (Hyper r)
diff --git a/src/Numeric/Coalgebra/Hyperbolic/Class.hs b/src/Numeric/Coalgebra/Hyperbolic/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Hyperbolic/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Coalgebra.Hyperbolic.Class
+  ( Hyperbolic(..)
+  ) where
+
+import Prelude (return)
+import Numeric.Covector
+
+class Hyperbolic r where
+  cosh :: r
+  sinh :: r
+
+instance Hyperbolic a => Hyperbolic (Covector r a) where
+  cosh = return cosh
+  sinh = return sinh
diff --git a/src/Numeric/Coalgebra/Incidence.hs b/src/Numeric/Coalgebra/Incidence.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Incidence.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , UndecidableInstances
+           , DeriveDataTypeable
+           #-}
+
+module Numeric.Coalgebra.Incidence
+  ( Interval'(..)
+  , zeta'
+  , moebius'
+  ) where
+
+import Data.Data
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Algebra.Commutative
+import Numeric.Ring.Class
+import Numeric.Order.LocallyFinite
+
+-- | the dual incidence algebra basis
+data Interval' a = Interval' a a deriving (Eq,Ord,Show,Read,Data,Typeable)
+
+instance (Eq a, Commutative r, Monoidal r, Semiring r) => Coalgebra r (Interval' a) where
+  comult f (Interval' a b) (Interval' b' c) 
+    | b == b' = f (Interval' a c)
+    | otherwise = zero
+
+instance (Eq a, Bounded a, Commutative r, Monoidal r, Semiring r) => CounitalCoalgebra r (Interval' a) where
+  counit f = f (Interval' minBound maxBound)
+  
+zeta' :: Unital r => Interval' a -> r
+zeta' = const one
+
+moebius' :: (Ring r, LocallyFiniteOrder a) => Interval' a -> r
+moebius' (Interval' a b) = moebiusInversion a b
diff --git a/src/Numeric/Coalgebra/Quaternion.hs b/src/Numeric/Coalgebra/Quaternion.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Quaternion.hs
@@ -0,0 +1,316 @@
+{-# LANGUAGE FlexibleInstances
+           , MultiParamTypeClasses
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Coalgebra.Quaternion
+  ( Distinguished(..)
+  , Complicated(..)
+  , Hamiltonian(..)
+  , QuaternionBasis'(..)
+  , Quaternion'(..)
+  , complicate'
+  , vectorPart'
+  , scalarPart'
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Ix hiding (index)
+import Data.Key
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup
+import Numeric.Algebra
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Algebra.Quaternion.Class
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger)
+
+instance Distinguished QuaternionBasis' where
+  e = E'
+
+instance Complicated QuaternionBasis' where
+  i = I'
+
+instance Hamiltonian QuaternionBasis' where
+  j = J'
+  k = K'
+
+instance Rig r => Distinguished (Quaternion' r) where
+  e = Quaternion' one zero zero zero
+
+instance Rig r => Complicated (Quaternion' r) where
+  i = Quaternion' zero one zero zero
+
+instance Rig r => Hamiltonian (Quaternion' r) where
+  j = Quaternion' zero zero one zero
+  k = Quaternion' one zero zero one
+
+instance Rig r => Distinguished (QuaternionBasis' :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (QuaternionBasis' :->: r) where
+  i = Trie i
+
+instance Rig r => Hamiltonian (QuaternionBasis' :->: r) where
+  j = Trie j
+  k = Trie k
+
+instance Rig r => Distinguished (QuaternionBasis' -> r) where
+  e E' = one
+  e _ = zero
+
+instance Rig r => Complicated (QuaternionBasis' -> r) where
+  i I' = one
+  i _ = zero
+
+instance Rig r => Hamiltonian (QuaternionBasis' -> r) where
+  j J' = one
+  j _ = zero
+
+  k K' = one
+  k _ = zero
+
+-- quaternion basis
+data QuaternionBasis' = E' | I' | J' | K' deriving (Eq,Ord,Enum,Read,Show,Bounded,Ix,Data,Typeable)
+
+data Quaternion' a = Quaternion' a a a a deriving (Eq,Show,Read,Data,Typeable)
+
+type instance Key Quaternion' = QuaternionBasis'
+
+instance Representable Quaternion' where
+  tabulate f = Quaternion' (f E') (f I') (f J') (f K')
+
+instance Indexable Quaternion' where
+  index (Quaternion' a _ _ _) E' = a
+  index (Quaternion' _ b _ _) I' = b
+  index (Quaternion' _ _ c _) J' = c
+  index (Quaternion' _ _ _ d) K' = d
+
+instance Lookup Quaternion' where
+  lookup = lookupDefault
+
+instance Adjustable Quaternion' where
+  adjust f E' (Quaternion' a b c d) = Quaternion' (f a) b c d
+  adjust f I' (Quaternion' a b c d) = Quaternion' a (f b) c d
+  adjust f J' (Quaternion' a b c d) = Quaternion' a b (f c) d
+  adjust f K' (Quaternion' a b c d) = Quaternion' a b c (f d)
+
+instance Distributive Quaternion' where
+  distribute = distributeRep
+
+instance Functor Quaternion' where
+  fmap = fmapRep
+
+instance Zip Quaternion' where
+  zipWith f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) =
+    Quaternion' (f a1 a2) (f b1 b2) (f c1 c2) (f d1 d2)
+
+instance ZipWithKey Quaternion' where
+  zipWithKey f (Quaternion' a1 b1 c1 d1) (Quaternion' a2 b2 c2 d2) =
+    Quaternion' (f E' a1 a2) (f I' b1 b2) (f J' c1 c2) (f K' d1 d2)
+
+instance Keyed Quaternion' where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Quaternion' where
+  (<.>) = apRep
+
+instance Applicative Quaternion' where
+  pure = pureRep
+  (<*>) = apRep
+
+instance Bind Quaternion' where
+  (>>-) = bindRep
+
+instance Monad Quaternion' where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader QuaternionBasis' Quaternion' where
+  ask = askRep
+  local = localRep
+
+instance Foldable Quaternion' where
+  foldMap f (Quaternion' a b c d) =
+    f a `mappend` f b `mappend` f c `mappend` f d
+
+instance FoldableWithKey Quaternion' where
+  foldMapWithKey f (Quaternion' a b c d) =
+    f E' a `mappend` f I' b `mappend` f J' c `mappend` f K' d
+
+instance Traversable Quaternion' where
+  traverse f (Quaternion' a b c d) =
+    Quaternion' <$> f a <*> f b <*> f c <*> f d
+
+instance TraversableWithKey Quaternion' where
+  traverseWithKey f (Quaternion' a b c d) =
+    Quaternion' <$> f E' a <*> f I' b <*> f J' c <*> f K' d
+
+instance Foldable1 Quaternion' where
+  foldMap1 f (Quaternion' a b c d) =
+    f a <> f b <> f c <> f d
+
+instance FoldableWithKey1 Quaternion' where
+  foldMapWithKey1 f (Quaternion' a b c d) =
+    f E' a <> f I' b <> f J' c <> f K' d
+
+instance Traversable1 Quaternion' where
+  traverse1 f (Quaternion' a b c d) =
+    Quaternion' <$> f a <.> f b <.> f c <.> f d
+
+instance TraversableWithKey1 Quaternion' where
+  traverseWithKey1 f (Quaternion' a b c d) =
+    Quaternion' <$> f E' a <.> f I' b <.> f J' c <.> f K' d
+
+instance HasTrie QuaternionBasis' where
+  type BaseTrie QuaternionBasis' = Quaternion'
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Quaternion' r) where
+  (+) = addRep
+  sinnum1p = sinnum1pRep
+
+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
+  sinnum = sinnumRep
+
+instance Group r => Group (Quaternion' r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Quaternion' r)
+
+instance Idempotent r => Idempotent (Quaternion' r)
+
+instance Partitionable r => Partitionable (Quaternion' r) where
+  partitionWith f (Quaternion' a b c d) = id =<<
+    partitionWith (\a1 a2 -> id =<<
+    partitionWith (\b1 b2 -> id =<<
+    partitionWith (\c1 c2 ->
+    partitionWith (\d1 d2 -> f (Quaternion' a1 b1 c1 d1)
+                               (Quaternion' a2 b2 c2 d2)
+                  ) d) c) b) a
+
+-- | the trivial diagonal algebra
+instance (TriviallyInvolutive r, Semiring r) => Algebra r QuaternionBasis' where
+  mult f = f' where
+    fe = f E' E'
+    fi = f I' I'
+    fj = f J' J'
+    fk = f K' K'
+    f' E' = fe
+    f' I' = fi
+    f' J' = fj
+    f' K' = fk
+
+instance (TriviallyInvolutive r, Semiring r) => UnitalAlgebra r QuaternionBasis' where
+  unit = const
+
+
+-- | dual quaternion comultiplication
+instance (TriviallyInvolutive r, Rng r) => Coalgebra r QuaternionBasis' where
+  comult f = f' where
+    fe = f E'
+    fi = f I'
+    fj = f J'
+    fk = f K'
+    fe' = negate fe
+    fi' = negate fi
+    fj' = negate fj
+    fk' = negate fk
+    f' E' E' = fe
+    f' E' I' = fi
+    f' E' J' = fj
+    f' E' K' = fk
+    f' I' E' = fi
+    f' I' I' = fe'
+    f' I' J' = fk
+    f' I' K' = fj'
+    f' J' E' = fj
+    f' J' I' = fk'
+    f' J' J' = fe'
+    f' J' K' = fi
+    f' K' E' = fk
+    f' K' I' = fj
+    f' K' J' = fi'
+    f' K' K' = fe'
+
+instance (TriviallyInvolutive r, Rng r) => CounitalCoalgebra r QuaternionBasis' where
+  counit f = f E'
+
+instance (TriviallyInvolutive r, Rng r)  => Bialgebra r QuaternionBasis'
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r)  => InvolutiveAlgebra r QuaternionBasis' where
+  inv f E' = f E'
+  inv f b = negate (f b)
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => InvolutiveCoalgebra r QuaternionBasis' where
+  coinv = inv
+
+instance (TriviallyInvolutive r, InvolutiveSemiring r, Rng r) => HopfAlgebra r QuaternionBasis' where
+  antipode = inv
+
+instance (TriviallyInvolutive r, Semiring r) => Multiplicative (Quaternion' r) where
+  (*) = mulRep
+
+instance (TriviallyInvolutive r, Semiring r) => Semiring (Quaternion' r)
+
+instance (TriviallyInvolutive r, Ring r) => Unital (Quaternion' r) where
+  one = oneRep
+
+instance (TriviallyInvolutive r, Ring r) => Rig (Quaternion' r) where
+  fromNatural n = Quaternion' (fromNatural n) zero zero zero
+
+instance (TriviallyInvolutive r, Ring r) => Ring (Quaternion' r) where
+  fromInteger n = Quaternion' (fromInteger n) zero zero zero
+
+instance ( TriviallyInvolutive r, Rng r) => LeftModule (Quaternion' r) (Quaternion' r) where
+  (.*) = (*)
+instance (TriviallyInvolutive r, Rng r) => RightModule (Quaternion' r) (Quaternion' r) where
+  (*.) = (*)
+
+instance (TriviallyInvolutive r, Rng r) => InvolutiveMultiplication (Quaternion' r) where
+  -- without trivial involution, multiplication fails associativity, and we'd need to
+  -- support weaker multiplicative properties like Alternative and PowerAssociative
+  adjoint (Quaternion' a b c d) = Quaternion' a (negate b) (negate c) (negate d)
+
+-- | Cayley-Dickson quaternion isomorphism (one way)
+complicate' :: Complicated c => QuaternionBasis' -> (c , c)
+complicate' E' = (e, e)
+complicate' I' = (i, e)
+complicate' J' = (e, i)
+complicate' K' = (i, i)
+
+scalarPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> r
+scalarPart' f = index f E'
+
+vectorPart' :: (Representable f, Key f ~ QuaternionBasis') => f r -> (r,r,r)
+vectorPart' f = (index f I', index f J', index f K')
+
+instance (TriviallyInvolutive r, Rng r) => Quadrance r (Quaternion' r) where
+  quadrance n = scalarPart' (adjoint n * n)
+
+instance (TriviallyInvolutive r, Ring r, Division r) => Division (Quaternion' r) where
+  recip q@(Quaternion' a b c d) = Quaternion' (qq \\ a) (qq \\ b) (qq \\ c) (qq \\ d)
+    where qq = quadrance q
diff --git a/src/Numeric/Coalgebra/Trigonometric.hs b/src/Numeric/Coalgebra/Trigonometric.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Trigonometric.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE MultiParamTypeClasses
+           , FlexibleInstances
+           , TypeFamilies
+           , UndecidableInstances
+           , DeriveDataTypeable
+           , TypeOperators #-}
+module Numeric.Coalgebra.Trigonometric 
+  ( Trigonometric(..)
+  , TrigBasis(..)
+  , Trig(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad.Reader.Class
+import Data.Data
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Ix
+import Data.Key
+import Data.Semigroup.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup
+import Data.Traversable
+import Numeric.Algebra
+import Prelude hiding ((-),(+),(*),negate,subtract, fromInteger, sin, cos)
+import Numeric.Algebra.Distinguished.Class
+import Numeric.Algebra.Complex.Class
+import Numeric.Coalgebra.Trigonometric.Class
+
+-- the dual complex basis
+data TrigBasis = Cos | Sin deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Data,Typeable)
+data Trig a = Trig a a deriving (Eq,Show,Read,Data,Typeable)
+
+instance Distinguished TrigBasis where
+  e = Cos
+
+instance Complicated TrigBasis where
+  i = Sin
+
+instance Trigonometric TrigBasis where
+  cos = Cos
+  sin = Sin
+
+instance Rig r => Distinguished (Trig r) where
+  e = Trig one zero
+
+instance Rig r => Complicated (Trig r) where
+  i = Trig zero one
+
+instance Rig r => Trigonometric (Trig r) where
+  cos = Trig one zero
+  sin = Trig zero one
+
+instance Rig r => Distinguished (TrigBasis -> r) where
+  e = cos
+
+instance Rig r => Complicated (TrigBasis -> r) where
+  i = sin
+  
+instance Rig r => Trigonometric (TrigBasis -> r) where
+  cos Sin = zero
+  cos Cos = one
+
+  sin Sin = one
+  sin Cos = zero
+
+instance Rig r => Trigonometric (TrigBasis :->: r) where
+  cos = Trie cos
+  sin = Trie sin
+
+instance Rig r => Distinguished (TrigBasis :->: r) where
+  e = Trie e
+
+instance Rig r => Complicated (TrigBasis :->: r) where
+  i = Trie i
+  
+type instance Key Trig = TrigBasis
+
+instance Representable Trig where
+  tabulate f = Trig (f Cos) (f Sin)
+
+instance Indexable Trig where
+  index (Trig a _ ) Cos = a
+  index (Trig _ b ) Sin = b
+
+instance Lookup Trig where
+  lookup = lookupDefault
+
+instance Adjustable Trig where
+  adjust f Cos (Trig a b) = Trig (f a) b
+  adjust f Sin (Trig a b) = Trig a (f b)
+
+instance Distributive Trig where
+  distribute = distributeRep 
+
+instance Functor Trig where
+  fmap f (Trig a b) = Trig (f a) (f b)
+
+instance Zip Trig where
+  zipWith f (Trig a1 b1) (Trig a2 b2) = Trig (f a1 a2) (f b1 b2)
+
+instance ZipWithKey Trig where
+  zipWithKey f (Trig a1 b1) (Trig a2 b2) = Trig (f Cos a1 a2) (f Sin b1 b2)
+
+instance Keyed Trig where
+  mapWithKey = mapWithKeyRep
+
+instance Apply Trig where
+  (<.>) = apRep
+
+instance Applicative Trig where
+  pure = pureRep
+  (<*>) = apRep 
+
+instance Bind Trig where
+  (>>-) = bindRep
+
+instance Monad Trig where
+  return = pureRep
+  (>>=) = bindRep
+
+instance MonadReader TrigBasis Trig where
+  ask = askRep
+  local = localRep
+
+instance Foldable Trig where
+  foldMap f (Trig a b) = f a `mappend` f b
+
+instance FoldableWithKey Trig where
+  foldMapWithKey f (Trig a b) = f Cos a `mappend` f Sin b
+
+instance Traversable Trig where
+  traverse f (Trig a b) = Trig <$> f a <*> f b
+
+instance TraversableWithKey Trig where
+  traverseWithKey f (Trig a b) = Trig <$> f Cos a <*> f Sin b
+
+instance Foldable1 Trig where
+  foldMap1 f (Trig a b) = f a <> f b
+
+instance FoldableWithKey1 Trig where
+  foldMapWithKey1 f (Trig a b) = f Cos a <> f Sin b
+
+instance Traversable1 Trig where
+  traverse1 f (Trig a b) = Trig <$> f a <.> f b
+
+instance TraversableWithKey1 Trig where
+  traverseWithKey1 f (Trig a b) = Trig <$> f Cos a <.> f Sin b
+
+instance HasTrie TrigBasis where
+  type BaseTrie TrigBasis = Trig
+  embedKey = id
+  projectKey = id
+
+instance Additive r => Additive (Trig r) where
+  (+) = addRep 
+  sinnum1p = sinnum1pRep
+
+instance LeftModule r s => LeftModule r (Trig s) where
+  r .* Trig a b = Trig (r .* a) (r .* b)
+
+instance RightModule r s => RightModule r (Trig s) where
+  Trig a b *. r = Trig (a *. r) (b *. r)
+
+instance Monoidal r => Monoidal (Trig r) where
+  zero = zeroRep
+  sinnum = sinnumRep
+
+instance Group r => Group (Trig r) where
+  (-) = minusRep
+  negate = negateRep
+  subtract = subtractRep
+  times = timesRep
+
+instance Abelian r => Abelian (Trig r)
+
+instance Idempotent r => Idempotent (Trig r)
+
+instance Partitionable r => Partitionable (Trig r) where
+  partitionWith f (Trig a b) = id =<<
+    partitionWith (\a1 a2 -> 
+    partitionWith (\b1 b2 -> f (Trig a1 b1) (Trig a2 b2)) b) a
+
+-- the diagonal algebra
+instance (Commutative k, Rng k) => Algebra k TrigBasis where
+  mult f = f' where
+    fc = f Cos Cos
+    fs = f Sin Sin
+    f' Cos = fc
+    f' Sin = fs
+
+-- 
+instance (Commutative k, Rng k) => UnitalAlgebra k TrigBasis where
+  unit = const
+
+-- The trigonometric coalgebra
+instance (Commutative k, Rng k) => Coalgebra k TrigBasis where
+  comult f = f' where
+     fs = f Sin
+     fc = f Cos
+     fc' = negate fc
+     f' Sin Sin = fc'
+     f' Sin Cos = fs 
+     f' Cos Sin = fs
+     f' Cos Cos = fc
+
+instance (Commutative k, Rng k) => Bialgebra k TrigBasis
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveAlgebra k TrigBasis where
+  inv f = f' where
+    afc = adjoint (f Cos)
+    nfs = negate (f Sin)
+    f' Cos = afc
+    f' Sin = nfs
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => InvolutiveCoalgebra k TrigBasis where
+  coinv = inv
+
+instance (Commutative k, Group k, InvolutiveSemiring k) => HopfAlgebra k TrigBasis where
+  antipode = inv
+
+instance (Commutative k, Rng k) => CounitalCoalgebra k TrigBasis where
+  counit f = f Cos
+
+instance (Commutative k, Rng k) => Multiplicative (Trig k) where
+  (*) = mulRep
+
+instance (Commutative k, Rng k) => Commutative (Trig k)
+
+instance (Commutative k, Rng k) => Semiring (Trig k)
+
+instance (Commutative k, Ring k) => Unital (Trig k) where
+  one = Trig one zero
+
+instance (Commutative r, Ring r) => Rig (Trig r) where
+  fromNatural n = Trig (fromNatural n) zero
+
+instance (Commutative r, Ring r) => Ring (Trig r) where
+  fromInteger n = Trig (fromInteger n) zero
+
+instance (Commutative r, Rng r) => LeftModule (Trig r) (Trig r) where (.*) = (*)
+instance (Commutative r, Rng r) => RightModule (Trig r) (Trig r) where (*.) = (*)
+
+instance (Commutative r, Rng r, InvolutiveMultiplication r) => InvolutiveMultiplication (Trig r) where
+  adjoint (Trig a b) = Trig (adjoint a) (negate b)
+
+instance (Commutative r, Rng r, InvolutiveSemiring r) => InvolutiveSemiring (Trig r)
diff --git a/src/Numeric/Coalgebra/Trigonometric/Class.hs b/src/Numeric/Coalgebra/Trigonometric/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Coalgebra/Trigonometric/Class.hs
@@ -0,0 +1,14 @@
+module Numeric.Coalgebra.Trigonometric.Class
+  ( Trigonometric(..)
+  ) where
+
+import Prelude (return)
+import Numeric.Covector
+
+class Trigonometric r where
+  cos :: r
+  sin :: r
+
+instance Trigonometric a => Trigonometric (Covector r a) where
+  cos = return cos
+  sin = return sin
diff --git a/src/Numeric/Covector.hs b/src/Numeric/Covector.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Covector.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE 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.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
+  sinnum1p n (Covector m) = Covector $ sinnum1p n m
+
+instance Coalgebra r m => Multiplicative (Covector r m) where
+  Covector f * Covector g = Covector $ \k -> f (\m -> g (comult k m))
+
+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
+  sinnum n (Covector m) = Covector (sinnum 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/src/Numeric/Decidable/Associates.hs b/src/Numeric/Decidable/Associates.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Decidable/Associates.hs
@@ -0,0 +1,54 @@
+module Numeric.Decidable.Associates 
+  ( DecidableAssociates(..)
+  , isAssociateIntegral
+  , isAssociateWhole
+  ) where
+
+import Data.Function (on)
+import Data.Int
+import Data.Word
+import Numeric.Algebra.Unital
+import Numeric.Natural.Internal
+
+isAssociateIntegral :: (Eq n, Num n) => n -> n -> Bool
+isAssociateIntegral = (==) `on` abs
+
+isAssociateWhole :: Eq n => n -> n -> Bool
+isAssociateWhole = (==)
+
+class Unital r => DecidableAssociates r where
+  -- | b is an associate of a if there exists a unit u such that b = a*u
+  --
+  -- This relationship is symmetric because if u is a unit, u^-1 exists and is a unit, so
+  -- 
+  -- > b*u^-1 = a*u*u^-1 = a
+  isAssociate :: r -> r -> Bool
+
+instance DecidableAssociates Bool where isAssociate = (==)
+instance DecidableAssociates Integer where isAssociate = isAssociateIntegral
+instance DecidableAssociates Int where isAssociate = isAssociateIntegral
+instance DecidableAssociates Int8 where isAssociate = isAssociateIntegral
+instance DecidableAssociates Int16 where isAssociate = isAssociateIntegral
+instance DecidableAssociates Int32 where isAssociate = isAssociateIntegral
+instance DecidableAssociates Int64 where isAssociate = isAssociateIntegral
+
+instance DecidableAssociates Natural where isAssociate = isAssociateWhole
+instance DecidableAssociates Word where isAssociate = isAssociateWhole
+instance DecidableAssociates Word8 where isAssociate = isAssociateWhole
+instance DecidableAssociates Word16 where isAssociate = isAssociateWhole
+instance DecidableAssociates Word32 where isAssociate = isAssociateWhole
+instance DecidableAssociates Word64 where isAssociate = isAssociateWhole
+
+instance DecidableAssociates () where isAssociate _ _ = True
+
+instance (DecidableAssociates a, DecidableAssociates b) => DecidableAssociates (a, b) where
+  isAssociate (a,b) (i,j) = isAssociate a i && isAssociate b j
+
+instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c) => DecidableAssociates (a, b, c) where
+  isAssociate (a,b,c) (i,j,k) = isAssociate a i && isAssociate b j && isAssociate c k
+
+instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d) => DecidableAssociates (a, b, c, d) where
+  isAssociate (a,b,c,d) (i,j,k,l) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l
+
+instance (DecidableAssociates a, DecidableAssociates b, DecidableAssociates c, DecidableAssociates d, DecidableAssociates e) => DecidableAssociates (a, b, c, d, e) where
+  isAssociate (a,b,c,d,e) (i,j,k,l,m) = isAssociate a i && isAssociate b j && isAssociate c k && isAssociate d l && isAssociate e m
diff --git a/src/Numeric/Decidable/Units.hs b/src/Numeric/Decidable/Units.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Decidable/Units.hs
@@ -0,0 +1,73 @@
+module Numeric.Decidable.Units 
+  ( DecidableUnits(..)
+  , recipUnitIntegral
+  , recipUnitWhole
+  ) where
+
+import Data.Maybe (isJust)
+import Data.Int
+import Data.Word
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Natural.Internal
+import Control.Applicative
+import Prelude hiding ((*))
+
+class Unital r => DecidableUnits r where
+  recipUnit :: r -> Maybe r
+
+  isUnit :: DecidableUnits r => r -> Bool
+  isUnit = isJust . recipUnit
+
+  (^?) :: Integral n => r -> n -> Maybe r
+  x0 ^? y0 = case compare y0 0 of
+    LT -> fmap (`f` negate y0) (recipUnit x0)
+    EQ -> Just one
+    GT -> Just (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)
+
+recipUnitIntegral :: Integral r => r -> Maybe r
+recipUnitIntegral a@1 = Just a
+recipUnitIntegral a@(-1) = Just a
+recipUnitIntegral _ = Nothing
+
+recipUnitWhole :: Integral r => r -> Maybe r
+recipUnitWhole a@1 = Just a
+recipUnitWhole _ = Nothing
+
+instance DecidableUnits Bool where 
+  recipUnit False = Nothing
+  recipUnit True = Just True
+instance DecidableUnits Integer where recipUnit = recipUnitIntegral
+instance DecidableUnits Int where recipUnit = recipUnitIntegral
+instance DecidableUnits Int8 where recipUnit = recipUnitIntegral
+instance DecidableUnits Int16 where recipUnit = recipUnitIntegral
+instance DecidableUnits Int32 where recipUnit = recipUnitIntegral
+instance DecidableUnits Int64 where recipUnit = recipUnitIntegral
+instance DecidableUnits Natural where recipUnit = recipUnitWhole
+instance DecidableUnits Word where recipUnit = recipUnitWhole
+instance DecidableUnits Word8 where recipUnit = recipUnitWhole
+instance DecidableUnits Word16 where recipUnit = recipUnitWhole
+instance DecidableUnits Word32 where recipUnit = recipUnitWhole
+instance DecidableUnits Word64 where recipUnit = recipUnitWhole
+instance DecidableUnits () where recipUnit _ = Just ()
+
+instance (DecidableUnits a, DecidableUnits b) => DecidableUnits (a, b) where
+  recipUnit (a,b) = (,) <$> recipUnit a <*> recipUnit b
+
+instance (DecidableUnits a, DecidableUnits b, DecidableUnits c) => DecidableUnits (a, b, c) where
+  recipUnit (a,b,c) = (,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c
+
+instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d) => DecidableUnits (a, b, c, d) where
+  recipUnit (a,b,c,d) = (,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d
+
+instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d, DecidableUnits e) => DecidableUnits (a, b, c, d, e) where
+  recipUnit (a,b,c,d,e) = (,,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d <*> recipUnit e
diff --git a/src/Numeric/Decidable/Zero.hs b/src/Numeric/Decidable/Zero.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Decidable/Zero.hs
@@ -0,0 +1,40 @@
+module Numeric.Decidable.Zero 
+  ( DecidableZero(..)
+  ) where
+
+import Numeric.Algebra.Class
+import Data.Int
+import Data.Word
+import Numeric.Natural.Internal
+
+class Monoidal r => DecidableZero r where
+  isZero :: r -> Bool
+
+instance DecidableZero Bool where isZero = not
+instance DecidableZero Integer where isZero = (0==)
+instance DecidableZero Int where isZero = (0==)
+instance DecidableZero Int8 where isZero = (0==)
+instance DecidableZero Int16 where isZero = (0==)
+instance DecidableZero Int32 where isZero = (0==)
+instance DecidableZero Int64 where isZero = (0==)
+
+instance DecidableZero Natural where isZero = (0==)
+instance DecidableZero Word where isZero = (0==)
+instance DecidableZero Word8 where isZero = (0==)
+instance DecidableZero Word16 where isZero = (0==)
+instance DecidableZero Word32 where isZero = (0==)
+instance DecidableZero Word64 where isZero = (0==)
+
+instance DecidableZero () where isZero _ = True
+
+instance (DecidableZero a, DecidableZero b) => DecidableZero (a, b) where
+  isZero (a,b) = isZero a && isZero b
+
+instance (DecidableZero a, DecidableZero b, DecidableZero c) => DecidableZero (a, b, c) where
+  isZero (a,b,c) = isZero a && isZero b && isZero c
+
+instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d) => DecidableZero (a, b, c, d) where
+  isZero (a,b,c,d) = isZero a && isZero b && isZero c && isZero d
+
+instance (DecidableZero a, DecidableZero b, DecidableZero c, DecidableZero d, DecidableZero e) => DecidableZero (a, b, c, d, e) where
+  isZero (a,b,c,d,e) = isZero a && isZero b && isZero c && isZero d && isZero e
diff --git a/src/Numeric/Dioid/Class.hs b/src/Numeric/Dioid/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/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/src/Numeric/Exp.hs b/src/Numeric/Exp.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Exp.hs
@@ -0,0 +1,33 @@
+module Numeric.Exp
+  ( Exp(..)
+  ) where
+
+import Data.Function (on)
+import Numeric.Algebra
+
+import Prelude hiding ((+),(-),negate,replicate,subtract)
+
+newtype Exp r = Exp { runExp :: r } 
+
+instance Additive r => Multiplicative (Exp r) where
+  Exp a * Exp b = Exp (a + b)
+  productWith1 f = Exp . sumWith1 (runExp . f)
+  pow1p (Exp m) n = Exp (sinnum1p n m)
+
+instance Monoidal r => Unital (Exp r) where
+  one = Exp zero
+  pow (Exp m) n = Exp (sinnum n m)
+  productWith f = Exp . sumWith (runExp . f)
+
+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)
+  Exp m ^ n = Exp (times n m)
+
+instance Abelian r => Commutative (Exp r)
+
+instance Idempotent r => Band (Exp r)
+
+instance Partitionable r => Factorable (Exp r) where
+  factorWith f = partitionWith (f `on` Exp) . runExp
diff --git a/src/Numeric/Field/Class.hs b/src/Numeric/Field/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Field/Class.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Field.Class 
+  ( Field
+  ) where
+
+import Numeric.Ring.Division
+import Numeric.Algebra.Commutative
+
+class (Commutative r, DivisionRing r) => Field r
+instance (Commutative r, DivisionRing r) => Field r
diff --git a/src/Numeric/Log.hs b/src/Numeric/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Log.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Numeric.Log 
+  ( Log(..)
+  ) where
+
+import Data.Function (on)
+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)
+  sinnum1p n (Log m) = Log (pow1p m n)
+
+instance Unital r => LeftModule Natural (Log r) where
+  n .* Log m = Log (pow m n)
+
+instance Unital r => RightModule Natural (Log r) where
+  Log m *. n = Log (pow m n)
+
+instance Unital r => Monoidal (Log r) where
+  zero = Log one
+  sinnum n (Log m) = Log (pow m n)
+  sumWith f = Log . productWith (runLog . f)
+
+instance Division r => LeftModule Integer (Log r) where
+  n .* Log m = Log (m ^ n)
+
+instance Division r => RightModule Integer (Log r) where
+  Log m *. n = Log (m ^ n)
+
+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)
+  times n (Log m) = Log (m ^ n)
+
+instance Commutative r => Abelian (Log r)
+
+instance Band r => Idempotent (Log r)
+
+instance Factorable r => Partitionable (Log r) where
+  partitionWith f = factorWith (f `on` Log) . runLog
diff --git a/src/Numeric/Map.hs b/src/Numeric/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Map.hs
@@ -0,0 +1,294 @@
+{-# 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
+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)
+instance QFunctor (,) (Map r) (Map r)
+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
+  disassociate = arr disassociate
+
+instance Braided (Map r) (,) where
+  braid = arr braid
+
+instance Symmetric (Map r) (,)
+
+instance C.Monoidal (Map r) (,) where
+  type Id (Map r) (,) = ()
+  idl = arr C.idl
+  idr = arr C.idr
+  coidl = arr C.coidl
+  coidr = arr C.coidr
+
+instance Cartesian (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)
+instance QFunctor Either (Map r) (Map r)
+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
+  disassociate = arr disassociate
+
+instance Braided (Map r) Either where
+  braid = arr braid
+
+instance Symmetric (Map r) Either
+
+instance CoCartesian (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.Monoidal (Map r) Either where
+  type Id (Map r) Either = Void
+  idl = arr C.idl
+  idr = arr C.idr
+  coidl = arr C.coidl
+  coidr = arr C.coidr
+
+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
+  sinnum1p n (Map m) = Map $ sinnum1p 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
+  sinnum n (Map m) = Map $ sinnum 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/src/Numeric/Module/Class.hs b/src/Numeric/Module/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Module/Class.hs
@@ -0,0 +1,9 @@
+module Numeric.Module.Class
+  (  
+  -- * Module over semirings
+    LeftModule(..)
+  , RightModule(..)
+  , Module
+  ) where
+
+import Numeric.Algebra.Class
diff --git a/src/Numeric/Module/Representable.hs b/src/Numeric/Module/Representable.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Module/Representable.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE RebindableSyntax, FlexibleContexts #-}
+module Numeric.Module.Representable 
+  ( 
+  -- * Representable Additive
+    addRep, sinnum1pRep
+  -- * Representable Monoidal
+  , zeroRep, sinnumRep
+  -- * 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.sinnum1p` default definition
+sinnum1pRep :: (Whole n, Functor m, Additive r) => n -> m r -> m r
+sinnum1pRep = fmap . sinnum1p
+
+-- | `Monoidal.zero` default definition
+zeroRep :: (Applicative m, Monoidal r) => m r 
+zeroRep = pure zero
+
+-- | `Monoidal.sinnum` default definition
+sinnumRep :: (Whole n, Functor m, Monoidal r) => n -> m r -> m r
+sinnumRep = fmap . sinnum
+
+-- | `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/src/Numeric/Order/Additive.hs b/src/Numeric/Order/Additive.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Order/Additive.hs
@@ -0,0 +1,21 @@
+module Numeric.Order.Additive
+  ( AdditiveOrder
+  ) where
+
+import Numeric.Natural.Internal
+import Numeric.Additive.Class
+import Numeric.Order.Class
+
+-- An additive semigroup with a partial order (<=)
+
+-- | z + x <= z + y = x <= y = x + z <= y + z
+class (Additive r, Order r) => AdditiveOrder r
+
+instance AdditiveOrder Integer
+instance AdditiveOrder Natural
+instance AdditiveOrder Bool
+instance AdditiveOrder ()
+instance (AdditiveOrder a, AdditiveOrder b) => AdditiveOrder (a,b)
+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c) => AdditiveOrder (a,b,c)
+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d) => AdditiveOrder (a,b,c,d)
+instance (AdditiveOrder a, AdditiveOrder b, AdditiveOrder c, AdditiveOrder d, AdditiveOrder e) => AdditiveOrder (a,b,c,d,e)
diff --git a/src/Numeric/Order/Class.hs b/src/Numeric/Order/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Order/Class.hs
@@ -0,0 +1,77 @@
+module Numeric.Order.Class 
+  ( Order(..)
+  , orderOrd
+  ) where
+
+import Data.Int
+import Data.Word
+import Data.Set
+import Numeric.Natural.Internal
+
+-- a partial order (a, <=)
+class Order a where
+  (<~) :: a -> a -> Bool
+  a <~ b = maybe False (<= EQ) (order a b)
+
+  (<) :: a -> a -> Bool
+  a < b = order a b == Just LT
+
+  (>~) :: a -> a -> Bool
+  a >~ b = b <~ a
+
+  (>) :: a -> a -> Bool
+  a > b = order a b == Just GT
+
+  (~~) :: a -> a -> Bool
+  a ~~ b = order a b == Just EQ
+
+  (/~) :: a -> a -> Bool
+  a /~ b = order a b /= Just EQ
+
+  order :: a -> a -> Maybe Ordering
+  order a b 
+    | a <~ b = Just $ if b <~ a 
+               then EQ
+               else LT
+    | b <~ a = Just GT
+    | otherwise = Nothing
+
+  comparable :: a -> a -> Bool
+  comparable a b = maybe False (const True) (order a b)
+
+
+orderOrd :: Ord a => a -> a -> Maybe Ordering
+orderOrd a b = Just (compare a b)
+
+instance Order Bool where order = orderOrd 
+instance Order Integer where order = orderOrd 
+instance Order Int where order = orderOrd 
+instance Order Int8 where order = orderOrd 
+instance Order Int16 where order = orderOrd 
+instance Order Int32 where order = orderOrd 
+instance Order Int64 where order = orderOrd 
+instance Order Natural where order = orderOrd 
+instance Order Word where order = orderOrd
+instance Order Word8 where order = orderOrd
+instance Order Word16 where order = orderOrd
+instance Order Word32 where order = orderOrd
+instance Order Word64 where order = orderOrd
+instance Ord a => Order (Set a) where
+  (<~) = isSubsetOf
+
+instance Order () where 
+  order _ _ = Just EQ
+  _ <~ _ = True
+  comparable _ _ = True
+
+instance (Order a, Order b) => Order (a, b) where 
+  (a,b) <~ (i,j) = a <~ i && b <~ j
+
+instance (Order a, Order b, Order c) => Order (a, b, c) where 
+  (a,b,c) <~ (i,j,k) = a <~ i && b <~ j && c <~ k
+
+instance (Order a, Order b, Order c, Order d) => Order (a, b, c, d) where 
+  (a,b,c,d) <~ (i,j,k,l) = a <~ i && b <~ j && c <~ k && d <~ l
+
+instance (Order a, Order b, Order c, Order d, Order e) => Order (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
diff --git a/src/Numeric/Order/LocallyFinite.hs b/src/Numeric/Order/LocallyFinite.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Order/LocallyFinite.hs
@@ -0,0 +1,227 @@
+module Numeric.Order.LocallyFinite 
+  ( LocallyFiniteOrder(..)
+  ) where
+
+import Control.Applicative
+import Numeric.Additive.Class
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Numeric.Order.Class
+import Numeric.Natural.Internal
+import Numeric.Rig.Class
+import Numeric.Ring.Class
+import Data.Int
+import Data.Bits
+import Data.Word
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Ix as Ix
+import Prelude hiding ((*),(+),fromIntegral,(<),negate,(-))
+
+class Order a => LocallyFiniteOrder a where
+  range :: a -> a -> [a]
+  rangeSize :: a -> a -> Natural
+
+  -- moebiusInversion inversion
+  moebiusInversion :: Ring r => a -> a -> r
+  moebiusInversion x y = case order x y of
+    Just EQ -> one
+    Just LT -> sumWith (\z -> if z < y then moebiusInversion x z else zero) $ range x y
+    _  -> zero 
+
+instance LocallyFiniteOrder Natural where
+  range = curry Ix.range
+  rangeSize a b 
+    | a <= b = Natural (runNatural b - runNatural a + 1)
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | unsafePred y == x -> negate one 
+     _ -> zero
+
+instance LocallyFiniteOrder Integer where
+  range = curry Ix.range
+  rangeSize a b 
+    | a <= b = Natural (b - a + 1)
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance Ord a => LocallyFiniteOrder (Set a) where
+  range a b 
+    | Set.isSubsetOf a b = go a $ Set.toList $ Set.difference b a
+    | otherwise = []
+    where 
+      go _ [] = []
+      go s (x:xs) = do
+        s' <- [s, Set.insert x s]
+        go s' xs
+  rangeSize a b 
+    | Set.isSubsetOf a b = fromNatural $ shiftL 1 $ Set.size b - Set.size a
+    | otherwise = zero
+  moebiusInversion a b 
+    | Set.isSubsetOf a b = 
+      if (Set.size b - Set.size a) .&. 1 == 0 
+      then one 
+      else negate one
+    | otherwise          = zero
+
+instance LocallyFiniteOrder Bool where
+  range False False = [False]
+  range False True  = [False, True]
+  range True  False = []
+  range True  True  = [True]
+  rangeSize False False = 1
+  rangeSize False True  = 2
+  rangeSize True  False = 0 
+  rangeSize True  True  = 1
+  moebiusInversion False False = one
+  moebiusInversion False True  = negate one 
+  moebiusInversion True  False = zero
+  moebiusInversion True  True  = one
+
+
+instance LocallyFiniteOrder Int where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Int8 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Int16 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Int32 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Int64 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Word where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Word8 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Word16 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Word32 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder Word64 where
+  range = curry Ix.range
+  rangeSize a b
+    | a <= b = Natural $ fromIntegral $ b - a + 1
+    | otherwise = 0
+  moebiusInversion x y = case compare x y of
+     EQ -> one
+     LT | y - 1 == x -> negate one 
+     _  -> zero
+
+instance LocallyFiniteOrder () where
+  range _ _ = [()]
+  rangeSize _ _ = 1
+  moebiusInversion _ _ = one
+
+instance ( LocallyFiniteOrder a
+         , LocallyFiniteOrder b
+         ) => LocallyFiniteOrder (a,b) where
+  range (a,b) (i,j) = (,) <$> range a i <*> range b j
+  rangeSize (a,b) (i,j) = rangeSize a i * rangeSize b j
+  -- TODO: check this against the default definition above
+  moebiusInversion (a,b) (i,j) = moebiusInversion a i * moebiusInversion b j
+
+instance ( LocallyFiniteOrder a
+         , LocallyFiniteOrder b
+         , LocallyFiniteOrder c
+         ) => LocallyFiniteOrder (a,b,c) where
+  range (a,b,c) (i,j,k) = (,,) <$> range  a i <*> range b j <*> range c k
+  rangeSize (a,b,c) (i,j,k) = rangeSize a i * rangeSize b j * rangeSize c k
+  moebiusInversion (a,b,c) (i,j,k) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k
+
+
+instance ( LocallyFiniteOrder a
+         , LocallyFiniteOrder b
+         , LocallyFiniteOrder c
+         , LocallyFiniteOrder d
+         ) => LocallyFiniteOrder (a,b,c,d) where
+  range (a,b,c,d) (i,j,k,l) = (,,,) <$> range  a i <*> range b j <*> range c k <*> range d l
+  rangeSize (a,b,c,d) (i,j,k,l) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l
+  moebiusInversion (a,b,c,d) (i,j,k,l) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l
+
+instance ( LocallyFiniteOrder a
+         , LocallyFiniteOrder b
+         , LocallyFiniteOrder c
+         , LocallyFiniteOrder d
+         , LocallyFiniteOrder e
+         ) => LocallyFiniteOrder (a, b, c, d, e) where
+  range (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> range  a i <*> range b j <*> range c k <*> range d l <*> range e m
+  rangeSize (a,b,c,d,e) (i,j,k,l,m) = rangeSize  a i * rangeSize b j * rangeSize c k * rangeSize d l * rangeSize e m
+  moebiusInversion (a,b,c,d,e) (i,j,k,l,m) = moebiusInversion a i * moebiusInversion b j * moebiusInversion c k * moebiusInversion d l * moebiusInversion e m
+
diff --git a/src/Numeric/Partial/Group.hs b/src/Numeric/Partial/Group.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Partial/Group.hs
@@ -0,0 +1,88 @@
+module Numeric.Partial.Group
+  ( PartialGroup(..)
+  ) where
+
+import Control.Applicative
+import Data.Int
+import Data.Word
+import Numeric.Partial.Semigroup
+import Numeric.Partial.Monoid
+import Numeric.Natural
+
+class PartialMonoid a => PartialGroup a where
+  pnegate :: a -> Maybe a
+  pnegate = pminus pzero
+
+  pminus :: a -> a -> Maybe a
+  pminus a b = padd a =<< pnegate b 
+
+  psubtract :: a -> a -> Maybe a
+  psubtract a b = pnegate a >>= (`padd` b)
+
+instance PartialGroup Int where
+  pnegate = Just . negate
+
+instance PartialGroup Integer where
+  pnegate = Just . negate
+
+instance PartialGroup Int8 where
+  pnegate = Just . negate
+
+instance PartialGroup Int16 where
+  pnegate = Just . negate
+
+instance PartialGroup Int32 where
+  pnegate = Just . negate
+
+instance PartialGroup Int64 where
+  pnegate = Just . negate
+
+instance PartialGroup Word where
+  pnegate = Just . negate
+
+instance PartialGroup Word8 where
+  pnegate = Just . negate
+
+instance PartialGroup Word16 where
+  pnegate = Just . negate
+
+instance PartialGroup Word32 where
+  pnegate = Just . negate
+
+instance PartialGroup Word64 where
+  pnegate = Just . negate
+
+instance PartialGroup Natural where
+  pnegate 0 = Just 0
+  pnegate _ = Nothing
+  pminus a b 
+    | a < b = Nothing
+    | otherwise = Just (a - b)
+  psubtract a b 
+    | a > b = Nothing
+    | otherwise = Just (b - a)
+
+instance PartialGroup () where
+  pnegate _ = Just () 
+  pminus _ _ = Just ()
+  psubtract _ _ = Just ()
+
+instance (PartialGroup a, PartialGroup b) => PartialGroup (a, b) where
+  pnegate (a, b) = (,) <$> pnegate a <*> pnegate b
+  pminus (a, b) (i, j) = (,) <$> pminus a i <*> pminus b j
+  psubtract (a, b) (i, j) = (,) <$> psubtract a i <*> psubtract b j
+
+instance (PartialGroup a, PartialGroup b, PartialGroup c) => PartialGroup (a, b, c) where
+  pnegate (a, b, c) = (,,) <$> pnegate a <*> pnegate b <*> pnegate c
+  pminus (a, b, c) (i, j, k) = (,,) <$> pminus a i <*> pminus b j <*> pminus c k
+  psubtract (a, b, c) (i, j, k) = (,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k
+
+instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d) => PartialGroup (a, b, c, d) where
+  pnegate (a, b, c, d) = (,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d
+  pminus (a, b, c, d) (i, j, k, l) = (,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l
+  psubtract (a, b, c, d) (i, j, k, l) = (,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l
+
+instance (PartialGroup a, PartialGroup b, PartialGroup c, PartialGroup d, PartialGroup e) => PartialGroup (a, b, c, d, e) where
+  pnegate (a, b, c, d, e) = (,,,,) <$> pnegate a <*> pnegate b <*> pnegate c <*> pnegate d <*> pnegate e
+  pminus (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> pminus a i <*> pminus b j <*> pminus c k <*> pminus d l <*> pminus e m
+  psubtract (a, b, c, d, e) (i, j, k, l, m) = (,,,,) <$> psubtract a i <*> psubtract b j <*> psubtract c k <*> psubtract d l <*> psubtract e m
diff --git a/src/Numeric/Partial/Monoid.hs b/src/Numeric/Partial/Monoid.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Partial/Monoid.hs
@@ -0,0 +1,68 @@
+module Numeric.Partial.Monoid
+  ( PartialMonoid(..)
+  ) where
+
+import Numeric.Partial.Semigroup
+import Data.Int
+import Data.Word
+import Numeric.Natural.Internal
+
+class PartialSemigroup a => PartialMonoid a where
+  pzero :: a
+
+instance PartialMonoid Bool where
+  pzero = False
+
+instance PartialMonoid Int where
+  pzero = 0
+
+instance PartialMonoid Integer where
+  pzero = 0
+
+instance PartialMonoid Natural where
+  pzero = 0
+
+instance PartialMonoid Int8 where
+  pzero = 0
+
+instance PartialMonoid Int16 where
+  pzero = 0
+
+instance PartialMonoid Int32 where
+  pzero = 0
+
+instance PartialMonoid Int64 where
+  pzero = 0
+
+instance PartialMonoid Word where
+  pzero = 0
+
+instance PartialMonoid Word8 where
+  pzero = 0
+
+instance PartialMonoid Word16 where
+  pzero = 0
+
+instance PartialMonoid Word32 where
+  pzero = 0
+
+instance PartialMonoid Word64 where
+  pzero = 0
+
+instance PartialMonoid () where
+  pzero = () 
+
+instance PartialSemigroup a => PartialMonoid (Maybe a) where
+  pzero = Nothing
+
+instance (PartialMonoid a, PartialMonoid b) => PartialMonoid (a, b) where
+  pzero = (pzero, pzero)
+
+instance (PartialMonoid a, PartialMonoid b, PartialMonoid c) => PartialMonoid (a, b, c) where
+  pzero = (pzero, pzero, pzero)
+
+instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d) => PartialMonoid (a, b, c, d) where
+  pzero = (pzero, pzero, pzero, pzero)
+
+instance (PartialMonoid a, PartialMonoid b, PartialMonoid c, PartialMonoid d, PartialMonoid e) => PartialMonoid (a, b, c, d, e) where
+  pzero = (pzero, pzero, pzero, pzero, pzero)
diff --git a/src/Numeric/Partial/Semigroup.hs b/src/Numeric/Partial/Semigroup.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Partial/Semigroup.hs
@@ -0,0 +1,80 @@
+module Numeric.Partial.Semigroup
+  ( PartialSemigroup(..)
+  ) where
+
+import Control.Applicative
+import Data.Word
+import Data.Int
+import Numeric.Natural.Internal
+
+class PartialSemigroup a where
+  padd :: a -> a -> Maybe a
+
+paddNum :: Num a => a -> a -> Maybe a
+paddNum a b = Just (a + b)
+
+
+instance PartialSemigroup Int where
+  padd = paddNum
+
+instance PartialSemigroup Integer where
+  padd = paddNum
+
+instance PartialSemigroup Natural where
+  padd = paddNum
+
+instance PartialSemigroup Int8 where
+  padd = paddNum
+
+instance PartialSemigroup Int16 where
+  padd = paddNum
+
+instance PartialSemigroup Int32 where
+  padd = paddNum
+
+instance PartialSemigroup Int64 where
+  padd = paddNum
+
+instance PartialSemigroup Word where
+  padd = paddNum
+
+instance PartialSemigroup Word8 where
+  padd = paddNum
+
+instance PartialSemigroup Word16 where
+  padd = paddNum
+
+instance PartialSemigroup Word32 where
+  padd = paddNum
+
+instance PartialSemigroup Word64 where
+  padd = paddNum
+
+instance PartialSemigroup a => PartialSemigroup (Maybe a) where
+  padd ma mb = Just $ do
+   a <- ma
+   b <- mb
+   padd a b
+
+instance PartialSemigroup Bool where
+  padd a b = Just (a || b)
+
+instance PartialSemigroup () where
+  padd _ _ = Just ()
+
+instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (a, b) where
+  padd (a,b) (i,j) = (,) <$> padd a i <*> padd b j
+
+instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c) => PartialSemigroup (a, b, c) where
+  padd (a,b,c) (i,j,k) = (,,) <$> padd a i <*> padd b j <*> padd c k
+
+instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d) => PartialSemigroup (a, b, c, d) where
+  padd (a,b,c,d) (i,j,k,l) = (,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l
+
+instance (PartialSemigroup a, PartialSemigroup b, PartialSemigroup c, PartialSemigroup d, PartialSemigroup e) => PartialSemigroup (a, b, c, d, e) where
+  padd (a,b,c,d,e) (i,j,k,l,m) = (,,,,) <$> padd a i <*> padd b j <*> padd c k <*> padd d l <*> padd e m
+
+instance (PartialSemigroup a, PartialSemigroup b) => PartialSemigroup (Either a b) where
+  padd (Left a) (Left b) = Left <$> padd a b
+  padd (Right a) (Right b) = Right <$> padd a b
+  padd _ _ = Nothing
diff --git a/src/Numeric/Quadrance/Class.hs b/src/Numeric/Quadrance/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Quadrance/Class.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE MultiParamTypeClasses, 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/src/Numeric/Rig/Characteristic.hs b/src/Numeric/Rig/Characteristic.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Rig/Characteristic.hs
@@ -0,0 +1,81 @@
+module Numeric.Rig.Characteristic
+  ( Characteristic(..)
+  , charInt
+  , charWord
+  ) where
+
+import Data.Int
+import Data.Word
+import Numeric.Rig.Class
+import Numeric.Natural.Internal
+import Prelude hiding ((^))
+
+data Proxy p = Proxy
+
+class Rig r => Characteristic r where
+  char :: proxy r -> Natural
+
+charInt :: (Integral s, Bounded s) => proxy s -> Natural
+charInt p = 2 * fromIntegral (maxBound `asProxyTypeOf` p) + 2
+
+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
+instance Characteristic Bool where char _ = 0
+instance Characteristic Integer where char _ = 0
+instance Characteristic Natural where char _ = 0
+instance Characteristic Int where char = charInt
+instance Characteristic Int8 where char = charInt
+instance Characteristic Int16 where char = charInt
+instance Characteristic Int32 where char = charInt
+instance Characteristic Int64 where char = charInt
+instance Characteristic Word where char = charWord
+instance Characteristic Word8 where char = charWord
+instance Characteristic Word16 where char = charWord
+instance Characteristic Word32 where char = charWord
+instance Characteristic Word64 where char = charWord
+instance Characteristic () where char _ = 1
+
+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
+    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
+    b :: proxy (a,b,c) -> Proxy b
+    b _ = Proxy
+    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
+    b :: proxy (a,b,c,d) -> Proxy b
+    b _ = Proxy
+    c :: proxy (a,b,c,d) -> Proxy c
+    c _ = Proxy
+    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
+    b :: proxy (a,b,c,d,e) -> Proxy b
+    b _ = Proxy
+    c :: proxy (a,b,c,d,e) -> Proxy c
+    c _ = Proxy
+    d :: proxy (a,b,c,d,e) -> Proxy d
+    d _ = Proxy
+    e :: proxy (a,b,c,d,e) -> Proxy e
+    e _ = Proxy
diff --git a/src/Numeric/Rig/Class.hs b/src/Numeric/Rig/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Rig/Class.hs
@@ -0,0 +1,47 @@
+module Numeric.Rig.Class
+  ( Rig(..)
+  , fromNaturalNum
+  , fromWhole
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Algebra.Unital
+import Data.Int
+import Data.Word
+import Prelude (Integer, Bool, Num(fromInteger),(/=),id,(.))
+import Numeric.Natural.Internal
+
+fromNaturalNum :: Num r => Natural -> r
+fromNaturalNum (Natural n) = fromInteger n
+
+-- | A Ring without (n)egation
+class (Semiring r, Unital r, Monoidal r) => Rig r where
+  fromNatural :: Natural -> r
+  fromNatural n = sinnum n one
+
+fromWhole :: (Whole n, Rig r) => n -> r
+fromWhole = fromNatural . toNatural
+-- TODO: optimize
+
+instance Rig Integer where fromNatural = fromNaturalNum
+instance Rig Natural where fromNatural = id
+instance Rig Bool where fromNatural = (/=) 0
+instance Rig Int where fromNatural = fromNaturalNum
+instance Rig Int8 where fromNatural = fromNaturalNum
+instance Rig Int16 where fromNatural = fromNaturalNum
+instance Rig Int32 where fromNatural = fromNaturalNum
+instance Rig Int64 where fromNatural = fromNaturalNum
+instance Rig Word where fromNatural = fromNaturalNum
+instance Rig Word8 where fromNatural = fromNaturalNum
+instance Rig Word16 where fromNatural = fromNaturalNum
+instance Rig Word32 where fromNatural = fromNaturalNum
+instance Rig Word64 where fromNatural = fromNaturalNum
+instance Rig () where fromNatural _ = ()
+instance (Rig a, Rig b) => Rig (a, b) where
+  fromNatural n = (fromNatural n, fromNatural n)
+instance (Rig a, Rig b, Rig c) => Rig (a, b, c) where
+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n)
+instance (Rig a, Rig b, Rig c, Rig d) => Rig (a, b, c, d) where
+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n)
+instance (Rig a, Rig b, Rig c, Rig d, Rig e) => Rig (a, b, c, d, e) where
+  fromNatural n = (fromNatural n, fromNatural n, fromNatural n, fromNatural n, fromNatural n)
diff --git a/src/Numeric/Rig/Ordered.hs b/src/Numeric/Rig/Ordered.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Rig/Ordered.hs
@@ -0,0 +1,21 @@
+module Numeric.Rig.Ordered
+  ( OrderedRig
+  ) where
+
+import Numeric.Rig.Class
+import Numeric.Order.Additive
+import Numeric.Natural.Internal
+
+-- x <= y ==> x + z <= y + z
+-- 0 <= x && y <= z implies xy <= xz
+-- 0 <= x <= 1
+class (AdditiveOrder r, Rig r) => OrderedRig r
+
+instance OrderedRig Integer
+instance OrderedRig Natural
+instance OrderedRig Bool
+instance OrderedRig ()
+instance (OrderedRig a, OrderedRig b) => OrderedRig (a, b) 
+instance (OrderedRig a, OrderedRig b, OrderedRig c) => OrderedRig (a, b, c) 
+instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d) => OrderedRig (a, b, c, d) 
+instance (OrderedRig a, OrderedRig b, OrderedRig c, OrderedRig d, OrderedRig e) => OrderedRig (a, b, c, d, e) 
diff --git a/src/Numeric/Ring/Class.hs b/src/Numeric/Ring/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Class.hs
@@ -0,0 +1,41 @@
+module Numeric.Ring.Class
+  ( Ring(..)
+  , fromIntegral
+  ) where
+
+import Data.Int
+import Data.Word
+import Numeric.Rig.Class
+import Numeric.Rng.Class
+import Numeric.Additive.Group
+import Numeric.Algebra.Unital
+import qualified Prelude
+import Prelude (Integral(toInteger), Integer, (.))
+
+class (Rig r, Rng r) => Ring r where
+  fromInteger :: Integer -> r
+  fromInteger n = times n one
+
+fromIntegral :: (Integral n, Ring r) => n -> r
+fromIntegral = fromInteger . toInteger
+
+instance Ring Integer where fromInteger = Prelude.fromInteger
+instance Ring Int     where fromInteger = Prelude.fromInteger
+instance Ring Int8    where fromInteger = Prelude.fromInteger
+instance Ring Int16   where fromInteger = Prelude.fromInteger
+instance Ring Int32   where fromInteger = Prelude.fromInteger
+instance Ring Int64   where fromInteger = Prelude.fromInteger
+instance Ring Word    where fromInteger = Prelude.fromInteger
+instance Ring Word8   where fromInteger = Prelude.fromInteger
+instance Ring Word16  where fromInteger = Prelude.fromInteger
+instance Ring Word32  where fromInteger = Prelude.fromInteger
+instance Ring Word64  where fromInteger = Prelude.fromInteger
+instance Ring () where fromInteger _ = ()
+instance (Ring a, Ring b) => Ring (a, b) where
+  fromInteger n = (fromInteger n, fromInteger n)
+instance (Ring a, Ring b, Ring c) => Ring (a, b, c) where
+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+instance (Ring a, Ring b, Ring c, Ring d) => Ring (a, b, c, d) where
+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a, b, c, d, e) where
+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
diff --git a/src/Numeric/Ring/Division.hs b/src/Numeric/Ring/Division.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Division.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Ring.Division
+  ( DivisionRing
+  ) where
+
+import Numeric.Algebra.Division
+import Numeric.Ring.Class
+
+class (Division r, Ring r) => DivisionRing r
+instance (Division r, Ring r) => DivisionRing r
diff --git a/src/Numeric/Ring/Endomorphism.hs b/src/Numeric/Ring/Endomorphism.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Endomorphism.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Ring.Endomorphism 
+  ( End(..)
+  , toEnd
+  , fromEnd
+  , frobenius
+  ) where
+
+import Data.Monoid
+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
+-- 
+-- http://en.wikipedia.org/wiki/Endomorphism_ring
+newtype End a = End { appEnd :: a -> a }
+instance Monoid (End r) where
+  mappend (End a) (End b) = End (a . b)
+  mempty = End id
+instance Additive r => Additive (End r) where
+  End f + End g = End (f + g)
+instance Abelian r => Abelian (End r)
+instance Monoidal r => Monoidal (End r) where
+  zero = End (const zero)
+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)
+instance Multiplicative (End r) where
+  End f * End g = End (f . g)
+instance Unital (End r) where
+  one = End id
+instance (Abelian r, Commutative r) => Commutative (End r) 
+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 (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.
+toEnd :: Multiplicative r => r -> End r
+toEnd r = End (*r)
+
+-- 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/src/Numeric/Ring/Local.hs b/src/Numeric/Ring/Local.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Local.hs
@@ -0,0 +1,10 @@
+module Numeric.Ring.Local 
+  ( LocalRing 
+  ) where
+
+import Numeric.Ring.Class
+
+-- forall x in r, either x or 1 - x is a unit.
+-- if a finite sum is a unit then so are some of its terms, so the empty sum is not a unit, and one /= zero.
+class Ring r => LocalRing r
+
diff --git a/src/Numeric/Ring/Opposite.hs b/src/Numeric/Ring/Opposite.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Opposite.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Numeric.Ring.Opposite 
+  ( Opposite(..)
+  ) where
+
+import Data.Foldable
+import Data.Function (on)
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Traversable
+import Numeric.Algebra
+import Numeric.Decidable.Associates
+import Numeric.Decidable.Units
+import Numeric.Decidable.Zero
+import Prelude hiding ((-),(+),(*),(/),(^),recip,negate,subtract,replicate)
+
+-- | http://en.wikipedia.org/wiki/Opposite_ring
+newtype Opposite r = Opposite { runOpposite :: r } deriving (Show,Read)
+instance Eq r => Eq (Opposite r) where
+  (==) = (==) `on` runOpposite
+instance Ord r => Ord (Opposite r) where
+  compare = compare `on` runOpposite
+instance Functor Opposite where
+  fmap f (Opposite r) = Opposite (f r)
+instance Foldable Opposite where
+  foldMap f (Opposite r) = f r
+instance Traversable Opposite where
+  traverse f (Opposite r) = fmap Opposite (f r)
+instance Foldable1 Opposite where
+  foldMap1 f (Opposite r) = f r
+instance Traversable1 Opposite where
+  traverse1 f (Opposite r) = fmap Opposite (f r)
+instance Additive r => Additive (Opposite r) where
+  Opposite a + Opposite b = Opposite (a + b)
+  sinnum1p n (Opposite a) = Opposite (sinnum1p n a)
+  sumWith1 f = Opposite . sumWith1 (runOpposite . f)
+instance Monoidal r => Monoidal (Opposite r) where
+  zero = Opposite zero
+  sinnum n (Opposite a) = Opposite (sinnum n a)
+  sumWith f = Opposite . sumWith (runOpposite . f)
+instance Semiring r => LeftModule (Opposite r) (Opposite r) where
+  (.*) = (*)
+instance RightModule r s => LeftModule r (Opposite s) where
+  r .* Opposite s = Opposite (s *. r)
+instance LeftModule r s => RightModule r (Opposite s) where
+  Opposite s *. r = Opposite (r .* s)
+instance Semiring r => RightModule (Opposite r) (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)
+  times n (Opposite a) = Opposite (times n a)
+instance Abelian r => Abelian (Opposite r)
+instance DecidableZero r => DecidableZero (Opposite r) where
+  isZero = isZero . runOpposite
+instance DecidableUnits r => DecidableUnits (Opposite r) where
+  recipUnit = fmap Opposite . recipUnit . runOpposite
+instance DecidableAssociates r => DecidableAssociates (Opposite r) where
+  isAssociate (Opposite a) (Opposite b) = isAssociate a b
+instance Multiplicative r => Multiplicative (Opposite r) where
+  Opposite a * Opposite b = Opposite (b * a)
+  pow1p (Opposite a) n = Opposite (pow1p a n)
+instance Commutative r => Commutative (Opposite r)
+instance Idempotent r => Idempotent (Opposite r)
+instance Band r => Band (Opposite r)
+instance Unital r => Unital (Opposite r) where
+  one = Opposite one
+  pow (Opposite a) n = Opposite (pow a n)
+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 Rig r => Rig (Opposite r)
+instance Ring r => Ring (Opposite r)
diff --git a/src/Numeric/Ring/Rng.hs b/src/Numeric/Ring/Rng.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Ring/Rng.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Numeric.Ring.Rng
+  ( RngRing(..)
+  , rngRingHom
+  , liftRngHom
+  ) where
+
+import Numeric.Algebra
+import Prelude hiding ((+),(-),(*),(/),replicate,negate,subtract,fromIntegral)
+
+-- | The free Ring given a Rng obtained by adjoining Z, such that
+-- 
+-- > RngRing r = n*1 + r
+--
+-- This ring is commonly denoted r^.
+data RngRing r = RngRing !Integer r deriving (Show,Read)
+
+instance Abelian r => Additive (RngRing r) where
+  RngRing n a + RngRing m b = RngRing (n + m) (a + b)
+  sinnum1p n (RngRing m a) = RngRing ((1 + toInteger n) * m) (sinnum1p n a)
+
+instance Abelian r => Abelian (RngRing r)
+
+instance (Abelian r, Monoidal r) => LeftModule Natural (RngRing r) where
+  n .* RngRing m a = RngRing (toInteger n * m) (sinnum n a)
+
+instance (Abelian r, Monoidal r) => RightModule Natural (RngRing r) where
+  RngRing m a *. n = RngRing (toInteger n * m) (sinnum n a)
+
+instance (Abelian r, Monoidal r) => Monoidal (RngRing r) where
+  zero = RngRing 0 zero
+  sinnum n (RngRing m a) = RngRing (toInteger n * m) (sinnum n a)
+
+instance (Abelian r, Group r) => LeftModule Integer (RngRing r) where
+  n .* RngRing m a = RngRing (toInteger n * m) (times n a)
+
+instance (Abelian r, Group r) => RightModule Integer (RngRing r) where
+  RngRing m a *. n = RngRing (toInteger n * m) (times n a)
+
+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)
+  times n (RngRing m a) = RngRing (toInteger n * m) (times n a)
+
+instance Rng r => Multiplicative (RngRing r) where
+  RngRing n a * RngRing m b = RngRing (n*m) (times n b + times m a + a * b)
+
+instance (Commutative r, Rng r) => Commutative (RngRing r)
+
+instance Rng s => LeftModule (RngRing s) (RngRing s) where
+  (.*) = (*) 
+
+instance Rng s => RightModule (RngRing s) (RngRing s) where
+  (*.) = (*) 
+
+instance Rng r => Unital (RngRing r) where
+  one = RngRing 1 zero
+
+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 => Rig (RngRing r)
+
+instance Rng r => Ring (RngRing r)
+
+-- | The rng homomorphism from r to RngRing r
+rngRingHom :: r -> RngRing r
+rngRingHom = RngRing 0
+
+-- | given a rng homomorphism from a rng r into a ring s, liftRngHom yields a ring homomorphism from the ring `r^` into `s`.
+liftRngHom :: Ring s => (r -> s) -> RngRing r -> s
+liftRngHom g (RngRing n a) = times n one + g a
diff --git a/src/Numeric/Rng/Class.hs b/src/Numeric/Rng/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Rng/Class.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module Numeric.Rng.Class
+  ( Rng
+  ) where
+
+import Numeric.Additive.Group
+import Numeric.Algebra.Class
+
+-- | A Ring without an /i/dentity.
+
+class (Group r, Semiring r) => Rng r
+instance (Group r, Semiring r) => Rng r
diff --git a/src/Numeric/Rng/Zero.hs b/src/Numeric/Rng/Zero.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Rng/Zero.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Numeric.Rng.Zero
+  ( ZeroRng(..)
+  ) where
+
+import Numeric.Algebra
+import Data.Foldable (toList)
+import Prelude hiding ((+),(-),negate,subtract,replicate)
+
+-- *** The Zero Rng for an Abelian Group, adding the trivial product
+--
+-- > _ * _ = zero 
+--
+-- which distributes over (+)
+
+-- ZeroRng/runZeroRng witness an additive Abelian group isomorphism to the zero rng.
+newtype ZeroRng r = ZeroRng { runZeroRng :: r } deriving (Eq,Ord,Show,Read)
+
+instance Additive r => Additive (ZeroRng r) where
+  ZeroRng a + ZeroRng b = ZeroRng (a + b)
+  sumWith1 f = ZeroRng . sumWith1 (runZeroRng . f)
+
+instance Idempotent r => Idempotent (ZeroRng r)
+
+instance Abelian r => Abelian (ZeroRng r)
+
+instance Monoidal r => Monoidal (ZeroRng r) where
+  zero = ZeroRng zero
+  sumWith f = ZeroRng . sumWith (runZeroRng . f)
+  sinnum n (ZeroRng a) = ZeroRng (sinnum n a)
+  
+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 Monoidal r => Multiplicative (ZeroRng r) where
+  _ * _ = zero
+  productWith1 f as = case toList as of
+    [] -> error "productWith1: empty Foldable1"
+    [a] -> f a
+    _   -> zero
+
+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
+  (.*) = sinnum
+instance Monoidal r => RightModule Natural (ZeroRng r) where
+  m *. n = sinnum n m
+instance Group r => LeftModule Integer (ZeroRng r) where
+  (.*) = times
+instance Group r => RightModule Integer (ZeroRng r) where
+  m *. n = times n m
diff --git a/src/Numeric/Semiring/Integral.hs b/src/Numeric/Semiring/Integral.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Semiring/Integral.hs
@@ -0,0 +1,15 @@
+module Numeric.Semiring.Integral 
+  ( IntegralSemiring
+  ) where
+
+import Numeric.Algebra.Class
+import Numeric.Natural.Internal
+
+-- | 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
+instance IntegralSemiring Bool
diff --git a/src/Numeric/Semiring/Involutive.hs b/src/Numeric/Semiring/Involutive.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Semiring/Involutive.hs
@@ -0,0 +1,5 @@
+module Numeric.Semiring.Involutive 
+  ( InvolutiveSemiring
+  ) where
+
+import Numeric.Algebra.Involutive