species 0.3.2.1 → 0.3.2.3
raw patch · 9 files changed
+213/−189 lines, 9 filesdep ~basedep ~containersdep ~multiset-comb
Dependency ranges changed: base, containers, multiset-comb, np-extras, numeric-prelude, template-haskell
Files
- CHANGES +21/−15
- Math/Combinatorics/Species.hs +1/−1
- Math/Combinatorics/Species/AST.hs +32/−31
- Math/Combinatorics/Species/AST/Instances.hs +35/−35
- Math/Combinatorics/Species/Enumerate.hs +11/−10
- Math/Combinatorics/Species/Simplify.hs +41/−41
- Math/Combinatorics/Species/Structures.hs +38/−27
- Math/Combinatorics/Species/TH.hs +17/−20
- species.cabal +17/−9
CHANGES view
@@ -1,23 +1,29 @@-0.3 12 June 2010- * A bunch of new features including:- - Template Haskell support for deriving instances for user-defined data types- - simplifier- - Newton-Raphson iteration- -0.3.0.1 30 June 2010- * Fix broken dependency versions+0.3.2.3 18 Oct 2012+ * drop support for GHC < 7.4, and update to work with 7.4 and 7.6 -0.3.0.2 15 July 2010- * General cleanup, and added documentation+0.3.2.2 15 Sep 2011+ * update to build with GHC 7.2 -0.3.1 18 July 2010- * rename 'unerase' to the more descriptive 'annotate'- * export more stuff from Math.Combinatorics.Species and add some docs+0.3.2.1 12 Sep 2011+ * update to build with GHC 7 0.3.2 31 July 2010 * rename M.C.S.Unlabelled to M.C.S.Unlabeled and M.C.S.Labelled to M.C.S.Labeled; add 'labeled' and 'unlabeled' as aliases for 'labelled' and 'unlabelled' * export Interp from M.C.Species -0.3.2.1 12 Sep 2011- * update to build with GHC 7+0.3.1 18 July 2010+ * rename 'unerase' to the more descriptive 'annotate'+ * export more stuff from Math.Combinatorics.Species and add some docs++0.3.0.2 15 July 2010+ * General cleanup, and added documentation++0.3.0.1 30 June 2010+ * Fix broken dependency versions++0.3 12 June 2010+ * A bunch of new features including:+ - Template Haskell support for deriving instances for user-defined data types+ - simplifier+ - Newton-Raphson iteration
Math/Combinatorics/Species.hs view
@@ -78,7 +78,7 @@ -- $types , Void, Unit(..) , Id(..), Const(..)- , Sum(..), Prod(..), Comp(..)+ , (:+:)(..), (:*:)(..), (:.:)(..) , Star(..), Cycle(..), Set(..) -- * Species AST
Math/Combinatorics/Species/AST.hs view
@@ -5,6 +5,7 @@ , KindSignatures , FlexibleContexts , RankNTypes+ , TypeOperators #-} -----------------------------------------------------------------------------@@ -81,11 +82,11 @@ Subset :: SpeciesAST KSubset :: Integer -> SpeciesAST Elt :: SpeciesAST- (:+:) :: SpeciesAST -> SpeciesAST -> SpeciesAST- (:*:) :: SpeciesAST -> SpeciesAST -> SpeciesAST- (:.:) :: SpeciesAST -> SpeciesAST -> SpeciesAST- (:><:) :: SpeciesAST -> SpeciesAST -> SpeciesAST- (:@:) :: SpeciesAST -> SpeciesAST -> SpeciesAST+ (:+) :: SpeciesAST -> SpeciesAST -> SpeciesAST+ (:*) :: SpeciesAST -> SpeciesAST -> SpeciesAST+ (:.) :: SpeciesAST -> SpeciesAST -> SpeciesAST+ (:><) :: SpeciesAST -> SpeciesAST -> SpeciesAST+ (:@) :: SpeciesAST -> SpeciesAST -> SpeciesAST Der :: SpeciesAST -> SpeciesAST OfSize :: SpeciesAST -> (Integer -> Bool) -> SpeciesAST OfSizeExactly :: SpeciesAST -> Integer -> SpeciesAST@@ -125,12 +126,12 @@ TSubset :: TSpeciesAST Set TKSubset :: Integer -> TSpeciesAST Set TElt :: TSpeciesAST Id- (:+::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (Sum f g)- (:*::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (Prod f g)- (:.::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (Comp f g)- (:><::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (Prod f g)- (:@::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (Comp f g)- TDer :: SizedSpeciesAST f -> TSpeciesAST (Comp f Star)+ (:+::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (f :+: g)+ (:*::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (f :*: g)+ (:.::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (f :.: g)+ (:><::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (f :*: g)+ (:@::) :: SizedSpeciesAST f -> SizedSpeciesAST g -> TSpeciesAST (f :.: g)+ TDer :: SizedSpeciesAST f -> TSpeciesAST (f :.: Star) TOfSize :: SizedSpeciesAST f -> (Integer -> Bool) -> TSpeciesAST f TOfSizeExactly :: SizedSpeciesAST f -> Integer -> TSpeciesAST f TNonEmpty :: SizedSpeciesAST f -> TSpeciesAST f@@ -237,11 +238,11 @@ erase' TSubset = Subset erase' (TKSubset k) = KSubset k erase' TElt = Elt-erase' (f :+:: g) = erase' (stripI f) :+: erase' (stripI g)-erase' (f :*:: g) = erase' (stripI f) :*: erase' (stripI g)-erase' (f :.:: g) = erase' (stripI f) :.: erase' (stripI g)-erase' (f :><:: g) = erase' (stripI f) :><: erase' (stripI g)-erase' (f :@:: g) = erase' (stripI f) :@: erase' (stripI g)+erase' (f :+:: g) = erase' (stripI f) :+ erase' (stripI g)+erase' (f :*:: g) = erase' (stripI f) :* erase' (stripI g)+erase' (f :.:: g) = erase' (stripI f) :. erase' (stripI g)+erase' (f :><:: g) = erase' (stripI f) :>< erase' (stripI g)+erase' (f :@:: g) = erase' (stripI f) :@ erase' (stripI g) erase' (TDer f) = Der . erase' . stripI $ f erase' (TOfSize f p) = OfSize (erase' . stripI $ f) p erase' (TOfSizeExactly f k) = OfSizeExactly (erase' . stripI $ f) k@@ -261,15 +262,15 @@ annotate Subset = wrap TSubset annotate (KSubset k) = wrap (TKSubset k) annotate Elt = wrap TElt-annotate (f :+: g) = annotate f + annotate g+annotate (f :+ g) = annotate f + annotate g where Wrap f + Wrap g = wrap $ f :+:: g-annotate (f :*: g) = annotate f * annotate g+annotate (f :* g) = annotate f * annotate g where Wrap f * Wrap g = wrap $ f :*:: g-annotate (f :.: g) = annotate f . annotate g+annotate (f :. g) = annotate f . annotate g where Wrap f . Wrap g = wrap $ f :.:: g-annotate (f :><: g) = annotate f >< annotate g+annotate (f :>< g) = annotate f >< annotate g where Wrap f >< Wrap g = wrap $ f :><:: g-annotate (f :@: g) = annotate f @@ annotate g+annotate (f :@ g) = annotate f @@ annotate g where Wrap f @@ Wrap g = wrap $ f :@:: g annotate (Der f) = der $ annotate f where der (Wrap f) = wrap (TDer f)@@ -305,11 +306,11 @@ -- index series. needsCI :: SpeciesAST -> Bool needsCI L = True-needsCI (f :+: g) = needsCI f || needsCI g-needsCI (f :*: g) = needsCI f || needsCI g-needsCI (_ :.: _) = True-needsCI (_ :><: _) = True-needsCI (_ :@: _) = True+needsCI (f :+ g) = needsCI f || needsCI g+needsCI (f :* g) = needsCI f || needsCI g+needsCI (_ :. _) = True+needsCI (_ :>< _) = True+needsCI (_ :@ _) = True needsCI (Der _) = True needsCI (OfSize f _) = needsCI f needsCI (OfSizeExactly f _) = needsCI f@@ -319,11 +320,11 @@ -- | Substitute an expression for recursive occurrences. substRec :: ASTFunctor f => f -> SpeciesAST -> SpeciesAST -> SpeciesAST-substRec c e (f :+: g) = substRec c e f :+: substRec c e g-substRec c e (f :*: g) = substRec c e f :*: substRec c e g-substRec c e (f :.: g) = substRec c e f :.: substRec c e g-substRec c e (f :><: g) = substRec c e f :><: substRec c e g-substRec c e (f :@: g) = substRec c e f :@: substRec c e g+substRec c e (f :+ g) = substRec c e f :+ substRec c e g+substRec c e (f :* g) = substRec c e f :* substRec c e g+substRec c e (f :. g) = substRec c e f :. substRec c e g+substRec c e (f :>< g) = substRec c e f :>< substRec c e g+substRec c e (f :@ g) = substRec c e f :@ substRec c e g substRec c e (Der f) = Der (substRec c e f) substRec c e (OfSize f p) = OfSize (substRec c e f) p substRec c e (OfSizeExactly f k) = OfSizeExactly (substRec c e f) k
Math/Combinatorics/Species/AST/Instances.hs view
@@ -66,11 +66,11 @@ Subset == Subset = True (KSubset k) == (KSubset j) = k == j Elt == Elt = True- (f1 :+: g1) == (f2 :+: g2) = f1 == f2 && g1 == g2- (f1 :*: g1) == (f2 :*: g2) = f1 == f2 && g1 == g2- (f1 :.: g1) == (f2 :.: g2) = f1 == f2 && g1 == g2- (f1 :><: g1) == (f2 :><: g2) = f1 == f2 && g1 == g2- (f1 :@: g1) == (f2 :@: g2) = f1 == f2 && g1 == g2+ (f1 :+ g1) == (f2 :+ g2) = f1 == f2 && g1 == g2+ (f1 :* g1) == (f2 :* g2) = f1 == f2 && g1 == g2+ (f1 :. g1) == (f2 :. g2) = f1 == f2 && g1 == g2+ (f1 :>< g1) == (f2 :>< g2) = f1 == f2 && g1 == g2+ (f1 :@ g1) == (f2 :@ g2) = f1 == f2 && g1 == g2 Der f1 == Der f2 = f1 == f2 -- note, OfSize will always compare False since we can't compare the functions for equality OfSizeExactly f1 k1 == OfSizeExactly f2 k2 = f1 == f2 && k1 == k2@@ -107,26 +107,26 @@ compare _ (KSubset _) = GT compare Elt _ = LT compare _ Elt = GT- compare (f1 :+: g1) (f2 :+: g2) | f1 == f2 = compare g1 g2+ compare (f1 :+ g1) (f2 :+ g2) | f1 == f2 = compare g1 g2 | otherwise = compare f1 f2- compare (_ :+: _) _ = LT- compare _ (_ :+: _) = GT- compare (f1 :*: g1) (f2 :*: g2) | f1 == f2 = compare g1 g2+ compare (_ :+ _) _ = LT+ compare _ (_ :+ _) = GT+ compare (f1 :* g1) (f2 :* g2) | f1 == f2 = compare g1 g2 | otherwise = compare f1 f2- compare (_ :*: _) _ = LT- compare _ (_ :*: _) = GT- compare (f1 :.: g1) (f2 :.: g2) | f1 == f2 = compare g1 g2+ compare (_ :* _) _ = LT+ compare _ (_ :* _) = GT+ compare (f1 :. g1) (f2 :. g2) | f1 == f2 = compare g1 g2 | otherwise = compare f1 f2- compare (_ :.: _) _ = LT- compare _ (_ :.: _) = GT- compare (f1 :><: g1) (f2 :><: g2) | f1 == f2 = compare g1 g2+ compare (_ :. _) _ = LT+ compare _ (_ :. _) = GT+ compare (f1 :>< g1) (f2 :>< g2) | f1 == f2 = compare g1 g2 | otherwise = compare f1 f2- compare (_ :><: _) _ = LT- compare _ (_ :><: _) = GT- compare (f1 :@: g1) (f2 :@: g2) | f1 == f2 = compare g1 g2+ compare (_ :>< _) _ = LT+ compare _ (_ :>< _) = GT+ compare (f1 :@ g1) (f2 :@ g2) | f1 == f2 = compare g1 g2 | otherwise = compare f1 f2- compare (_ :@: _) _ = LT- compare _ (_ :@: _) = GT+ compare (_ :@ _) _ = LT+ compare _ (_ :@ _) = GT compare (Der f1) (Der f2) = compare f1 f2 compare (Der _) _ = LT compare _ (Der _) = GT@@ -162,19 +162,19 @@ showsPrec _ Subset = showChar 'p' showsPrec _ (KSubset n) = showChar 'p' . shows n showsPrec _ (Elt) = showChar 'e'- showsPrec p (f :+: g) = showParen (p>6) $ showsPrec 6 f+ showsPrec p (f :+ g) = showParen (p>6) $ showsPrec 6 f . showString " + " . showsPrec 6 g- showsPrec p (f :*: g) = showParen (p>=7) $ showsPrec 7 f+ showsPrec p (f :* g) = showParen (p>=7) $ showsPrec 7 f . showString " * " . showsPrec 7 g- showsPrec p (f :.: g) = showParen (p>=7) $ showsPrec 7 f+ showsPrec p (f :. g) = showParen (p>=7) $ showsPrec 7 f . showString " . " . showsPrec 7 g- showsPrec p (f :><: g) = showParen (p>=7) $ showsPrec 7 f+ showsPrec p (f :>< g) = showParen (p>=7) $ showsPrec 7 f . showString " >< " . showsPrec 7 g- showsPrec p (f :@: g) = showParen (p>=7) $ showsPrec 7 f+ showsPrec p (f :@ g) = showParen (p>=7) $ showsPrec 7 f . showString " @ " . showsPrec 7 g showsPrec p (Der f) = showsPrec 11 f . showChar '\''@@ -186,14 +186,14 @@ -- | Species expressions are additive. instance Additive.C SpeciesAST where zero = Zero- (+) = (:+:)+ (+) = (:+) negate = error "negation is not implemented yet! wait until virtual species..." -- | Species expressions form a ring. Well, sort of. Of course the -- ring laws actually only hold up to isomorphism of species, not up -- to structural equality. instance Ring.C SpeciesAST where- (*) = (:*:)+ (*) = (:*) one = One fromInteger 0 = zero fromInteger 1 = one@@ -216,9 +216,9 @@ subset = Subset ksubset k = KSubset k element = Elt- o = (:.:)- (><) = (:><:)- (@@) = (:@:)+ o = (:.)+ (><) = (:><)+ (@@) = (:@) ofSize = OfSize ofSizeExactly = OfSizeExactly nonEmpty = NonEmpty@@ -298,11 +298,11 @@ reflect Subset = subset reflect (KSubset k) = ksubset k reflect Elt = element-reflect (f :+: g) = reflect f + reflect g-reflect (f :*: g) = reflect f * reflect g-reflect (f :.: g) = reflect f `o` reflect g-reflect (f :><: g) = reflect f >< reflect g-reflect (f :@: g) = reflect f @@ reflect g+reflect (f :+ g) = reflect f + reflect g+reflect (f :* g) = reflect f * reflect g+reflect (f :. g) = reflect f `o` reflect g+reflect (f :>< g) = reflect f >< reflect g+reflect (f :@ g) = reflect f @@ reflect g reflect (Der f) = oneHole (reflect f) reflect (OfSize f p) = ofSize (reflect f) p reflect (OfSizeExactly f n) = ofSizeExactly (reflect f) n
Math/Combinatorics/Species/Enumerate.hs view
@@ -6,6 +6,7 @@ , KindSignatures , TypeFamilies , DeriveDataTypeable+ , TypeOperators #-} -----------------------------------------------------------------------------@@ -107,7 +108,7 @@ -- A better solution here might be to change MS.splits to only -- return splits which are of appropriate sizes. -enumerate' (f :*:: g) xs = [ Prod x y+enumerate' (f :*:: g) xs = [ x :*: y | (s1,s2) <- MS.splits xs , (fromIntegral $ MS.size s1) `I.elem` (getI f) , (fromIntegral $ MS.size s2) `I.elem` (getI g)@@ -124,7 +125,7 @@ enumerate' (f :><:: g) xs | any (/= 1) $ MS.getCounts xs = error "Unlabeled enumeration does not (yet) work with cartesian product."-enumerate' (f :><:: g) xs = [ Prod x y+enumerate' (f :><:: g) xs = [ x :*: y | x <- enumerate' (stripI f) xs , y <- enumerate' (stripI g) xs ]@@ -400,17 +401,17 @@ type StructTy Id = Id iso = id -instance (Enumerable f, Enumerable g) => Enumerable (Sum f g) where- type StructTy (Sum f g) = Sum (StructTy f) (StructTy g)+instance (Enumerable f, Enumerable g) => Enumerable (f :+: g) where+ type StructTy (f :+: g) = StructTy f :+: StructTy g iso (Inl x) = Inl (iso x) iso (Inr y) = Inr (iso y) -instance (Enumerable f, Enumerable g) => Enumerable (Prod f g) where- type StructTy (Prod f g) = Prod (StructTy f) (StructTy g)- iso (Prod x y) = Prod (iso x) (iso y)+instance (Enumerable f, Enumerable g) => Enumerable (f :*: g) where+ type StructTy (f :*: g) = StructTy f :*: StructTy g+ iso (x :*: y) = iso x :*: iso y -instance (Enumerable f, Functor f, Enumerable g) => Enumerable (Comp f g) where- type StructTy (Comp f g) = Comp (StructTy f) (StructTy g)+instance (Enumerable f, Functor f, Enumerable g) => Enumerable (f :.: g) where+ type StructTy (f :.: g) = StructTy f :.: StructTy g iso (Comp fgx) = Comp (fmap iso (iso fgx)) instance Enumerable [] where@@ -434,6 +435,6 @@ iso = id instance Enumerable Maybe where- type StructTy Maybe = Sum Unit Id+ type StructTy Maybe = Unit :+: Id iso (Inl Unit) = Nothing iso (Inr (Id x)) = Just x
Math/Combinatorics/Species/Simplify.hs view
@@ -44,11 +44,11 @@ simplify Subset = Subset simplify f@(KSubset _) = f simplify Elt = Elt-simplify (f :+: g) = simplSum (simplify f) (simplify g)-simplify (f :*: g) = simplProd (simplify f) (simplify g)-simplify (f :.: g) = simplComp (simplify f) (simplify g)-simplify (f :><: g) = simplCart (simplify f) (simplify g)-simplify (f :@: g) = simplFunc (simplify f) (simplify g)+simplify (f :+ g) = simplSum (simplify f) (simplify g)+simplify (f :* g) = simplProd (simplify f) (simplify g)+simplify (f :. g) = simplComp (simplify f) (simplify g)+simplify (f :>< g) = simplCart (simplify f) (simplify g)+simplify (f :@ g) = simplFunc (simplify f) (simplify g) simplify (Der f) = simplDer (simplify f) simplify (OfSize f p) = simplOfSize (simplify f) p simplify (OfSizeExactly f k) = simplOfSizeExactly (simplify f) k@@ -63,19 +63,19 @@ simplSum One (N n) = N $ succ n simplSum (N n) One = N $ succ n simplSum (N m) (N n) = N $ m + n-simplSum One (One :+: g) = simplSum (N 2) g-simplSum One ((N n) :+: g) = simplSum (N $ succ n) g-simplSum (N n) (One :+: g) = simplSum (N $ succ n) g-simplSum (N m) ((N n) :+: g) = simplSum (N (m + n)) g-simplSum (f :+: g) h = simplSum f (simplSum g h)+simplSum One (One :+ g) = simplSum (N 2) g+simplSum One ((N n) :+ g) = simplSum (N $ succ n) g+simplSum (N n) (One :+ g) = simplSum (N $ succ n) g+simplSum (N m) ((N n) :+ g) = simplSum (N (m + n)) g+simplSum (f :+ g) h = simplSum f (simplSum g h) simplSum f g | f == g = simplProd (N 2) f-simplSum f (g :+: h) | f == g = simplSum (simplProd (N 2) f) h-simplSum (N n :*: f) g | f == g = N (succ n) :*: f-simplSum f (N n :*: g) | f == g = N (succ n) :*: f-simplSum (N m :*: f) (N n :*: g) | f == g = N (m + n) :*: f-simplSum f (g :+: h) | g < f = simplSum g (simplSum f h)-simplSum f g | g < f = g :+: f-simplSum f g = f :+: g+simplSum f (g :+ h) | f == g = simplSum (simplProd (N 2) f) h+simplSum (N n :* f) g | f == g = N (succ n) :* f+simplSum f (N n :* g) | f == g = N (succ n) :* f+simplSum (N m :* f) (N n :* g) | f == g = N (m + n) :* f+simplSum f (g :+ h) | g < f = simplSum g (simplSum f h)+simplSum f g | g < f = g :+ f+simplSum f g = f :+ g simplProd :: SpeciesAST -> SpeciesAST -> SpeciesAST simplProd Zero _ = Zero@@ -83,15 +83,15 @@ simplProd One g = g simplProd f One = f simplProd (N m) (N n) = N $ m * n-simplProd (f1 :+: f2) g = simplSum (simplProd f1 g) (simplProd f2 g)-simplProd f (g1 :+: g2) = simplSum (simplProd f g1) (simplProd f g2)+simplProd (f1 :+ f2) g = simplSum (simplProd f1 g) (simplProd f2 g)+simplProd f (g1 :+ g2) = simplSum (simplProd f g1) (simplProd f g2) simplProd f (N n) = simplProd (N n) f-simplProd (N m) (N n :*: g) = simplProd (N $ m * n) g-simplProd f ((N n) :*: g) = simplProd (N n) (simplProd f g)-simplProd (f :*: g) h = simplProd f (simplProd g h)-simplProd f (g :*: h) | g < f = simplProd g (simplProd f h)-simplProd f g | g < f = g :*: f-simplProd f g = f :*: g+simplProd (N m) (N n :* g) = simplProd (N $ m * n) g+simplProd f ((N n) :* g) = simplProd (N n) (simplProd f g)+simplProd (f :* g) h = simplProd f (simplProd g h)+simplProd f (g :* h) | g < f = simplProd g (simplProd f h)+simplProd f g | g < f = g :* f+simplProd f g = f :* g simplComp :: SpeciesAST -> SpeciesAST -> SpeciesAST simplComp Zero _ = Zero@@ -100,16 +100,16 @@ simplComp X g = g simplComp f X = f simplComp f Zero = simplOfSizeExactly f 0-simplComp (f1 :+: f2) g = simplSum (simplComp f1 g) (simplComp f2 g)-simplComp (f1 :*: f2) g = simplProd (simplComp f1 g) (simplComp f2 g)-simplComp (f :.: g) h = f :.: (g :.: h)-simplComp f g = f :.: g+simplComp (f1 :+ f2) g = simplSum (simplComp f1 g) (simplComp f2 g)+simplComp (f1 :* f2) g = simplProd (simplComp f1 g) (simplComp f2 g)+simplComp (f :. g) h = f :. (g :. h)+simplComp f g = f :. g simplCart :: SpeciesAST -> SpeciesAST -> SpeciesAST-simplCart f g = f :><: g -- XXX+simplCart f g = f :>< g -- XXX simplFunc :: SpeciesAST -> SpeciesAST -> SpeciesAST-simplFunc f g = f :@: g -- XXX+simplFunc f g = f :@ g -- XXX simplDer :: SpeciesAST -> SpeciesAST simplDer Zero = Zero@@ -118,11 +118,11 @@ simplDer X = One simplDer E = E simplDer C = L-simplDer L = L :*: L-simplDer (f :+: g) = simplSum (simplDer f) (simplDer g)-simplDer (f :*: g) = simplSum (simplProd f (simplDer g)) (simplProd (simplDer f) g)-simplDer (f :.: g) = simplProd (simplComp (simplDer f) g) (simplDer g)-simplDer f = Der f+simplDer L = L :* L+simplDer (f :+ g) = simplSum (simplDer f) (simplDer g)+simplDer (f :* g) = simplSum (simplProd f (simplDer g)) (simplProd (simplDer f) g)+simplDer (f :. g) = simplProd (simplComp (simplDer f) g) (simplDer g)+simplDer f = Der f simplOfSize :: SpeciesAST -> (Integer -> Bool) -> SpeciesAST simplOfSize f p = OfSize f p -- XXX@@ -138,8 +138,8 @@ simplOfSizeExactly E 0 = One simplOfSizeExactly C 0 = Zero simplOfSizeExactly L 0 = One-simplOfSizeExactly (f :+: g) k = simplSum (simplOfSizeExactly f k) (simplOfSizeExactly g k)-simplOfSizeExactly (f :*: g) k = foldr simplSum Zero+simplOfSizeExactly (f :+ g) k = simplSum (simplOfSizeExactly f k) (simplOfSizeExactly g k)+simplOfSizeExactly (f :* g) k = foldr simplSum Zero [ simplProd (simplOfSizeExactly f j) (simplOfSizeExactly g (k - j)) | j <- [0..k] ] -- XXX get this to work?@@ -148,7 +148,7 @@ -- multiply together all the g's. However for non-regular f this -- doesn't work. Seems difficult to do this properly... --- simplOfSizeExactly (f :.: g) k = foldr simplSum Zero $+-- simplOfSizeExactly (f :. g) k = foldr simplSum Zero $ -- map (\gs -> simplProd (simplOfSizeExactly f (genericLength gs)) (foldr simplProd One gs)) -- [ map (simplOfSizeExactly g) p | p <- intPartitions k ] @@ -168,7 +168,7 @@ -- | Simplify a species and decompose it into a sum of products. sumOfProducts :: SpeciesAST -> [[SpeciesAST]] sumOfProducts = terms . simplify- where terms (f :+: g) = factors f : terms g+ where terms (f :+ g) = factors f : terms g terms f = [factors f]- factors (f :*: g) = f : factors g+ factors (f :* g) = f : factors g factors f = [f]
Math/Combinatorics/Species/Structures.hs view
@@ -5,6 +5,7 @@ , DeriveDataTypeable , TypeFamilies , EmptyDataDecls+ , TypeOperators #-} -----------------------------------------------------------------------------@@ -28,9 +29,9 @@ , Unit(..) , Const(..) , Id(..)- , Sum(..)- , Prod(..)- , Comp(..)+ , (:+:)(..)+ , (:*:)(..)+ , (:.:)(..) , Cycle(..) , Set(..) , Star(..)@@ -92,44 +93,54 @@ show (Id x) = show x -- | Functor coproduct.-data Sum f g a = Inl (f a) | Inr (g a)-instance (Functor f, Functor g) => Functor (Sum f g) where+data (f :+: g) a = Inl (f a) | Inr (g a)+instance (Functor f, Functor g) => Functor (f :+: g) where fmap f (Inl fa) = Inl (fmap f fa) fmap f (Inr ga) = Inr (fmap f ga)-instance (Show (f a), Show (g a)) => Show (Sum f g a) where+instance (Show (f a), Show (g a)) => Show ((f :+: g) a) where show (Inl fa) = "inl(" ++ show fa ++ ")" show (Inr ga) = "inr(" ++ show ga ++ ")"-instance (Typeable1 f, Typeable1 g) => Typeable1 (Sum f g) where- typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.Sum") [typeOf1 (getF x), typeOf1 (getG x)]- where getF :: Sum f g a -> f a+instance (Typeable1 f, Typeable1 g) => Typeable1 (f :+: g) where+ typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:+:)") [typeOf1 (getF x), typeOf1 (getG x)]+ where getF :: (f :+: g) a -> f a getF = undefined- getG :: Sum f g a -> g a+ getG :: (f :+: g) a -> g a getG = undefined -- | Functor product.-data Prod f g a = Prod (f a) (g a)-instance (Functor f, Functor g) => Functor (Prod f g) where- fmap f (Prod fa ga) = Prod (fmap f fa) (fmap f ga)-instance (Show (f a), Show (g a)) => Show (Prod f g a) where- show (Prod x y) = show (x,y)-instance (Typeable1 f, Typeable1 g) => Typeable1 (Prod f g) where- typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.Prod") [typeOf1 (getF x), typeOf1 (getG x)]- where getF :: Prod f g a -> f a+data (f :*: g) a = f a :*: g a++pFst :: (f :*: g) a -> f a+pFst (x :*: y) = x++pSnd :: (f :*: g) a -> g a+pSnd (x :*: y) = y++pSwap :: (f :*: g) a -> (g :*: f) a+pSwap (x :*: y) = y :*: x++instance (Functor f, Functor g) => Functor (f :*: g) where+ fmap f (fa :*: ga) = fmap f fa :*: fmap f ga+instance (Show (f a), Show (g a)) => Show ((f :*: g) a) where+ show (x :*: y) = show (x,y)+instance (Typeable1 f, Typeable1 g) => Typeable1 (f :*: g) where+ typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:*:)") [typeOf1 (getF x), typeOf1 (getG x)]+ where getF :: (f :*: g) a -> f a getF = undefined- getG :: Prod f g a -> g a+ getG :: (f :*: g) a -> g a getG = undefined -- | Functor composition.-data Comp f g a = Comp { unComp :: (f (g a)) }-instance (Functor f, Functor g) => Functor (Comp f g) where+data (f :.: g) a = Comp { unComp :: (f (g a)) }+instance (Functor f, Functor g) => Functor (f :.: g) where fmap f (Comp fga) = Comp (fmap (fmap f) fga)-instance (Show (f (g a))) => Show (Comp f g a) where+instance (Show (f (g a))) => Show ((f :.: g) a) where show (Comp x) = show x-instance (Typeable1 f, Typeable1 g) => Typeable1 (Comp f g) where- typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.Comp") [typeOf1 (getF x), typeOf1 (getG x)]- where getF :: Comp f g a -> f a+instance (Typeable1 f, Typeable1 g) => Typeable1 (f :.: g) where+ typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:.:)") [typeOf1 (getF x), typeOf1 (getG x)]+ where getF :: (f :.: g) a -> f a getF = undefined- getG :: Comp f g a -> g a+ getG :: (f :.: g) a -> g a getG = undefined -- | Cycle structure. A value of type @'Cycle' a@ is implemented as@@ -186,5 +197,5 @@ -- | Interpretation type function for codes for higher-order type -- constructors, used as arguments to the higher-order fixpoint 'Mu'.-type family Interp f self :: * -> *+type family Interp f (self :: * -> *) :: * -> *
Math/Combinatorics/Species/TH.hs view
@@ -6,6 +6,7 @@ , TypeFamilies , PatternGuards , DeriveDataTypeable+ , TypeOperators #-} {- Refactoring plan:@@ -75,10 +76,6 @@ -- Preliminaries ----------------------------------------- ------------------------------------------------------------ -instance Applicative Q where- pure = return- (<*>) = ap- -- | Report a fatal error and stop processing in the 'Q' monad. errorQ :: String -> Q a errorQ msg = report True msg >> error msg@@ -219,11 +216,11 @@ spToExp' Subset = [| subset |] spToExp' (KSubset k) = [| ksubset $(lift k) |] spToExp' Elt = [| element |]- spToExp' (f :+: g) = [| $(spToExp' f) + $(spToExp' g) |]- spToExp' (f :*: g) = [| $(spToExp' f) * $(spToExp' g) |]- spToExp' (f :.: g) = [| $(spToExp' f) `o` $(spToExp' g) |]- spToExp' (f :><: g) = [| $(spToExp' f) >< $(spToExp' g) |]- spToExp' (f :@: g) = [| $(spToExp' f) @@ $(spToExp' g) |]+ spToExp' (f :+ g) = [| $(spToExp' f) + $(spToExp' g) |]+ spToExp' (f :* g) = [| $(spToExp' f) * $(spToExp' g) |]+ spToExp' (f :. g) = [| $(spToExp' f) `o` $(spToExp' g) |]+ spToExp' (f :>< g) = [| $(spToExp' f) >< $(spToExp' g) |]+ spToExp' (f :@ g) = [| $(spToExp' f) @@ $(spToExp' g) |] spToExp' (Der f) = [| oneHole $(spToExp' f) |] spToExp' (OfSize _ _) = error "Can't reify general size predicate into code" spToExp' (OfSizeExactly f k) = [| $(spToExp' f) `ofSizeExactly` $(lift k) |]@@ -247,11 +244,11 @@ spToTy' Subset = [t| Set |] spToTy' (KSubset _) = [t| Set |] spToTy' Elt = [t| Id |]- spToTy' (f :+: g) = [t| Sum $(spToTy' f) $(spToTy' g) |]- spToTy' (f :*: g) = [t| Prod $(spToTy' f) $(spToTy' g) |]- spToTy' (f :.: g) = [t| Comp $(spToTy' f) $(spToTy' g) |]- spToTy' (f :><: g) = [t| Prod $(spToTy' f) $(spToTy' g) |]- spToTy' (f :@: g) = [t| Comp $(spToTy' f) $(spToTy' g) |]+ spToTy' (f :+ g) = [t| $(spToTy' f) :+: $(spToTy' g) |]+ spToTy' (f :* g) = [t| $(spToTy' f) :*: $(spToTy' g) |]+ spToTy' (f :. g) = [t| $(spToTy' f) :.: $(spToTy' g) |]+ spToTy' (f :>< g) = [t| $(spToTy' f) :*: $(spToTy' g) |]+ spToTy' (f :@ g) = [t| $(spToTy' f) :.: $(spToTy' g) |] spToTy' (Der f) = [t| Star $(spToTy' f) |] spToTy' (OfSize f _) = spToTy' f spToTy' (OfSizeExactly f _) = spToTy' f@@ -316,7 +313,7 @@ mkIsoMatches _ (SSumProd []) = return [] mkIsoMatches sp (SSumProd [con]) = mkIsoConMatches sp con mkIsoMatches sp (SSumProd cons) = addInjs 0 <$> zipWithM mkIsoConMatches (terms sp) cons- where terms (f :+: g) = terms f ++ [g]+ where terms (f :+ g) = terms f ++ [g] terms f = [f] addInjs :: Int -> [[(Pat, Exp)]] -> [(Pat, Exp)]@@ -337,11 +334,11 @@ mkIsoConMatches :: SpeciesAST -> (Name, [Struct]) -> Q [(Pat, Exp)] mkIsoConMatches _ (cnm, []) = return [(ConP 'Unit [], ConE cnm)] mkIsoConMatches sp (cnm, ps) = map mkProd . sequence <$> zipWithM mkIsoMatches (factors sp) ps- where factors (f :*: g) = factors f ++ [g]+ where factors (f :* g) = factors f ++ [g] factors f = [f] mkProd :: [(Pat, Exp)] -> (Pat, Exp)- mkProd = (foldl1 (\x y -> (ConP 'Prod [x, y])) *** foldl AppE (ConE cnm))+ mkProd = (foldl1 (\x y -> (ConP '(:*:) [x, y])) *** foldl AppE (ConE cnm)) . unzip -- Species definition --------@@ -367,14 +364,14 @@ structToSpAST _ (SConst t) = error "SConst in structToSpAST?" structToSpAST self (SEnum t) = typeToSpAST self t structToSpAST _ (SSumProd []) = [| TZero |]-structToSpAST self (SSumProd ss) = foldl1 (\x y -> [| annI $x :+: annI $y |])+structToSpAST self (SSumProd ss) = foldl1 (\x y -> [| annI $x :+ annI $y |]) $ map (conToSpAST self) ss-structToSpAST self (SComp s1 s2) = [| annI $(structToSpAST self s1) :.: annI $(structToSpAST self s2) |]+structToSpAST self (SComp s1 s2) = [| annI $(structToSpAST self s1) :. annI $(structToSpAST self s2) |] structToSpAST self SSelf = varE self conToSpAST :: Name -> (Name, [Struct]) -> Q Exp conToSpAST _ (_,[]) = [| TOne |]-conToSpAST self (_,ps) = foldl1 (\x y -> [| annI $x :*: annI $y |]) $ map (structToSpAST self) ps+conToSpAST self (_,ps) = foldl1 (\x y -> [| annI $x :* annI $y |]) $ map (structToSpAST self) ps typeToSpAST :: Name -> Type -> Q Exp typeToSpAST _ ListT = [| TL |]
species.cabal view
@@ -1,12 +1,13 @@ name: species-version: 0.3.2.1+version: 0.3.2.3 license: BSD3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.6-tested-with: GHC == 6.12.1, GHC == 7.0.3+cabal-version: >= 1.10+tested-with: GHC == 7.4.2, GHC == 7.6.1 author: Brent Yorgey maintainer: Brent Yorgey <byorgey@cis.upenn.edu>+bug-reports: http://hub.darcs.net/byorgey/species/issues category: Math synopsis: Computational combinatorial species @@ -17,13 +18,15 @@ extra-source-files: CHANGES source-repository head type: darcs- location: http://code.haskell.org/~byorgey/code/species+ location: http://hub.darcs.net/byorgey/species Library- build-depends: base >= 3 && < 4.5, numeric-prelude >= 0.1.1 && < 0.3,- np-extras >= 0.2.0.2 && < 0.3, containers >= 0.2 && < 0.5,- multiset-comb >= 0.2.1 && < 0.3,- template-haskell >= 2.4 && < 2.7+ build-depends: base >= 3 && < 4.7,+ numeric-prelude >= 0.3 && < 0.4,+ np-extras >= 0.3 && < 0.4,+ containers >= 0.2 && < 0.6,+ multiset-comb >= 0.2.3 && < 0.3,+ template-haskell >= 2.7 && < 2.9 exposed-modules: Math.Combinatorics.Species Math.Combinatorics.Species.Class@@ -39,4 +42,9 @@ Math.Combinatorics.Species.Util.Interval Math.Combinatorics.Species.NewtonRaphson Math.Combinatorics.Species.Simplify- extensions: NoImplicitPrelude+ default-extensions: NoImplicitPrelude+ other-extensions: GADTs,+ TemplateHaskell,+ DeriveDataTypeable,+ CPP+ default-language: Haskell2010