species 0.1 → 0.2
raw patch · 10 files changed
+814/−328 lines, 10 filesdep ~np-extras
Dependency ranges changed: np-extras
Files
- Math/Combinatorics/Species.hs +67/−17
- Math/Combinatorics/Species/AST.hs +174/−0
- Math/Combinatorics/Species/Algebra.hs +0/−142
- Math/Combinatorics/Species/Class.hs +103/−45
- Math/Combinatorics/Species/CycleIndex.hs +142/−20
- Math/Combinatorics/Species/Generate.hs +206/−49
- Math/Combinatorics/Species/Labelled.hs +11/−3
- Math/Combinatorics/Species/Types.hs +82/−25
- Math/Combinatorics/Species/Unlabelled.hs +22/−20
- species.cabal +7/−7
Math/Combinatorics/Species.hs view
@@ -1,53 +1,103 @@ {-# LANGUAGE NoImplicitPrelude #-} --- | A DSL for describing combinatorial species and computing various--- properties. This module re-exports the most generally useful--- functionality; for more specialized functionality (for example,--- computing directly with cycle index series), see the various--- sub-modules.+-- | A DSL for describing and computing with combinatorial species.+-- This module re-exports the most generally useful functionality;+-- for more specialized functionality (for example, computing+-- directly with cycle index series), see the various sub-modules. -- -- Note that this library makes extensive use of the numeric-prelude -- library; to use it you will want to use -XNoImplicitPrelude, and -- import NumericPrelude and PreludeBase. ----- For a good reference (really, the only English-language--- reference!) on combinatorial species, see Bergeron, Labelle, and--- Leroux, \"Combinatorial Species and Tree-Like Structures\",--- Vol. 67 of the Encyclopedia of Mathematics and its Applications,--- Gian-Carlo Rota, ed., Cambridge University Press, 1998.+-- For a friendly introduction to combinatorial species in general+-- and this library in particular, see my series of blog posts:+--+-- <http://byorgey.wordpress.com/2009/07/24/introducing-math-combinatorics-species/>+--+-- For a good reference (really, the+-- only English-language reference!) on combinatorial species, see+-- Bergeron, Labelle, and Leroux, \"Combinatorial Species and+-- Tree-Like Structures\", Vol. 67 of the Encyclopedia of+-- Mathematics and its Applications, Gian-Carlo Rota, ed., Cambridge+-- University Press, 1998. module Math.Combinatorics.Species ( -- * The combinatorial species DSL+ -- $DSL Species(..) -- ** Convenience methods+ -- $synonyms+ , oneHole , madeOf- , x, e, sets, cycles- + , (><), (@@)+ , x, sets, cycles+ , subsets+ , ksubsets+ , elements+ -- ** Derived operations , pointed- , nonEmpty -- ** Derived species , list, lists- , element, elements , octopus, octopi , partition, partitions , permutation, permutations- , subset, subsets , ballot, ballots- , ksubset, ksubsets + , simpleGraph, simpleGraphs+ , directedGraph, directedGraphs -- * Computing with species , labelled , unlabelled++ -- * Generating species structures , generate + , generateTyped+ , structureType++ -- ** Types used for generation+ -- $types+ , Identity(..), Const(..)+ , Sum(..), Prod(..), Comp(..)+ , Star(..), Cycle(..), Set(..)++ -- * Species AST+ -- $ast+ , SpeciesTypedAST(..)+ , SpeciesAST(..)+ , reify+ , reflect+ ) where +import Math.Combinatorics.Species.Types import Math.Combinatorics.Species.Class import Math.Combinatorics.Species.Labelled import Math.Combinatorics.Species.Unlabelled import Math.Combinatorics.Species.Generate- +import Math.Combinatorics.Species.AST +-- $DSL+-- The combinatorial species DSL consists of the 'Species' type class,+-- which defines some primitive species and species operations.+-- Expressions of type @Species s => s@ can then be interpreted at+-- various instance types in order to compute with species in various+-- ways.++-- $synonyms+-- Some synonyms are provided for convenience. In particular,+-- gramatically it can often be convenient to have both the singular+-- and plural versions of species, for example, @set \`o\` nonEmpty+-- sets@.++-- $types+-- Many of these functors are already defined elsewhere, in other+-- packages; but to avoid a plethora of imports, inconsistent+-- naming/instance schemes, etc., we just redefine them here.++-- $ast+-- Species can be converted to and from 'SpeciesAST' via the functions+-- 'reify' and 'reflect'.
+ Math/Combinatorics/Species/AST.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE NoImplicitPrelude+ , GADTs+ , TypeOperators+ , FlexibleContexts+ #-}++-- | A data structure to reify combinatorial species.+module Math.Combinatorics.Species.AST+ (+ SpeciesTypedAST(..)+ , SpeciesAST(..)+ , needsZT, needsZ++ , reify+ , reflectT+ , reflect++ ) where++import Math.Combinatorics.Species.Class+import Math.Combinatorics.Species.Types++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import qualified Algebra.Differential as Differential++import Data.Typeable++import NumericPrelude+import PreludeBase hiding (cycle)++-- | Reified combinatorial species. Note that 'SpeciesTypedAST' has a+-- phantom type parameter which also reflects the structure, so we+-- can do case analysis on species at both the value and type level.+--+-- Of course, the non-uniform type parameter means that+-- 'SpeciesTypedAST' cannot be an instance of the 'Species' class;+-- for that purpose the existential wrapper 'SpeciesAST' is+-- provided.+data SpeciesTypedAST s where+ O :: SpeciesTypedAST Z+ I :: SpeciesTypedAST (S Z)+ X :: SpeciesTypedAST X+ E :: SpeciesTypedAST E+ C :: SpeciesTypedAST C+ Subset :: SpeciesTypedAST Sub+ KSubset :: Integer -> SpeciesTypedAST Sub+ Elt :: SpeciesTypedAST Elt+ (:+:) :: (ShowF (StructureF f), ShowF (StructureF g))+ => SpeciesTypedAST f -> SpeciesTypedAST g -> SpeciesTypedAST (f :+: g)+ (:*:) :: (ShowF (StructureF f), ShowF (StructureF g))+ => SpeciesTypedAST f -> SpeciesTypedAST g -> SpeciesTypedAST (f :*: g)+ (:.:) :: (ShowF (StructureF f), ShowF (StructureF g))+ => SpeciesTypedAST f -> SpeciesTypedAST g -> SpeciesTypedAST (f :.: g)+ (:><:) :: (ShowF (StructureF f), ShowF (StructureF g))+ => SpeciesTypedAST f -> SpeciesTypedAST g -> SpeciesTypedAST (f :><: g)+ (:@:) :: (ShowF (StructureF f), ShowF (StructureF g))+ => SpeciesTypedAST f -> SpeciesTypedAST g -> SpeciesTypedAST (f :@: g)+ Der :: (ShowF (StructureF f))+ => SpeciesTypedAST f -> SpeciesTypedAST (Der f)+ OfSize :: SpeciesTypedAST f -> (Integer -> Bool) -> SpeciesTypedAST f+ OfSizeExactly :: SpeciesTypedAST f -> Integer -> SpeciesTypedAST f+ NonEmpty :: SpeciesTypedAST f -> SpeciesTypedAST f++instance Show (SpeciesTypedAST s) where+ showsPrec _ O = showChar '0'+ showsPrec _ I = showChar '1'+ showsPrec _ X = showChar 'X'+ showsPrec _ E = showChar 'E'+ showsPrec _ C = showChar 'C'+ 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 . showString " + " . showsPrec 6 g+ showsPrec p (f :*: g) = showParen (p>=7) $ showsPrec 7 f . showString " * " . showsPrec 7 g+ showsPrec p (f :.: g) = showParen (p>=7) $ showsPrec 7 f . showString " . " . showsPrec 7 g+ showsPrec p (f :><: g) = showParen (p>=7) $ showsPrec 7 f . showString " >< " . showsPrec 7 g+ showsPrec p (f :@: g) = showParen (p>=7) $ showsPrec 7 f . showString " @ " . showsPrec 7 g+ showsPrec p (Der f) = showsPrec 11 f . showChar '\''+ showsPrec _ (OfSize f p) = showChar '<' . showsPrec 0 f . showChar '>'+ showsPrec _ (OfSizeExactly f n) = showsPrec 11 f . shows n+ showsPrec _ (NonEmpty f) = showsPrec 11 f . showChar '+'++-- | 'needsZT' is a predicate which checks whether a species uses any+-- of the operations which are not supported directly by ordinary+-- generating functions (composition, differentiation, cartesian+-- product, and functor composition), and hence need cycle index+-- series.+needsZT :: SpeciesTypedAST s -> Bool+needsZT (f :+: g) = needsZT f || needsZT g+needsZT (f :*: g) = needsZT f || needsZT g+needsZT (_ :.: _) = True+needsZT (_ :><: _) = True+needsZT (_ :@: _) = True+needsZT (Der _) = True+needsZT (OfSize f _) = needsZT f+needsZT (OfSizeExactly f _) = needsZT f+needsZT (NonEmpty f) = needsZT f+needsZT _ = False++-- | An existential wrapper to hide the phantom type parameter to+-- 'SpeciesTypedAST', so we can make it an instance of 'Species'.+data SpeciesAST where+ SA :: (ShowF (StructureF s), Typeable1 (StructureF s)) + => SpeciesTypedAST s -> SpeciesAST++-- | A version of 'needsZT' for 'SpeciesAST'.+needsZ :: SpeciesAST -> Bool+needsZ (SA s) = needsZT s++instance Show SpeciesAST where+ show (SA f) = show f++instance Additive.C SpeciesAST where+ zero = SA O+ (SA f) + (SA g) = SA (f :+: g)+ negate = error "negation is not implemented yet! wait until virtual species..."++instance Ring.C SpeciesAST where+ (SA f) * (SA g) = SA (f :*: g)+ one = SA I++instance Differential.C SpeciesAST where+ differentiate (SA f) = SA (Der f)++instance Species SpeciesAST where+ singleton = SA X+ set = SA E+ cycle = SA C+ subset = SA Subset+ ksubset k = SA (KSubset k)+ element = SA Elt+ o (SA f) (SA g) = SA (f :.: g)+ cartesian (SA f) (SA g) = SA (f :><: g)+ fcomp (SA f) (SA g) = SA (f :@: g)+ ofSize (SA f) p = SA (OfSize f p)+ ofSizeExactly (SA f) n = SA (OfSizeExactly f n)+ nonEmpty (SA f) = SA (NonEmpty f)++-- | Reify a species expression into an AST. Of course, this is just+-- the identity function with a usefully restricted type. For+-- example:+--+-- > > reify octopus+-- > C . C'++-- > > reify (ksubset 3)+-- > E3 * E++reify :: SpeciesAST -> SpeciesAST+reify = id++-- | Reflect an AST back into any instance of the 'Species' class.+reflectT :: Species s => SpeciesTypedAST f -> s+reflectT O = zero+reflectT I = one+reflectT X = singleton+reflectT E = set+reflectT C = cycle+reflectT Subset = subset+reflectT (KSubset k) = ksubset k+reflectT Elt = element+reflectT (f :+: g) = reflectT f + reflectT g+reflectT (f :*: g) = reflectT f * reflectT g+reflectT (f :.: g) = reflectT f `o` reflectT g+reflectT (f :><: g) = reflectT f >< reflectT g+reflectT (f :@: g) = reflectT f @@ reflectT g+reflectT (Der f) = oneHole (reflectT f)+reflectT (OfSize f p) = ofSize (reflectT f) p+reflectT (OfSizeExactly f n) = ofSizeExactly (reflectT f) n+reflectT (NonEmpty f) = nonEmpty (reflectT f)++-- | Reflect an AST back into any instance of the 'Species' class.+reflect :: Species s => SpeciesAST -> s+reflect (SA f) = reflectT f
− Math/Combinatorics/Species/Algebra.hs
@@ -1,142 +0,0 @@-{-# LANGUAGE NoImplicitPrelude- , GADTs- , TypeOperators- , FlexibleContexts- #-}---- | A data structure to reify combinatorial species.-module Math.Combinatorics.Species.Algebra - (- SpeciesAlgT(..)- , SpeciesAlg(..)- , needsZT, needsZ-- , reify- , reflectT- , reflect- - ) where--import Math.Combinatorics.Species.Class-import Math.Combinatorics.Species.Types--import qualified Algebra.Additive as Additive-import qualified Algebra.Ring as Ring-import qualified Algebra.Differential as Differential--import NumericPrelude-import PreludeBase hiding (cycle)---- | Reified combinatorial species. Note that 'SpeciesAlgT' has a--- phantom type parameter which also reflects the structure, so we--- can do case analysis on species at both the value and type level.------ Of course, the non-uniform type parameter means that--- 'SpeciesAlgT' cannot be an instance of the 'Species' class; for--- that purpose the existential wrapper 'SpeciesAlg' is provided.-data SpeciesAlgT s where- O :: SpeciesAlgT Z- I :: SpeciesAlgT (S Z)- X :: SpeciesAlgT X- (:+:) :: (ShowF (StructureF f), ShowF (StructureF g)) - => SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :+: g)- (:*:) :: (ShowF (StructureF f), ShowF (StructureF g))- => SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :*: g)- (:.:) :: (ShowF (StructureF f), ShowF (StructureF g)) - => SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :.: g)- Der :: (ShowF (StructureF f)) - => SpeciesAlgT f -> SpeciesAlgT (Der f)- E :: SpeciesAlgT E- C :: SpeciesAlgT C- OfSize :: SpeciesAlgT f -> (Integer -> Bool) -> SpeciesAlgT f- OfSizeExactly :: SpeciesAlgT f -> Integer -> SpeciesAlgT f---- (:.) :: (ShowF (StructureF f), ShowF (StructureF g))--- => SpeciesAlgT f -> SpeciesAlgT g -> SpeciesAlgT (f :. g)---- XXX improve this-instance Show (SpeciesAlgT s) where- show O = "0"- show I = "1"- show X = "X"- show (f :+: g) = "(" ++ show f ++ " + " ++ show g ++ ")"- show (f :*: g) = "(" ++ show f ++ " * " ++ show g ++ ")"- show (f :.: g) = "(" ++ show f ++ " . " ++ show g ++ ")"- show (Der f) = show f ++ "'"- show E = "E"- show C = "C"- show (OfSize f p) = "<" ++ show f ++ ">"- show (OfSizeExactly f n) = show f ++ "_" ++ show n---- show (f :. g) = show f ++ ".:" ++ show g---- | 'needsZT' is a predicate which checks whether a species uses any--- of the operations which are not supported directly by ordinary--- generating functions (composition and differentiation), and hence--- need cycle index series.-needsZT :: SpeciesAlgT s -> Bool-needsZT (f :+: g) = needsZT f || needsZT g-needsZT (f :*: g) = needsZT f || needsZT g-needsZT (_ :.: _) = True-needsZT (Der _) = True-needsZT (OfSize f _) = needsZT f-needsZT (OfSizeExactly f _) = needsZT f-needsZT _ = False---- | An existential wrapper to hide the phantom type parameter to--- 'SpeciesAlgT', so we can make it an instance of 'Species'.-data SpeciesAlg where- SA :: (ShowF (StructureF s)) => SpeciesAlgT s -> SpeciesAlg---- | A version of 'needsZT' for 'SpeciesAlg'.-needsZ :: SpeciesAlg -> Bool-needsZ (SA s) = needsZT s--instance Show SpeciesAlg where- show (SA f) = show f--instance Additive.C SpeciesAlg where- zero = SA O- (SA f) + (SA g) = SA (f :+: g)- negate = error "negation is not implemented yet! wait until virtual species..."--instance Ring.C SpeciesAlg where- (SA f) * (SA g) = SA (f :*: g)- one = SA I--instance Differential.C SpeciesAlg where- differentiate (SA f) = SA (Der f)--instance Species SpeciesAlg where- singleton = SA X- set = SA E- cycle = SA C- o (SA f) (SA g) = SA (f :.: g)- ofSize (SA f) p = SA (OfSize f p)- ofSizeExactly (SA f) n = SA (OfSizeExactly f n)---- | Reify a species expression into a tree. Of course, this is just--- the identity function with a usefully restricted type. For example:------ > > reify octopus--- > (C . C'_+)-reify :: SpeciesAlg -> SpeciesAlg-reify = id---- | Reflect a species back into any instance of the 'Species' class.-reflectT :: Species s => SpeciesAlgT f -> s-reflectT O = zero-reflectT I = one-reflectT X = singleton-reflectT (f :+: g) = reflectT f + reflectT g-reflectT (f :*: g) = reflectT f * reflectT g-reflectT (f :.: g) = reflectT f `o` reflectT g-reflectT (Der f) = oneHole (reflectT f)-reflectT E = set-reflectT C = cycle-reflectT (OfSize f p) = ofSize (reflectT f) p-reflectT (OfSizeExactly f n) = ofSizeExactly (reflectT f) n---- | A version of 'reflectT' for the existential wrapper 'SpeciesAlg'.-reflect :: Species s => SpeciesAlg -> s-reflect (SA f) = reflectT f
Math/Combinatorics/Species/Class.hs view
@@ -10,32 +10,32 @@ Species(..) -- * Convenience methods- -- $synonyms , oneHole , madeOf+ , (><), (@@) , x- , e , sets , cycles+ , subsets+ , ksubsets+ , elements -- * Derived operations -- $derived_ops , pointed- , nonEmpty -- * Derived species -- $derived , list, lists- , element, elements , octopus, octopi , partition, partitions , permutation, permutations- , subset, subsets , ballot, ballots- , ksubset, ksubsets+ , simpleGraph, simpleGraphs+ , directedGraph, directedGraphs ) where @@ -44,8 +44,6 @@ import NumericPrelude import PreludeBase hiding (cycle) -infixr 5 .:- -- | The Species type class. Note that the @Differential@ constraint -- requires s to be a differentiable ring, which means that every -- instance must also implement instances for "Algebra.Additive"@@ -54,45 +52,100 @@ -- i.e. partitional product), and "Algebra.Differential" (species -- differentiation, i.e. adjoining a distinguished element). --+-- Minimal complete definition: 'singleton', 'set', 'cycle', 'o',+-- 'cartesian', 'fcomp', 'ofSize'.+-- -- Note that the 'o' operation can be used infix to suggest common -- notation for composition, and also to be read as an abbreviation -- for \"of\", as in \"top o' the mornin'\": @set \`o\` nonEmpty -- sets@.+--+-- In this version of the library, 'Species' has four instances:+-- 'EGF' (exponential generating functions, for counting labelled+-- structures), 'GF' (ordinary generating function, for counting+-- unlabelled structures), 'CycleIndex' (cycle index series, a+-- generalization of both 'EGF' and 'GF'), and 'SpeciesAST' (reified+-- species expressions). class (Differential.C s) => Species s where - -- | The species X of singletons+ -- | The species X of singletons. X puts a singleton structure on an+ -- underlying set of size 1, and no structures on any other+ -- underlying sets. singleton :: s - -- | The species E of sets+ -- | The species E of sets. E puts a singleton structure on any+ -- underlying set. set :: s - -- | The species C of cyclical orderings (cycles/rings)+ -- | The species C of cyclical orderings (cycles/rings). cycle :: s - -- | Partitional composition+ -- | The species p of subsets is given by p = E * E. 'subset' has a+ -- default implementation of @set * set@, but is included in the+ -- 'Species' class so it can be overridden when generating+ -- structures: since subset is defined as @set * set@, the+ -- generation code by default generates a pair of the subset and+ -- its complement, but normally when thinking about subsets we+ -- only want to see the elements in the subset. To explicitly+ -- generate subset/complement pairs, you can use @set * set@+ -- directly.+ subset :: s+ subset = set * set++ -- | Subsets of size exactly k, p[k] = E_k * E. Included with a+ -- default definition in the 'Species' class for the same reason+ -- as 'subset'.+ ksubset :: Integer -> s+ ksubset k = (set `ofSizeExactly` k) * set++ -- | Structures of the species e of elements are just elements of+ -- the underlying set: e = X * E. Included with default+ -- definition in 'Species' class for the same reason as 'subset'+ -- and 'ksubset'.+ element :: s+ element = x * set++ -- | Partitional composition. To form all (F o G)-structures on the+ -- underlying set U, first form all set partitions of U; for each+ -- partition p, put an F-structure on the classes of p, and a+ -- separate G-structure on the elements in each class. o :: s -> s -> s + -- | Cartisian product of two species. An (F x G)-structure+ -- consists of an F structure superimposed on a G structure over+ -- the same underlying set.+ cartesian :: s -> s -> s++ -- | Functor composition of two species. An (F \@\@ G)-structure+ -- consists of an F-structure on the set of all G-structures.+ fcomp :: s -> s -> s+ -- | Only put a structure on underlying sets whose size satisfies -- the predicate. ofSize :: s -> (Integer -> Bool) -> s - -- | Only put a structure on underlying sets of the given size. We- -- include this as a special case, instead of just using @ofSize- -- (==k)@, since it can be more efficient: we get to turn infinite- -- lists of coefficients into finite ones.+ -- | Only put a structure on underlying sets of the given size. A+ -- default implementation of @ofSize (==k)@ is provided, but this+ -- method is included in the 'Species' class as a special case+ -- since it can be more efficient: we get to turn infinite lists+ -- of coefficients into finite ones. ofSizeExactly :: s -> Integer -> s+ ofSizeExactly s n = s `ofSize` (==n) - -- | @s1 .: s2@ is the species which puts an s1 structure on the- -- empty set and an s2 structure on anything else. Useful for- -- getting recursively defined species off the ground.- (.:) :: s -> s -> s+ -- | Don't put a structure on the empty set. The default definition+ -- uses 'ofSize'; included in the 'Species' class so it can be+ -- overriden in special cases (such as when reifying species+ -- expressions).+ nonEmpty :: s -> s+ nonEmpty = flip ofSize (>0) --- $synonyms--- Some synonyms are provided for convenience. In particular,--- gramatically it can often be convenient to have both the singular--- and plural versions of species, for example, @set \`o\` nonEmpty--- sets@.+ -- | @rec n s f@ is the species which puts an s-structure on label+ -- sets of size <= n, and which are described recusively by (fix+ -- f) for larger label sets.+ -- rec :: Integer -> s -> (s -> s) -> s ++ -- | A convenient synonym for differentiation. F'-structures look -- like F-structures on a set formed by adjoining a distinguished -- \"hole\" element to the underlying set.@@ -103,14 +156,18 @@ madeOf :: Species s => s -> s -> s madeOf = o +-- | A synonym for cartesian product.+(><) :: Species s => s -> s -> s+(><) = cartesian++-- | A synonym for functor composition.+(@@) :: Species s => s -> s -> s+(@@) = fcomp+ -- | A synonym for 'singleton'. x :: Species s => s x = singleton --- | A synonym for 'set'.-e :: Species s => s-e = set- sets :: Species s => s sets = set @@ -126,11 +183,6 @@ pointed :: Species s => s -> s pointed = (x *) . Differential.differentiate --- | Don't put a structure on the empty set.-nonEmpty :: Species s => s -> s-nonEmpty = flip ofSize (>0)-- -- $derived -- Some species that can be defined in terms of the primitive species -- operations.@@ -140,14 +192,10 @@ list :: Species s => s list = oneHole cycle --- | A convenient synonym for 'list'. lists :: Species s => s lists = list --- | Structures of the species eps of elements are just elements of--- the underlying set: eps = X * E.-elements, element :: Species s => s-element = x * e+elements :: Species s => s elements = element -- | An octopus is a cyclic arrangement of lists, so called because@@ -168,9 +216,7 @@ permutation = set `o` cycles permutations = permutation --- | The species p of subsets is given by p = E * E.-subsets, subset :: Species s => s-subset = set * set+subsets :: Species s => s subsets = subset -- | The species Bal of ballots consists of linear orderings of@@ -179,7 +225,19 @@ ballot = list `o` nonEmpty sets ballots = ballot --- | Subsets of size exactly k, p[k] = E_k * E.-ksubsets, ksubset :: Species s => Integer -> s-ksubset k = (set `ofSizeExactly` k) * set+ksubsets :: Species s => Integer -> s ksubsets = ksubset++-- | Simple graphs (undirected, without loops). A simple graph is a+-- subset of the set of all size-two subsets of the vertices: G = p+-- \@\@ p_2.+simpleGraphs, simpleGraph :: Species s => s+simpleGraph = subset @@ (ksubset 2)+simpleGraphs = simpleGraph++-- | A directed graph (with loops) is a subset of all pairs drawn+-- (without replacement) from the set of vertices: D = p \@\@ (e ><+-- e). It can also be thought of as the species of binary relations.+directedGraphs, directedGraph :: Species s => s+directedGraph = subset @@ (element >< element)+directedGraphs = directedGraph
Math/Combinatorics/Species/CycleIndex.hs view
@@ -1,13 +1,21 @@-{-# LANGUAGE NoImplicitPrelude +{-# LANGUAGE NoImplicitPrelude , FlexibleInstances #-} -- | An instance of 'Species' for cycle index series. For details on -- cycle index series, see \"Combinatorial Species and Tree-Like -- Structures\", chapter 1.-module Math.Combinatorics.Species.CycleIndex +module Math.Combinatorics.Species.CycleIndex ( zToEGF , zToGF++ , zCoeff+ , zFix++ -- * Miscellaneous+ , aut+ , intPartitions+ , cyclePower ) where import Math.Combinatorics.Species.Types@@ -20,9 +28,11 @@ import qualified MathObj.FactoredRational as FQ import qualified Algebra.Ring as Ring+import qualified Algebra.ZeroTestable as ZeroTestable import qualified Data.Map as M-import Data.List (genericReplicate, genericDrop, groupBy, sort, intercalate)+import Data.List ( genericReplicate, genericDrop, groupBy, sort, intercalate, scanl+ , genericIndex) import Data.Function (on) import Control.Arrow ((&&&), first, second) @@ -37,39 +47,42 @@ o = liftCI2 MVP.compose + cartesian = liftCI2 . MVP.lift2 $ \x y -> hadamard x y++ fcomp = zFComp+ ofSize s p = (liftCI . MVP.lift1 $ filter (p . Monomial.pDegree)) s ofSizeExactly s n = (liftCI . MVP.lift1 $ ( takeWhile ((==n) . Monomial.pDegree) . dropWhile ((<n) . Monomial.pDegree))) s- - (CI (MVP.Cons (x:_))) .: (CI (MVP.Cons (y:ys))) = CI $ MVP.Cons (x:rest)- where rest | Monomial.pDegree y == 0 = ys- | otherwise = (y:ys)- -- | Convert an integer partition to the corresponding monomial in the -- cycle index series for the species of sets.-partToMonomial :: [(Integer, Integer)] -> Monomial.T Rational-partToMonomial js = Monomial.Cons (zCoeff js) (M.fromList js)+partToMonomial :: CycleType -> Monomial.T Rational+partToMonomial js = Monomial.Cons (ezCoeff js) (M.fromList js) --- | @'zCoeff' js@ is the coefficient of the corresponding monomial in+-- | @'ezCoeff' js@ is the coefficient of the corresponding monomial in -- the cycle index series for the species of sets.-zCoeff :: [(Integer, Integer)] -> Rational-zCoeff js = toRational $ 1 / aut js+ezCoeff :: CycleType -> Rational+ezCoeff js = toRational $ 1 / aut js -- | @aut js@ is is the number of automorphisms of a permutation with -- cycle type @js@ (i.e. a permutation which has @n@ cycles of size--- @i@ for each @(i,n)@ in @js@).-aut :: [(Integer, Integer)] -> FQ.T+-- @i@ for each @(i,n)@ in @js@). Another way to look at it is that+-- there are @n!/aut js@ permutations on n elements with cycle type+-- @js@. The result type is a @'FactoredRational.T'@.+aut :: CycleType -> FQ.T aut = product . map (\(b,e) -> FQ.factorial e * (fromInteger b)^e) -- | Generate all partitions of an integer. In particular, if @p@ is -- an element of the list output by @intPartitions n@, then @sum--- . map (uncurry (*)) $ p == n@.+-- . map (uncurry (*)) $ p == n@. The result type is @[CycleType]@+-- since each integer partition of @n@ corresponds to the cycle type+-- of a permutation on @n@ elements. ----- Also, the partitions are generated in an order corresponding to+-- The partitions are generated in an order corresponding to -- the Ord instance for 'Monomial'.-intPartitions :: Integer -> [[(Integer, Integer)]]+intPartitions :: Integer -> [CycleType] intPartitions n = intPartitions' n n where intPartitions' :: Integer -> Integer -> [[(Integer,Integer)]] intPartitions' 0 _ = [[]]@@ -117,7 +130,116 @@ insertZeros = insertZeros' [0..] where insertZeros' _ [] = []- insertZeros' (n:ns) ((pow,c):pcs) - | n < pow = genericReplicate (pow - n) 0 + insertZeros' (n:ns) ((pow,c):pcs)+ | n < pow = genericReplicate (pow - n) 0 ++ insertZeros' (genericDrop (pow - n) (n:ns)) ((pow,c):pcs) | otherwise = c : insertZeros' ns pcs++-- | Hadamard product.+hadamard :: (Ring.C a, ZeroTestable.C a) => [Monomial.T a] -> [Monomial.T a] -> [Monomial.T a]+hadamard = MVP.merge False zap+ where zap m1 m2 = Monomial.Cons (Monomial.coeff m1 * Monomial.coeff m2 *+ (fromInteger . toInteger . aut . M.assocs . Monomial.powers $ m1))+ (Monomial.powers m1)++-- | @cyclePower s n@ computes the cycle type of sigma^n, where sigma+-- is any permutation of cycle type s.+--+-- In particular, if s = (s_1, s_2, s_3, ...) (i.e. sigma has s_1+-- fixed points, s_2 2-cycles, ... s_k k-cycles), then+--+-- sigma^n_j = sum_{j*gcd(n,k) = k} gcd(n,k)*s_k+cyclePower :: CycleType -> Integer -> CycleType+cyclePower [] _ = []+cyclePower s n = concatMap jCycles [1..maximum (map fst s)]+ where jCycles j = let snj = sum . map (\(k,sk) -> if j*gcd n k == k then gcd n k * sk else 0) $ s+ in [ (j, snj) | snj > 0 ]++-- | Extract a particular coefficient from a cycle index series.+zCoeff :: CycleIndex -> CycleType -> Rational+zCoeff (CI (MVP.Cons z)) ix = c+ where ixm = Monomial.mkMonomial 1 ix+ z' = dropWhile (<ixm) z+ c = case z' of+ [] -> 0+ (m:_) -> if (Monomial.powers m == Monomial.powers ixm)+ then Monomial.coeff m+ else 0++-- | Compute @fix F[n]@, i.e. the number of F-structures fixed by a+-- permutation with cycle type n, given the cycle index series Z_F.+--+-- In particular, @fix F[n] = aut(n) * zCoeff Z_F n@.+zFix :: CycleIndex -> CycleType -> Integer+zFix z n = numerator $ toRational (aut n) * zCoeff z n++-- | Functor composition for cycle index series. See BLL pp. 72--73.+--+-- We have+--+-- Z_F \@ Z_G = sum_{n>=0}+-- sum_{nn \in Par(n)}+-- 1/aut(nn) * fix F[(G[nn])_1, (G[nn])_2, ...]+-- * x_1^nn_1 x_2^nn_2 ...+--+-- where+--+-- (G[nn])_k = 1/k sum_{d|k} \mu(k/d) fix G[nn^d]+--+-- and we use (G[nn])_k to denote (G[sigma])_k, the number of+-- k-cycles in the image of sigma under G, where sigma has cycle+-- type nn. In fact, this only depends on the cycle type nn and not+-- on sigma, so the notation is well-defined.+--+-- How to know how far to compute G[nn]? We know that nn is a+-- permutation of n labels, so we can compute G(n) (by converting to+-- an egf) and keep computing elements of G[nn] until the partition+-- degree equals G(n).+zFComp :: CycleIndex -> CycleIndex -> CycleIndex+zFComp f g = ciFromMonomials $+ concat $ for [0..] $ \n ->+ for (intPartitions n) $ \nn ->+ Monomial.mkMonomial+ (toRational (1 / aut nn) * (zFix f (gnn nn n) % 1))+ nn++ where for = flip map++ -- Convert g to an EGF for later reference.+ gEGF = labelled $ zToEGF g++ -- Given a cycle type @nn@ (corresponding to a permutation+ -- sigma on @n@ elements), compute the cycle type of G[sigma],+ -- which we abbreviate G[nn] since it is determined by the+ -- cycle type.+ --+ -- We first use gnn' to compute an infinite list of (cycle+ -- size, count) pairs, then truncate it to the right length:+ -- we know how many G-structures there are on a set of size n,+ -- so we know we are looking for a permutation on that many+ -- elements.+ gnn :: CycleType -> Integer -> CycleType+ gnn [] _ = []+ gnn nn n = (gnn' nn) `truncToPartitionOf` (gEGF `genericIndex` n)++ -- Compute the image of a cycle type under G.+ gnn' :: CycleType -> CycleType+ gnn' nn = concat $ for [1..] $ \k -> let xk = gnnk nn k+ in [ (k,xk) | xk > 0 ]++ -- Compute (G[nn])_k for a particular k, that is, the number+ -- of cycles of size k in the image under G of any permutation+ -- with cycle type nn.+ gnnk :: CycleType -> Integer -> Integer+ gnnk nn k = (`div` k) . sum $+ for (FQ.divisors k') $ \d ->+ FQ.mu (k'/d) * zFix g (cyclePower nn (toInteger d))+ where k' = fromIntegral k++ truncToPartitionOf :: CycleType -> Integer -> CycleType+ truncToPartitionOf _ 0 = []+ truncToPartitionOf p n = map snd $ takeUntil ((>=n) . fst) partials+ where partials = zip (tail $ scanl (\soFar cyc -> soFar + uncurry (*) cyc) 0 p) p+ takeUntil p [] = []+ takeUntil p (x:xs) | p x = [x]+ | otherwise = x : takeUntil p xs
Math/Combinatorics/Species/Generate.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE NoImplicitPrelude +{-# LANGUAGE NoImplicitPrelude , GADTs , MultiParamTypeClasses , FlexibleInstances , FlexibleContexts+ , ScopedTypeVariables #-} -- | Generation of species: given a species and an underlying set of@@ -12,64 +13,85 @@ ( generateF , Structure(..) , generate+ , generateTyped+ , structureType ) where import Math.Combinatorics.Species.Class import Math.Combinatorics.Species.Types-import Math.Combinatorics.Species.Algebra+import Math.Combinatorics.Species.AST+import Math.Combinatorics.Species.CycleIndex (intPartitions) import Control.Arrow (first, second)-import Data.List (genericLength)+import Data.List (genericLength, genericReplicate) +import Data.Typeable+ import NumericPrelude import PreludeBase hiding (cycle) -- | Given an AST describing a species, with a phantom type parameter -- describing the species at the type level, and an underlying set, -- generate a list of all possible structures built over the--- underlying set. Of course, the type of the output list is a+-- underlying set; the type of the output list is a -- function of the species structure. (Of course, it would be -- really nice to have a real dependently-typed language for this!) ----- Unfortunately, 'SpeciesAlgT' cannot be made an instance of+-- Unfortunately, 'SpeciesTypedAST' cannot be made an instance of -- 'Species', so if we want to be able to generate structures given -- an expression of the 'Species' DSL as input, we must take--- 'SpeciesAlg' as input, which existentially wraps the phantom+-- 'SpeciesAST' as input, which existentially wraps the phantom -- structure type---but this means that the output list type must be--- existentially quantified as well; see 'generate' below.-generateF :: SpeciesAlgT s -> [a] -> [StructureF s a]-generateF O _ = []-generateF I [] = [Const 1]-generateF I _ = []-generateF X [x] = [Identity x]-generateF X _ = []-generateF (f :+: g) xs = map (Sum . Left ) (generateF f xs) - ++ map (Sum . Right) (generateF g xs)-generateF (f :*: g) xs = [ Prod (x, y) | (s1,s2) <- pSet xs- , x <- generateF f s1- , y <- generateF g s2- ]-generateF (f :.: g) xs = [ Comp y | p <- sPartitions xs- , xs <- mapM (generateF g) p- , y <- generateF f xs- ]-generateF (Der f) xs = map Comp $ generateF f (Star : map Original xs)-generateF E xs = [xs]-generateF C [] = []-generateF C (x:xs) = map (Cycle . (x:)) (sPermutations xs)+-- existentially quantified as well; see 'generate' and+-- 'generateTyped' below.+generateF :: SpeciesTypedAST s -> [a] -> [StructureF s a]+generateF O _ = []+generateF I [] = [Const 1]+generateF I _ = []+generateF X [x] = [Identity x]+generateF X _ = []+generateF E xs = [Set xs]+generateF C [] = []+generateF C (x:xs) = map (Cycle . (x:)) (sPermutations xs)+generateF Subset xs = map (Set . fst) (pSet xs)+generateF (KSubset k) xs = map Set (sKSubsets k xs)+generateF Elt xs = map Identity xs+generateF (f :+: g) xs = map (Sum . Left ) (generateF f xs)+ ++ map (Sum . Right) (generateF g xs)+generateF (f :*: g) xs = [ Prod (x, y) | (s1,s2) <- pSet xs+ , x <- generateF f s1+ , y <- generateF g s2+ ]+generateF (f :.: g) xs = [ Comp y | p <- sPartitions xs+ , xs <- mapM (generateF g) p+ , y <- generateF f xs+ ]+generateF (f :><: g) xs = [ Prod (x,y) | x <- generateF f xs+ , y <- generateF g xs ]+generateF (f :@: g) xs = map Comp $ generateF f (generateF g xs)+generateF (Der f) xs = map Comp $ generateF f (Star : map Original xs)+ generateF (OfSize f p) xs | p (genericLength xs) = generateF f xs | otherwise = [] generateF (OfSizeExactly f n) xs | genericLength xs == n = generateF f xs | otherwise = []+generateF (NonEmpty f) [] = []+generateF (NonEmpty f) xs = generateF f xs -- | @pSet xs@ generates the power set of @xs@, yielding a list of -- subsets of @xs@ paired with their complements. pSet :: [a] -> [([a],[a])] pSet [] = [([],[])]-pSet (x:xs) = mapx first ++ mapx second +pSet (x:xs) = mapx first ++ mapx second where mapx which = map (which (x:)) $ pSet xs +-- | @sKSubsets k xs@ generate all the size-k subsets of @xs@.+sKSubsets :: Integer -> [a] -> [[a]]+sKSubsets 0 _ = [[]]+sKSubsets _ [] = []+sKSubsets n (x:xs) = map (x:) (sKSubsets (n-1) xs) ++ sKSubsets n xs+ -- | Generate all partitions of a set. sPartitions :: [a] -> [[[a]]] sPartitions [] = [[]]@@ -90,37 +112,129 @@ select [] = [] select (x:xs) = (x,xs) : map (second (x:)) (select xs) --- | An existential wrapper for structures. For now we just ensure--- that they are Showable; in a future version of the library I hope--- to be able to add a Typeable constraint as well, so that we can--- actually usefully recover the generated values if we know what--- type we are expecting.+-- | An existential wrapper for structures, ensuring that the+-- structure functor results in something Showable and Typeable (when+-- applied to a Showable and Typeable argument type). data Structure a where- Structure :: (ShowF f) => f a -> Structure a+ Structure :: (ShowF f, Typeable1 f, Functor f) => f a -> Structure a instance (Show a) => Show (Structure a) where show (Structure t) = showF t --- | We can generate structures from a 'SpeciesAlg' (which is an--- instance of 'Species') only if we existentially quantify over the--- output type. However, we have guaranteed that the structures--- will be Showable. For example:+instance Functor Structure where+ fmap f (Structure fa) = Structure (fmap f fa)++extractStructure :: (Typeable1 f, Typeable a) => Structure a -> Maybe (f a)+extractStructure (Structure s) = cast s++-- | @generate s ls@ generates a complete list of all s-structures+-- over the underlying set of labels @ls@. For example: -- -- > > generate octopi ([1,2,3] :: [Int])--- > [{{*,1,2,3}},{{*,1,3,2}},{{*,2,1,3}},{{*,2,3,1}},{{*,3,1,2}},{{*,3,2,1}},--- > {{*,1,2},{*,3}},{{*,2,1},{*,3}},{{*,1,3},{*,2}},{{*,3,1},{*,2}},{{*,1},--- > {*,2,3}},{{*,1},{*,3,2}},{{*,1},{*,2},{*,3}},{{*,1},{*,3},{*,2}}]+-- > [<<*,1,2,3>>,<<*,1,3,2>>,<<*,2,1,3>>,<<*,2,3,1>>,<<*,3,1,2>>,<<*,3,2,1>>,+-- > <<*,1,2>,<*,3>>,<<*,2,1>,<*,3>>,<<*,1,3>,<*,2>>,<<*,3,1>,<*,2>>,<<*,1>,+-- > <*,2,3>>,<<*,1>,<*,3,2>>,<<*,1>,<*,2>,<*,3>>,<<*,1>,<*,3>,<*,2>>]+-- >+-- > > generate subsets "abc"+-- > [{'a','b','c'},{'a','b'},{'a','c'},{'a'},{'b','c'},{'b'},{'c'},{}] ----- Of course, this is not the output we might hope for; octopi are--- cycles of lists, but above we are seeing the fact that lists are--- implemented as the derivative of cycles, so each list is--- represented by a cycle containing *. In a future version of this--- library I plan to implement a system for automatically converting--- between isomorphic structures during species generation.-generate :: SpeciesAlg -> [a] -> [Structure a]+-- > > generate simpleGraphs ([1,2,3] :: [Int])+-- > [{{1,2},{1,3},{2,3}},{{1,2},{1,3}},{{1,2},{2,3}},{{1,2}},{{1,3},{2,3}},+-- > {{1,3}},{{2,3}},{}]+--+-- There is one caveat: since the type of the generated structures+-- is different for each species, it must be existentially+-- quantified! The output of 'generate' can always be Shown, but+-- not much else.+--+-- However! All is not lost. It's possible, by the magic of+-- "Data.Typeable", to yank the type information (kicking and+-- screaming) back into the open, so that you can then manipulate+-- the generated structures to your heart's content. To see how,+-- consult 'structureType' and 'generateTyped'.+generate :: SpeciesAST -> [a] -> [Structure a] generate (SA s) xs = map Structure (generateF s xs) +-- | @generateTyped s ls@ generates a complete list of all s-structures+-- over the underlying set of labels @ls@, where the type of the+-- generated structures is known ('structureType' may be used to+-- compute this type). For example:+--+-- > > structureType subsets+-- > "Set"+-- > > generateTyped subsets ([1,2,3] :: [Int]) :: [Set Int]+-- > [{1,2,3},{1,2},{1,3},{1},{2,3},{2},{3},{}]+-- > > map (sum . getSet) $ it+-- > [6,3,4,1,5,2,3,0]+--+-- Although the output from 'generate' appears the same, trying to+-- compute the subset sums fails spectacularly if we use 'generate'+-- instead of 'generateTyped':+--+-- > > generate subsets ([1..3] :: [Int])+-- > [{1,2,3},{1,2},{1,3},{1},{2,3},{2},{3},{}]+-- > > map (sum . getSet) $ it+-- > <interactive>:1:21:+-- > Couldn't match expected type `Set a'+-- > against inferred type `Math.Combinatorics.Species.Generate.Structure+-- > Int'+-- > Expected type: [Set a]+-- > Inferred type: [Math.Combinatorics.Species.Generate.Structure Int]+-- > In the second argument of `($)', namely `it'+-- > In the expression: map (sum . getSet) $ it+-- +-- If we use the wrong type, we get a nice error message:+--+-- > > generateTyped octopi ([1..3] :: [Int]) :: [Set Int]+-- > *** Exception: structure type mismatch.+-- > Expected: Set Int+-- > Inferred: Comp Cycle (Comp Cycle Star) Int+generateTyped :: forall f a. (Typeable1 f, Typeable a) => SpeciesAST -> [a] -> [f a]+generateTyped s xs = + case (mapM extractStructure . generate s $ xs) of+ Nothing -> error $ + "structure type mismatch.\n"+ ++ " Expected: " ++ showStructureType (typeOf (undefined :: f a)) ++ "\n"+ ++ " Inferred: " ++ structureType s ++ " " ++ show (typeOf (undefined :: a))+ Just ys -> ys +-- | @'structureType' s@ returns a String representation of the+-- functor type which represents the structure of the species @s@.+-- In particular, if @structureType s@ prints @\"T\"@, then you can+-- safely use 'generateTyped' by writing+--+-- > generateTyped s ls :: [T L]+--+-- where @ls :: [L]@.+structureType :: SpeciesAST -> String+structureType (SA s) = showStructureType . extractType $ s+ where extractType :: forall s. Typeable1 (StructureF s) => SpeciesTypedAST s -> TypeRep+ extractType _ = typeOf1 (undefined :: StructureF s ())++-- | Show a TypeRep while stripping off qualifier portions of TyCon+-- names. This is essentially copied and pasted from the+-- Data.Typeable source, with a number of cases taken out that we+-- don't care about (special cases for (->), tuples, etc.).+showStructureType :: TypeRep -> String+showStructureType t = showsPrecST 0 t ""+ where showsPrecST :: Int -> TypeRep -> ShowS+ showsPrecST p t =+ case splitTyConApp t of+ (tycon, []) -> showString (dropQuals $ tyConString tycon)+ (tycon, args) -> showParen (p > 9)+ $ showString (dropQuals $ tyConString tycon)+ . showChar ' '+ . showArgsST args++ showArgsST :: [TypeRep] -> ShowS+ showArgsST [] = id+ showArgsST [t] = showsPrecST 10 t+ showArgsST (t:ts) = showsPrecST 10 t . showChar ' ' . showArgsST ts++ dropQuals :: String -> String+ dropQuals = reverse . takeWhile (/= '.') . reverse++ -- Experimental stuff below, automatically converting between -- isomorphic structures. --@@ -140,5 +254,48 @@ -- instance (Iso f1 f2, Iso g1 g2) => Iso (Prod f1 g1) (Prod f2 g2) where -- iso (Prod (x,y)) = Prod (iso x, iso y) --- generateFI :: (Iso (StructureF s) f) => SpeciesAlgT s -> [a] -> [f a]+-- generateFI :: (Iso (StructureF s) f) => SpeciesTypedAST s -> [a] -> [f a] -- generateFI s xs = map iso $ generateF s xs++++-- More old code below: a first try at *unlabelled* generation, but+-- it's not quite so easy---for exactly the same reasons that ordinary+-- generating function composition/derivative etc. don't correspond to+-- species operations.++-- | Given an AST describing a species, with a phantom type parameter+-- describing the species at the type level, and the size of the+-- underlying set, generate a list of all possible unlabelled+-- structures built by the species.+-- generateFU :: SpeciesTypedAST s -> Integer -> [StructureF s ()]+-- generateFU O _ = []+-- generateFU I 0 = [Const 1]+-- generateFU I _ = []+-- generateFU X 1 = [Identity ()]+-- generateFU X _ = []+-- generateFU (f :+: g) n = map (Sum . Left ) (generateFU f n)+-- ++ map (Sum . Right) (generateFU g n)+-- generateFU (f :*: g) n = [ Prod (x, y) | n1 <- [0..n]+-- , x <- generateFU f n1+-- , y <- generateFU g (n - n1)+-- ]+-- generateFU (f :.: g) n = [ Comp y | p <- intPartitions n+-- , xs <- mapM (generateFU g) $ expandPartition p+-- , y <- generateF f xs+-- ]+-- -- generateFU (Der f) n = map -- XXX how to do this?+-- generateFU E n = [Set $ genericReplicate n ()]+-- generateFU C 0 = []+-- generateFU C n = [Cycle $ genericReplicate n ()]+-- generateFU (OfSize f p) n | p n = generateFU f n+-- | otherwise = []+-- generateFU (OfSizeExactly f s) n | s == n = generateFU f n+-- | otherwise = []+-- generateFU (f :><: g) n = [ Prod (x,y) | x <- generateFU f n+-- , y <- generateFU g n+-- ]++-- expandPartition :: [(Integer, Integer)] -> [Integer]+-- expandPartition = concatMap (uncurry (flip genericReplicate))+
Math/Combinatorics/Species/Labelled.hs view
@@ -12,6 +12,7 @@ import Math.Combinatorics.Species.Class import qualified MathObj.PowerSeries as PS+import qualified MathObj.FactoredRational as FQ import NumericPrelude import PreludeBase hiding (cycle)@@ -24,11 +25,18 @@ set = egfFromCoeffs (map (LR . (1%)) facts) cycle = egfFromCoeffs (0 : map (LR . (1%)) [1..]) o = liftEGF2 PS.compose+ cartesian = liftEGF2 . PS.lift2 $ \xs ys -> zipWith3 mult xs ys (map fromIntegral facts)+ where mult x y z = x * y * z+ fcomp = liftEGF2 . PS.lift2 $ \fs gs -> map (\(n,gn) -> let gn' = numerator . unLR $ gn + in (fs `safeIndex` gn') + * LR (toRational (FQ.factorial gn' / FQ.factorial n)))+ (zip [0..] $ zipWith (*) (map fromIntegral facts) gs)+ where safeIndex [] _ = 0+ safeIndex (x:_) 0 = x+ safeIndex (_:xs) n = safeIndex xs (n-1)+ ofSize s p = (liftEGF . PS.lift1 $ filterCoeffs p) s ofSizeExactly s n = (liftEGF . PS.lift1 $ selectIndex n) s-- (EGF (PS.Cons (x:_))) .: EGF (PS.Cons ~(_:xs))- = EGF (PS.Cons (x:xs)) -- | Extract the coefficients of an exponential generating function as -- a list of Integers. Since 'EGF' is an instance of
Math/Combinatorics/Species/Types.hs view
@@ -4,13 +4,19 @@ , TypeOperators , FlexibleContexts , GeneralizedNewtypeDeriving+ , DeriveDataTypeable #-} --- | Some common types used by the species library.+-- | Some common types used by the species library, along with some+-- utility functions. module Math.Combinatorics.Species.Types- ( -- * Lazy multiplication- - LazyRing(..)+ ( -- * Miscellaneous++ CycleType++ -- * Lazy multiplication++ , LazyRing(..) , LazyQ , LazyZ @@ -48,12 +54,13 @@ , Prod(..) , Comp(..) , Cycle(..)+ , Set(..) , Star(..) -- * Type-level species- -- $typespecies - - , Z, S, X, (:+:), (:*:), (:.:), Der, E, C, NonEmpty+ -- $typespecies++ , Z, S, X, E, C, Sub, Elt, (:+:), (:*:), (:.:), (:><:), (:@:), Der , StructureF ) where @@ -73,6 +80,13 @@ import Data.Lub (parCommute, HasLub(..), flatLub) +import Data.Typeable++-- | A representation of the cycle type of a permutation. If @c ::+-- CycleType@ and @(k,n) `elem` c@, then the permutation has @n@+-- cycles of size @k@.+type CycleType = [(Integer, Integer)]+ -------------------------------------------------------------------------------- -- Lazy multiplication ------------------------------------------------------- --------------------------------------------------------------------------------@@ -113,7 +127,7 @@ liftEGF :: (PS.T LazyQ -> PS.T LazyQ) -> EGF -> EGF liftEGF f (EGF x) = EGF (f x) -liftEGF2 :: (PS.T LazyQ -> PS.T LazyQ -> PS.T LazyQ) +liftEGF2 :: (PS.T LazyQ -> PS.T LazyQ -> PS.T LazyQ) -> EGF -> EGF -> EGF liftEGF2 f (EGF x) (EGF y) = EGF (f x y) @@ -127,7 +141,7 @@ liftGF :: (PS.T Integer -> PS.T Integer) -> GF -> GF liftGF f (GF x) = GF (f x) -liftGF2 :: (PS.T Integer -> PS.T Integer -> PS.T Integer) +liftGF2 :: (PS.T Integer -> PS.T Integer -> PS.T Integer) -> GF -> GF -> GF liftGF2 f (GF x) (GF y) = GF (f x y) @@ -193,7 +207,10 @@ -------------------------------------------------------------------------------- -- $struct--- Functors used in building up structures for species generation.+-- Functors used in building up structures for species+-- generation. Many of these functors are already defined elsewhere,+-- in other packages; but to avoid a plethora of imports, inconsistent+-- naming/instance schemes, etc., we just redefine them here. -- | The constant functor. newtype Const x a = Const x@@ -203,9 +220,14 @@ show (Const x) = show x instance (Show x) => ShowF (Const x) where showF = show+instance Typeable2 Const where+ typeOf2 _ = mkTyConApp (mkTyCon "Const") []+instance Typeable x => Typeable1 (Const x) where+ typeOf1 = typeOf1Default -- | The identity functor. newtype Identity a = Identity a+ deriving Typeable instance Functor Identity where fmap f (Identity x) = Identity (f x) instance (Show a) => Show (Identity a) where@@ -219,10 +241,17 @@ fmap f (Sum (Left fa)) = Sum (Left (fmap f fa)) fmap f (Sum (Right ga)) = Sum (Right (fmap f ga)) instance (Show (f a), Show (g a)) => Show (Sum f g a) where- show (Sum x) = show x+ show (Sum (Left fa)) = "inl(" ++ show fa ++ ")"+ show (Sum (Right ga)) = "inr(" ++ show ga ++ ")" instance (ShowF f, ShowF g) => ShowF (Sum f g) where showF (Sum (Left fa)) = "inl(" ++ showF fa ++ ")" showF (Sum (Right ga)) = "inr(" ++ showF 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+ getF = undefined+ getG :: Sum f g a -> g a+ getG = undefined -- | Functor product. newtype Prod f g a = Prod { unProd :: (f a, g a) }@@ -232,6 +261,12 @@ show (Prod x) = show x instance (ShowF f, ShowF g) => ShowF (Prod f g) where showF (Prod (fa, ga)) = "(" ++ showF fa ++ "," ++ showF ga ++ ")"+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+ getF = undefined+ getG :: Prod f g a -> g a+ getG = undefined -- | Functor composition. data Comp f g a = Comp { unComp :: (f (g a)) }@@ -241,21 +276,37 @@ show (Comp x) = show x instance (ShowF f, ShowF g) => ShowF (Comp f g) where showF (Comp fga) = showF (fmap (RawString . showF) fga)+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+ getF = undefined+ getG :: Comp f g a -> g a+ getG = undefined -- | Cycle structure. A value of type 'Cycle a' is implemented as -- '[a]', but thought of as a directed cycle.-newtype Cycle a = Cycle [a]-instance Functor Cycle where- fmap f (Cycle xs) = Cycle (fmap f xs)+newtype Cycle a = Cycle { getCycle :: [a] }+ deriving (Functor, Typeable) instance (Show a) => Show (Cycle a) where- show (Cycle xs) = "{" ++ intercalate "," (map show xs) ++ "}"+ show (Cycle xs) = "<" ++ intercalate "," (map show xs) ++ ">" instance ShowF Cycle where showF = show ++-- | Set structure. A value of type 'Set a' is implemented as '[a]',+-- but thought of as an unordered set.+newtype Set a = Set { getSet :: [a] }+ deriving (Functor, Typeable)+instance (Show a) => Show (Set a) where+ show (Set xs) = "{" ++ intercalate "," (map show xs) ++ "}"+instance ShowF Set where+ showF = show+ -- | 'Star' is isomorphic to 'Maybe', but with a more useful 'Show' -- instance for our purposes. Used to implement species -- differentiation. data Star a = Star | Original a+ deriving (Typeable) instance Functor Star where fmap _ Star = Star fmap f (Original a) = Original (f a)@@ -270,21 +321,24 @@ -------------------------------------------------------------------------------- -- $typespecies--- Some constructor-less data types used as indices to 'SpeciesAlgT'--- to reflect the species structure at the type level. This is the--- point at which we wish we were doing this in a dependently typed--- language.+-- Some constructor-less data types used as indices to+-- 'SpeciesTypedAST' to reflect the species structure at the type+-- level. This is the point at which we wish we were doing this in a+-- dependently typed language. data Z data S n data X+data E+data C+data Sub+data Elt data (:+:) f g data (:*:) f g data (:.:) f g+data (:><:) f g+data (:@:) f g data Der f-data E-data C-data NonEmpty f -- | 'StructureF' is a type function which maps type-level species -- descriptions to structure functors. That is, a structure of the@@ -294,11 +348,14 @@ type instance StructureF Z = Const Integer type instance StructureF (S s) = Const Integer type instance StructureF X = Identity+type instance StructureF E = Set+type instance StructureF C = Cycle+type instance StructureF Sub = Set+type instance StructureF Elt = Identity type instance StructureF (f :+: g) = Sum (StructureF f) (StructureF g) type instance StructureF (f :*: g) = Prod (StructureF f) (StructureF g) type instance StructureF (f :.: g) = Comp (StructureF f) (StructureF g)+type instance StructureF (f :><: g) = Prod (StructureF f) (StructureF g)+type instance StructureF (f :@: g) = Comp (StructureF f) (StructureF g) type instance StructureF (Der f) = Comp (StructureF f) Star-type instance StructureF E = []-type instance StructureF C = Cycle-type instance StructureF (NonEmpty f) = StructureF f
Math/Combinatorics/Species/Unlabelled.hs view
@@ -5,7 +5,7 @@ import Math.Combinatorics.Species.Types import Math.Combinatorics.Species.Class-import Math.Combinatorics.Species.Algebra+import Math.Combinatorics.Species.AST import Math.Combinatorics.Species.CycleIndex import qualified MathObj.PowerSeries as PS@@ -15,20 +15,22 @@ import NumericPrelude import PreludeBase hiding (cycle) +needsCI :: String -> a+needsCI op = error ("unlabelled " ++ op ++ " must go via cycle index series.")+ instance Differential.C GF where- differentiate = error "unlabelled differentiation must go via cycle index series."+ differentiate = needsCI "differentiation" instance Species GF where singleton = gfFromCoeffs [0,1] set = gfFromCoeffs (repeat 1) cycle = set- o = error "unlabelled composition must go via cycle index series."+ o = needsCI "composition"+ cartesian = needsCI "cartesian product"+ fcomp = needsCI "functor composition" ofSize s p = (liftGF . PS.lift1 $ filterCoeffs p) s ofSizeExactly s n = (liftGF . PS.lift1 $ selectIndex n) s - (GF (PS.Cons (x:_))) .: GF (PS.Cons xs)- = GF (PS.Cons (x:tail xs))- unlabelledCoeffs :: GF -> [Integer] unlabelledCoeffs (GF p) = PS.coeffs p @@ -44,19 +46,19 @@ -- -- Actually, the above is something of a white lie, as you may have -- already realized by looking at the input type of 'unlabelled',--- which is 'SpeciesAlg' rather than the expected 'GF'. The--- reason is that although products and sums of unlabelled species+-- which is 'SpeciesAST' rather than the expected 'GF'. The reason+-- is that although products and sums of unlabelled species -- correspond to products and sums of ordinary generating functions,--- composition and differentiation do not! In order to compute an--- ordinary generating function for a species defined in terms of--- composition and/or differentiation, we must compute the cycle--- index series for the species and then convert it to an ordinary--- generating function. So 'unlabelled' actually works by first--- reifying the species to an AST and checking whether it uses--- composition or differentiation, and using operations on cycle--- index series if it does, and (much faster) operations directly on--- ordinary generating functions otherwise.-unlabelled :: SpeciesAlg -> [Integer]+-- other operations such as composition and differentiation do not!+-- In order to compute an ordinary generating function for a species+-- defined in terms of composition and/or differentiation, we must+-- compute the cycle index series for the species and then convert+-- it to an ordinary generating function. So 'unlabelled' actually+-- works by first reifying the species to an AST and checking which+-- operations are used in its definition, and then choosing to work+-- with cycle index series or directly with (much faster) ordinary+-- generating functions as appropriate.+unlabelled :: SpeciesAST -> [Integer] unlabelled s - | needsZ s = unlabelledCoeffs . zToGF . reflect $ s- | otherwise = unlabelledCoeffs . reflect $ s+ | needsZ s = unlabelledCoeffs . zToGF . reflect $ s+ | otherwise = unlabelledCoeffs . reflect $ s
species.cabal view
@@ -1,5 +1,5 @@ name: species-version: 0.1+version: 0.2 license: BSD3 license-file: LICENSE build-type: Simple@@ -8,15 +8,15 @@ author: Brent Yorgey maintainer: Brent Yorgey <byorgey@cis.upenn.edu> category: Math-synopsis: Combinatorial species library+synopsis: Computational combinatorial species -description: A DSL for describing combinatorial species, along with a number- of ways to interpret it, to e.g. count labelled or unlabelled - species, or generate species elements.+description: A DSL for describing and computing with combinatorial species,+ e.g. counting labelled or unlabelled structures, or generating+ a list of all labeled structures for a species. Library build-depends: base >= 3.0 && < 4.2, numeric-prelude >= 0.1.1 && < 0.2,- np-extras >= 0.1 && < 0.2, containers >= 0.2 && < 0.3,+ np-extras >= 0.2 && < 0.3, containers >= 0.2 && < 0.3, lub >= 0.0.5 && < 0.1 exposed-modules: Math.Combinatorics.Species@@ -25,6 +25,6 @@ Math.Combinatorics.Species.Labelled Math.Combinatorics.Species.Unlabelled Math.Combinatorics.Species.CycleIndex- Math.Combinatorics.Species.Algebra+ Math.Combinatorics.Species.AST Math.Combinatorics.Species.Generate extensions: NoImplicitPrelude