{-# LANGUAGE RebindableSyntax #-}
{- |
Copyright    :   (c) Mikael Johansson 2006
Maintainer   :   mik@math.uni-jena.de
Stability    :   provisional
Portability  :   requires multi-parameter type classes

The generic case of a k-algebra generated by a monoid.
-}

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,{-Read,-}Show,(++),($),
                   concat,map,show)


newtype {- (Ord a, Monoid.C a, Ring.C b) => -}
     T a b = Cons (Map a b)
         deriving (T a b -> T a b -> Bool
(T a b -> T a b -> Bool) -> (T a b -> T a b -> Bool) -> Eq (T a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
/= :: T a b -> T a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
== :: T a b -> T a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
Eq {- ,Read -} )

instance Functor (T a) where
   fmap :: (a -> b) -> T a a -> T a b
fmap a -> b
f (Cons Map a a
x) = Map a b -> T a b
forall a b. Map a b -> T a b
Cons ((a -> b) -> Map a a -> Map a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map a a
x)

-- is an Indexable instance better than an Ord instance here?

instance (Ord a, Additive.C b) => Additive.C (T a b) where
   + :: T a b -> T a b -> T a b
(+) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b. Ord a => (b -> b -> b) -> T a b -> T a b -> T a b
zipWith b -> b -> b
forall a. C a => a -> a -> a
(+)
   {- This implementation is attracting but wrong.
     It fails if terms are present in b that are missing in a.
     Default implementation is better here.
   (-) = zipWith (-)
   -}
   negate :: T a b -> T a b
negate = (b -> b) -> T a b -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. C a => a -> a
negate
   zero :: T a b
zero = Map a b -> T a b
forall a b. Map a b -> T a b
Cons Map a b
forall k a. Map k a
Map.empty

zipWith :: (Ord a) => (b -> b -> b) -> (T a b -> T a b -> T a b)
zipWith :: (b -> b -> b) -> T a b -> T a b -> T a b
zipWith b -> b -> b
op (Cons Map a b
ma) (Cons Map a b
mb) = Map a b -> T a b
forall a b. Map a b -> T a b
Cons ((b -> b -> b) -> Map a b -> Map a b -> Map a b
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith b -> b -> b
op Map a b
ma Map a b
mb)

instance Ord a => Vector.C (T a) where
   zero :: T a a
zero  = T a a
forall a. C a => a
zero
   <+> :: T a a -> T a a -> T a a
(<+>) = T a a -> T a a -> T a a
forall a. C a => a -> a -> a
(+)
   *> :: a -> T a a -> T a a
(*>)  = a -> T a a -> T a a
forall (v :: * -> *) a. (Functor v, C a) => a -> v a -> v a
Vector.functorScale

instance (Ord a, Monoid.C a, Ring.C b) => Ring.C (T a b) where
   one :: T a b
one = Map a b -> T a b
forall a b. Map a b -> T a b
Cons (Map a b -> T a b) -> Map a b -> T a b
forall a b. (a -> b) -> a -> b
$ a -> b -> Map a b
forall k a. k -> a -> Map k a
Map.singleton a
forall a. C a => a
Monoid.idt b
forall a. C a => a
Ring.one
   (Cons Map a b
ma) * :: T a b -> T a b -> T a b
* (Cons Map a b
mb) =
      Map a b -> T a b
forall a b. Map a b -> T a b
Cons (Map a b -> T a b) -> Map a b -> T a b
forall a b. (a -> b) -> a -> b
$ (b -> b -> b) -> [(a, b)] -> Map a b
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith b -> b -> b
forall a. C a => a -> a -> a
(+) ([(a, b)] -> Map a b) -> [(a, b)] -> Map a b
forall a b. (a -> b) -> a -> b
$
         ((a, b) -> (a, b) -> (a, b)) -> [(a, b)] -> [(a, b)] -> [(a, b)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (a, b) -> (a, b) -> (a, b)
forall a b. (C a, C b) => (a, b) -> (a, b) -> (a, b)
mulMonomial (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a b
ma) (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a b
mb)

mulMonomial :: (Monoid.C a, Ring.C b) => (a,b) -> (a,b) -> (a,b)
mulMonomial :: (a, b) -> (a, b) -> (a, b)
mulMonomial (a
c1,b
m1) (a
c2,b
m2) = (a
c1a -> a -> a
forall a. C a => a -> a -> a
<*>a
c2,b
m1b -> b -> b
forall a. C a => a -> a -> a
*b
m2)

instance (Show a, Show b) => Show (T a b) where
   show :: T a b -> String
show (Cons Map a b
ma) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
           String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"+" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
           ((a, b) -> String) -> [(a, b)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
m,b
c) -> b -> String
forall a. Show a => a -> String
show b
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m)
               (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a b
ma)

monomial :: a -> b -> (T a b)
monomial :: a -> b -> T a b
monomial a
index b
coefficient = Map a b -> T a b
forall a b. Map a b -> T a b
Cons (a -> b -> Map a b
forall k a. k -> a -> Map k a
Map.singleton a
index b
coefficient)