{-# LANGUAGE NoImplicitPrelude #-}
module MathObj.Algebra where
import qualified Algebra.Vector as Vector
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.Monoid as Monoid
import Algebra.Ring((*))
import Algebra.Additive((+),negate,zero)
import Algebra.Monoid((<*>))
import Control.Monad(liftM2,Functor,fmap)
import Data.Map(Map)
import qualified Data.Map as Map
import Data.List(intersperse)
import NumericPrelude.Base(Ord,Eq,Show,(++),($),
concat,map,show)
newtype
T a b = Cons (Map a b)
deriving (Eq )
instance Functor (T a) where
fmap f (Cons x) = Cons (fmap f x)
instance (Ord a, Additive.C b) => Additive.C (T a b) where
(+) = zipWith (+)
negate = fmap negate
zero = Cons Map.empty
zipWith :: (Ord a) => (b -> b -> b) -> (T a b -> T a b -> T a b)
zipWith op (Cons ma) (Cons mb) = Cons (Map.unionWith op ma mb)
instance Ord a => Vector.C (T a) where
zero = zero
(<+>) = (+)
(*>) = Vector.functorScale
instance (Ord a, Monoid.C a, Ring.C b) => Ring.C (T a b) where
one = Cons $ Map.singleton Monoid.idt Ring.one
(Cons ma) * (Cons mb) =
Cons $ Map.fromListWith (+) $
liftM2 mulMonomial (Map.toList ma) (Map.toList mb)
mulMonomial :: (Monoid.C a, Ring.C b) => (a,b) -> (a,b) -> (a,b)
mulMonomial (c1,m1) (c2,m2) = (c1<*>c2,m1*m2)
instance (Show a, Show b) => Show (T a b) where
show (Cons ma) = concat $
intersperse "+" $
map (\(m,c) -> show c ++ "." ++ show m)
(Map.toList ma)
monomial :: a -> b -> (T a b)
monomial index coefficient = Cons (Map.singleton index coefficient)