packages feed

algebra 0.1.0 → 0.2.0

raw patch · 4 files changed

+122/−57 lines, 4 filesdep +voiddep ~categories

Dependencies added: void

Dependency ranges changed: categories

Files

+ Numeric/Algebra/Free.hs view
@@ -0,0 +1,11 @@+module Numeric.Algebra.Free +  ( FreeAlgebra(..)+  , FreeUnitalAlgebra(..)+  , FreeCoalgebra(..)+  , FreeCounitalCoalgebra(..)+  , Hopf(..)+  ) where++import Numeric.Algebra.Free.Class+import Numeric.Algebra.Free.Unital+import Numeric.Algebra.Free.Hopf
Numeric/Functional/Linear.hs view
@@ -2,8 +2,14 @@ module Numeric.Functional.Linear    ( Linear(..)   , (.*), (*.)-  , embedHom-  , augmentHom+  -- * Vectors+  , Vector+  , unitVector+  -- * Covectors as linear functionals+  , Covector+  , counitCovector+  , embedCovector+  , augmentCovector   ) where  import Numeric.Addition@@ -22,50 +28,55 @@ import qualified Prelude import Prelude hiding ((+),(-),negate,subtract,replicate,(*)) +infixr 0 $*+ -- | Linear functionals from elements of a free module to a scalar --- appLinear f (x + y) = appLinear f x + appLinear f y--- appLinear f (a .* x) = a * appLinear f x+-- f $* (x + y) = (f $* x) + (f $* y)+-- f $* (a .* x) = a * (f $* x) -newtype Linear r a = Linear { appLinear :: (a -> r) -> r }+newtype Linear r a = Linear { ($*) :: (a -> r) -> r } +type Covector a r = Linear r a+type Vector = (->)+ instance Functor (Linear r) where-  fmap f (Linear m) = Linear (\k -> m (k . f))+  fmap f m = Linear $ \k -> m $* k . f  instance Apply (Linear r) where-  Linear mf <.> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))+  mf <.> ma = Linear $ \k -> mf $* \f -> ma $* k . f  instance Applicative (Linear r) where-  pure a = Linear (\k -> k a)-  Linear mf <*> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))+  pure a = Linear $ \k -> k a+  mf <*> ma = Linear $ \k -> mf $* \f -> ma $* k . f  instance Bind (Linear r) where-  Linear m >>- f = Linear (\k -> m (\a -> appLinear (f a) k))+  m >>- f = Linear $ \k -> m $* \a -> f a $* k    instance Monad (Linear r) where-  return a = Linear (\k -> k a)-  Linear m >>= f = Linear (\k -> m (\a -> appLinear (f a) k))+  return a = Linear $ \k -> k a+  m >>= f = Linear $ \k -> m $* \a -> f a $* k  instance Additive r => Alt (Linear r) where-  Linear m <!> Linear n = Linear (m + n)+  Linear m <!> Linear n = Linear $ m + n  instance AdditiveMonoid r => Plus (Linear r) where   zero = Linear zero   instance AdditiveMonoid r => Alternative (Linear r) where-  Linear m <|> Linear n = Linear (m + n)+  Linear m <|> Linear n = Linear $ m + n   empty = Linear zero  instance AdditiveMonoid r => MonadPlus (Linear r) where-  Linear m `mplus` Linear n = Linear (m + n)+  Linear m `mplus` Linear n = Linear $ m + n   mzero = Linear zero  instance Additive r => Additive (Linear r a) where-  Linear m + Linear n = Linear (m + n)-  replicate1p n (Linear m) = Linear (replicate1p n m)+  Linear m + Linear n = Linear $ m + n+  replicate1p n (Linear m) = Linear $ replicate1p n m  instance FreeCoalgebra r m => Multiplicative (Linear r m) where-  Linear f * Linear g = Linear (\k -> f (g . cojoin k))+  f * Linear g = Linear $ \k -> f $* g . cojoin k instance (Commutative m, FreeCoalgebra r m) => Commutative (Linear r m) instance FreeCoalgebra r m => Semiring (Linear r m) instance FreeCounitalCoalgebra r m => Unital (Linear r m) where@@ -74,16 +85,22 @@ instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Linear r m) instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Linear r m) --- ring homomorphism from r -> r^a-embedHom :: (Unital m, FreeCounitalCoalgebra r m) => r -> Linear r m-embedHom r = Linear (\k -> r * k one)+unitVector :: FreeUnitalAlgebra r a => a -> r+unitVector = unit one +counitCovector :: FreeCounitalCoalgebra r c => Linear r c+counitCovector = Linear counit++-- ring homomorphism from r -> r^a, generalizes the embedding of a semiring into its monoid semiring+embedCovector :: (Unital m, FreeCounitalCoalgebra r m) => r -> Linear r m+embedCovector r = Linear $ \k -> r * k one+ -- if the characteristic of s does not divide the order of a, then s[a] is semisimple -- and if a has a length function, we can build a filtered algebra --- | The augmentation ring homomorphism from r^a -> r-augmentHom :: Unital s => Linear s a -> s-augmentHom (Linear m) = m (const one)+-- | The augmentation ring homomorphism from r^a -> r, generalizes the augmentation homomorphism from a monoid semiring to the underlying semiring+augmentCovector :: Unital s => Linear s a -> s+augmentCovector m = m $* const one  -- TODO: we can also build up the augmentation ideal @@ -94,20 +111,20 @@ instance Abelian s => Abelian (Linear s a)  instance AdditiveGroup s => AdditiveGroup (Linear s a) where-  Linear m - Linear n = Linear (m - n)-  negate (Linear m) = Linear (negate m)-  subtract (Linear m) (Linear n) = Linear (subtract m n)-  times n (Linear m) = Linear (times n m)+  Linear m - Linear n = Linear $ m - n+  negate (Linear m) = Linear $ negate m+  subtract (Linear m) (Linear n) = Linear $ subtract m n+  times n (Linear m) = Linear $ times n m  instance FreeCoalgebra r m => LeftModule (Linear r m) (Linear r m) where   (.*) = (*)  instance LeftModule r s => LeftModule r (Linear s m) where-  s .* Linear m = Linear (\k -> s .* m k)+  s .* m = Linear $ \k -> s .* (m $* k)  instance FreeCoalgebra r m => RightModule (Linear r m) (Linear r m) where   (*.) = (*)  instance RightModule r s => RightModule r (Linear s m) where-  Linear m *. s = Linear (\k -> m k *. s)+  m *. s = Linear $ \k -> (m $* k) *. s
Numeric/Map/Linear.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-} module Numeric.Map.Linear   ( Map(..)+  , ($@)   , joinMap   , unitMap   , memoMap@@ -21,17 +22,16 @@ import Control.Category.Braided import Control.Category.Cartesian import Control.Category.Cartesian.Closed---import Control.Category.Distributive+import Control.Category.Distributive import Control.Category.Monoidal import Control.Monad hiding (join) import Control.Monad.Reader.Class---import Data.Foldable hiding (sum, concat) import Data.Functor.Representable.Trie import Data.Functor.Bind hiding (join) import Data.Functor.Plus hiding (zero) import qualified Data.Functor.Plus as Plus---import Data.Semigroup.Foldable import Data.Semigroupoid+import Data.Void import Numeric.Addition import Numeric.Algebra.Free import Numeric.Multiplication@@ -41,6 +41,7 @@ import Numeric.Ring.Class import Numeric.Rng.Class import Prelude hiding ((*), (+), negate, subtract,(-), recip, (/), foldr, sum, product, replicate, concat, (.), id, curry, uncurry, fst, snd)+import Numeric.Functional.Linear  -- | linear maps from elements of a free module to another free module over r --@@ -58,6 +59,11 @@ infixr 0 $# newtype Map r b a = Map { ($#) :: (a -> r) -> b -> r } +infixr 0 $@+-- | extract a linear functional from a linear map+($@) :: Map r b a -> b -> Linear r a+m $@ b = Linear $ \k -> (m $# k) b+ -- NB: due to contravariance (>>>) to get the usual notion of composition! instance Category (Map r) where   id = Map id@@ -103,13 +109,16 @@  instance Symmetric (Map r) (,) -instance HasIdentity (Map r) (,) where-  type Id (Map r) (,) = ()+type instance Id (Map r) (,) = ()  instance Monoidal (Map r) (,) where   idl = arr idl   idr = arr idr +instance Comonoidal (Map r) (,) where+  coidl = arr coidl+  coidr = arr coidr+ instance PreCartesian (Map r) where   type Product (Map r) = (,)    fst = arr fst@@ -117,18 +126,14 @@   diag = arr diag   f &&& g = Map $ \k a -> (f $# \b -> (g $# \c -> k (b,c)) a) a --- instance Cartesian (Map r)--{- instance CCC (Map r) where   type Exp (Map r) = Map r -  apply = Map $ \k (f,a) -> k $ f a-  curry m = Map $ \k a -> k $ \b -> m $# (a,b)-  uncurry m = Map $ \k (a,b) -> k $ (m $# a) b--}+  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 ((((,)a) *** ((,)a)) p)+instance Distributive (Map r) where+  distribute = Map $ \k (a,p) -> k $ bimap ((,) a) ((,)a) p  instance PFunctor Either (Map r) (Map r) where   first m = Map $ \k -> either (m $# k . Left) (k . Right)@@ -139,6 +144,34 @@ instance Bifunctor Either (Map r) (Map r) (Map r) where   bimap m n = Map $ \k -> either (m $# k . Left) (n $# k . Right) +instance Associative (Map r) Either where+  associate = arr associate++instance Disassociative (Map r) Either where+  disassociate = arr disassociate++instance Braided (Map r) Either where+  braid = arr braid++instance Symmetric (Map r) Either++type instance Id (Map r) Either = Void++instance PreCoCartesian (Map r) where+  type Sum (Map r) = Either+  inl = arr inl +  inr = arr inr+  codiag = arr codiag+  m ||| n = Map $ \k -> either (m $# k) (n $# k) ++instance Comonoidal (Map r) Either where+  coidl = arr coidl+  coidr = arr coidr++instance Monoidal (Map r) Either where+  idl = arr idl+  idr = arr idr+ instance Arrow (Map r) where   arr f = Map (. f)   first m = Map $ \k (a,c) -> (m $# \b -> k (b,c)) a@@ -146,6 +179,9 @@   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@@ -167,13 +203,13 @@ instance AdditiveMonoid r => ArrowPlus (Map r) where   Map m <+> Map n = Map $ m + n --- TODO: ArrowChoice, ArrowApply & ArrowLoop---- instance Associative (Map r) Either where---  associate m = Map $ \k -> m $# k . associate+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)  ---instance Disassociative (Map r) Either where---  disassociate m = Map $ \k -> m $# k . disassociate+-- TODO: ArrowLoop?  -- TODO: more categories instances for (Map r) & Either to get to precocartesian! @@ -230,10 +266,11 @@ instance (Rng r, FreeCounitalCoalgebra r m) => Rng (Map r b m) instance (Ring r, FreeCounitalCoalgebra r m) => Ring (Map r a m) --- (inefficiently) combine a linear combination of basis vectors to make a map.+-- | (inefficiently) combine a linear combination of basis vectors to make a map. arrMap :: (AdditiveMonoid r, Semiring r) => (b -> [(r, a)]) -> Map r b a arrMap f = Map $ \k b -> sum [ r * k a | (r, a) <- f b ] +-- | Memoize the results of this linear map memoMap :: HasTrie a => Map r a a memoMap = Map memo @@ -243,15 +280,13 @@ cojoinMap :: FreeCoalgebra r c => Map r (c,c) c cojoinMap = Map $ uncurry . cojoin --- r -> a -> r unitMap :: FreeUnitalAlgebra r a => Map r a () unitMap = Map $ \k -> unit $ k () --- counit :: (c -> r) -> r counitMap :: FreeCounitalCoalgebra r c => Map r () c counitMap = Map $ \k () -> counit k --- | convolution give an associative algebra and coassociative coalgebra+-- | convolution given an associative algebra and coassociative coalgebra convolveMap :: (FreeAlgebra r a, FreeCoalgebra r c) => Map r a c -> Map r a c -> Map r a c convolveMap f g = joinMap >>> (f *** g) >>> cojoinMap
algebra.cabal view
@@ -1,6 +1,6 @@ name:          algebra category:      Math, Algebra-version:       0.1.0+version:       0.2.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -22,18 +22,20 @@     base >= 4 && < 4.4,     transformers >= 0.2.0 && < 0.3,     tagged >= 0.2.2 && < 0.3,-    categories >= 0.57.0 && < 0.58,+    categories >= 0.58.0 && < 0.59,     containers >= 0.3.0.0 && < 0.5,     mtl >= 2.0 && < 2.1,     semigroups >= 0.5 && < 0.6,     semigroupoids >= 1.2.2 && < 1.3,-    representable-tries >= 1.8 && < 1.9+    representable-tries >= 1.8 && < 1.9,+    void >= 0.5.4 && < 0.6    exposed-modules:     Numeric.Addition     Numeric.Addition.Abelian     Numeric.Addition.Partitionable     Numeric.Addition.Idempotent+    Numeric.Algebra.Free     Numeric.Algebra.Free.Class     Numeric.Algebra.Free.Unital     Numeric.Algebra.Free.Hopf