packages feed

species (empty) → 0.1

raw patch · 11 files changed

+1137/−0 lines, 11 filesdep +basedep +containersdep +lubsetup-changed

Dependencies added: base, containers, lub, np-extras, numeric-prelude

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Brent Yorgey 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of other contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Math/Combinatorics/Species.hs view
@@ -0,0 +1,53 @@+{-# 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.+--+--   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.+module Math.Combinatorics.Species+    ( -- * The combinatorial species DSL+      Species(..)++      -- ** Convenience methods+    , oneHole+    , madeOf+    , x, e, sets, cycles+          +      -- ** Derived operations+    , pointed+    , nonEmpty++      -- ** Derived species+    , list, lists+    , element, elements+    , octopus, octopi+    , partition, partitions+    , permutation, permutations+    , subset, subsets+    , ballot, ballots+    , ksubset, ksubsets            ++      -- * Computing with species+    , labelled+    , unlabelled+    , generate++    ) where++import Math.Combinatorics.Species.Class+import Math.Combinatorics.Species.Labelled+import Math.Combinatorics.Species.Unlabelled+import Math.Combinatorics.Species.Generate+  +
+ Math/Combinatorics/Species/Algebra.hs view
@@ -0,0 +1,142 @@+{-# 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
@@ -0,0 +1,185 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | The Species type class, which defines a small DSL for describing+--   combinatorial species.  Other modules in this library provide+--   specific instances which allow computing various properties of+--   combinatorial species.+module Math.Combinatorics.Species.Class+    (+      -- * The Species type class+      Species(..)++      -- * Convenience methods+      -- $synonyms++    , oneHole+    , madeOf+    , x+    , e+    , sets+    , cycles++      -- * 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++    ) where++import qualified Algebra.Differential as Differential++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"+--   (the species 0 and species addition, i.e. disjoint sum),+--   "Algebra.Ring" (the species 1 and species multiplication,+--   i.e. partitional product), and "Algebra.Differential" (species+--   differentiation, i.e. adjoining a distinguished element).+--+--   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@.+class (Differential.C s) => Species s where++  -- | The species X of singletons+  singleton :: s++  -- | The species E of sets+  set       :: s++  -- | The species C of cyclical orderings (cycles/rings)+  cycle     :: s++  -- | Partitional composition+  o         :: 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.+  ofSizeExactly :: s -> Integer -> s++  -- | @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++-- $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@.++-- | 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.+oneHole :: (Species s) => s -> s+oneHole = Differential.differentiate++-- | A synonym for 'o' (partitional composition).+madeOf :: Species s => s -> s -> s+madeOf = o++-- | 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++cycles :: Species s => s+cycles     = cycle++-- $derived_ops+-- Some derived operations on species.++-- | Combinatorially, the operation of pointing picks out a+--   distinguished element from an underlying set.  It is equivalent+--   to the operator @x d/dx@.+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.++-- | The species L of linear orderings (lists): since lists are+--   isomorphic to cycles with a hole, we may take L = C'.+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 = element++-- | An octopus is a cyclic arrangement of lists, so called because+--   the lists look like \"tentacles\" attached to the cyclic+--   \"body\": Oct = C o E+ .+octopi, octopus :: Species s => s+octopus = cycle `o` nonEmpty lists+octopi  = octopus++-- | The species of set partitions is just the composition E o E+,+--   that is, sets of nonempty sets.+partitions, partition :: Species s => s+partition  = set `o` nonEmpty sets+partitions = partition++-- | A permutation is a set of disjoint cycles: S = E o C.+permutations, permutation :: Species s => s+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 = subset++-- | The species Bal of ballots consists of linear orderings of+--   nonempty sets: Bal = L o E+.+ballots, ballot :: Species s => s+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 = ksubset
+ Math/Combinatorics/Species/CycleIndex.hs view
@@ -0,0 +1,123 @@+{-# 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 +    ( zToEGF+    , zToGF+    ) where++import Math.Combinatorics.Species.Types+import Math.Combinatorics.Species.Class+import Math.Combinatorics.Species.Labelled++import qualified MathObj.PowerSeries as PowerSeries+import qualified MathObj.MultiVarPolynomial as MVP+import qualified MathObj.Monomial as Monomial+import qualified MathObj.FactoredRational as FQ++import qualified Algebra.Ring as Ring++import qualified Data.Map as M+import Data.List (genericReplicate, genericDrop, groupBy, sort, intercalate)+import Data.Function (on)+import Control.Arrow ((&&&), first, second)++import NumericPrelude+import PreludeBase hiding (cycle)++instance Species CycleIndex where+  singleton = CI $ MVP.x 1+  set       = ciFromMonomials . map partToMonomial . concatMap intPartitions $ [0..]++  cycle     = ciFromMonomials . concatMap cycleMonomials $ [1..]++  o = liftCI2 MVP.compose++  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)++-- | @'zCoeff' 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++-- | @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+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@.+--+--   Also, the partitions are generated in an order corresponding to+--   the Ord instance for 'Monomial'.+intPartitions :: Integer -> [[(Integer, Integer)]]+intPartitions n = intPartitions' n n+  where intPartitions' :: Integer -> Integer -> [[(Integer,Integer)]]+        intPartitions' 0 _ = [[]]+        intPartitions' n 0 = []+        intPartitions' n k =+          [ if (j == 0) then js else (k,j):js+            | j <- reverse [0..n `div` k]+            , js <- intPartitions' (n - j*k) (min (k-1) (n - j*k)) ]++-- | @cycleMonomials d@ generates all monomials of partition degree+--   @d@ in the cycle index series for the species C of cycles.+cycleMonomials :: Integer -> [Monomial.T Rational]+cycleMonomials n = map cycleMonomial ds+  where n' = fromIntegral n+        ds = sort . FQ.divisors $ n'+        cycleMonomial d = Monomial.Cons (FQ.eulerPhi (n' / d) % n)+                                        (M.singleton (n `div` (toInteger d)) (toInteger d))++-- | Convert a cycle index series to an exponential generating+--   function:  F(x) = Z_F(x,0,0,0,...).+zToEGF :: CycleIndex -> EGF+zToEGF (CI (MVP.Cons xs))+  = EGF . PowerSeries.fromCoeffs . map LR+  . insertZeros+  . concatMap (\(c,as) -> case as of { [] -> [(0,c)] ; [(1,p)] -> [(p,c)] ; _ -> [] })+  . map (Monomial.coeff &&& (M.assocs . Monomial.powers))+  $ xs++-- | Convert a cycle index series to an ordinary generating function:+--   F~(x) = Z_F(x,x^2,x^3,...).+zToGF :: CycleIndex -> GF+zToGF (CI (MVP.Cons xs))+  = GF . PowerSeries.fromCoeffs . map numerator+  . insertZeros+  . map ((fst . head) &&& (sum . map snd))+  . groupBy ((==) `on` fst)+  . map ((sum . map (uncurry (*)) . M.assocs . Monomial.powers) &&& Monomial.coeff)+  $ xs++-- | Since cycle index series use a sparse representation, not every+--   power of x may be present after converting to an ordinary or+--   exponential generating function; 'insertZeros' inserts+--   coefficients of zero where necessary.+insertZeros :: Ring.C a => [(Integer, a)] -> [a]+insertZeros = insertZeros' [0..]+  where+    insertZeros' _ [] = []+    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
+ Math/Combinatorics/Species/Generate.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE NoImplicitPrelude +           , GADTs+           , MultiParamTypeClasses+           , FlexibleInstances+           , FlexibleContexts+  #-}++-- | Generation of species: given a species and an underlying set of+--   labels, generate a list of all structures built from the+--   underlying set.+module Math.Combinatorics.Species.Generate+    ( generateF+    , Structure(..)+    , generate++    ) where++import Math.Combinatorics.Species.Class+import Math.Combinatorics.Species.Types+import Math.Combinatorics.Species.Algebra++import Control.Arrow (first, second)+import Data.List (genericLength)++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+--   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+--   '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+--   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)+generateF (OfSize f p) xs | p (genericLength xs) = generateF f xs+                          | otherwise     = []+generateF (OfSizeExactly f n) xs | genericLength xs == n = generateF f xs+                                 | otherwise = []++-- | @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 +  where mapx which = map (which (x:)) $ pSet xs++-- | Generate all partitions of a set.+sPartitions :: [a] -> [[[a]]]+sPartitions [] = [[]]+sPartitions (s:s') = do (sub,compl) <- pSet s'+                        let firstSubset = s:sub+                        map (firstSubset:) $ sPartitions compl++-- | Generate all permutations of a list.+sPermutations :: [a] -> [[a]]+sPermutations [] = [[]]+sPermutations xs = [ y:p | (y,ys) <- select xs+                         , p      <- sPermutations ys+                  ]++-- | Select each element of a list in turn, yielding a list of+--   elements, each paired with a list of the remaining elements.+select :: [a] -> [(a,[a])]+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.+data Structure a where+  Structure :: (ShowF 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:+--+-- > > 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}}]+--+-- 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 (SA s) xs = map Structure (generateF s xs)+++-- Experimental stuff below, automatically converting between+-- isomorphic structures.+--+-- class Iso f g where+--   iso :: f a -> g a++-- instance Iso (Comp Cycle Star) [] where+--   iso (Comp (Cycle (_:xs))) = map (\(Original x) -> x) xs++-- instance (Iso f g, Functor h) => Iso (Comp h f) (Comp h g) where+--   iso (Comp h) = Comp (fmap iso h)++-- instance (Iso f1 f2, Iso g1 g2) => Iso (Sum f1 g1) (Sum f2 g2) where+--   iso (Sum (Left x)) = Sum (Left (iso x))+--   iso (Sum (Right x)) = Sum (Right (iso x))++-- 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 s xs = map iso $ generateF s xs
+ Math/Combinatorics/Species/Labelled.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude +           , GeneralizedNewtypeDeriving+           , PatternGuards+  #-}+-- | An interpretation of species as exponential generating functions,+--   which count labelled structures.+module Math.Combinatorics.Species.Labelled +    ( labelled+    ) where++import Math.Combinatorics.Species.Types+import Math.Combinatorics.Species.Class++import qualified MathObj.PowerSeries as PS++import NumericPrelude+import PreludeBase hiding (cycle)++facts :: [Integer]+facts = 1 : zipWith (*) [1..] facts++instance Species EGF where+  singleton         = egfFromCoeffs [0,1]+  set               = egfFromCoeffs (map (LR . (1%)) facts)+  cycle             = egfFromCoeffs (0 : map (LR . (1%)) [1..])+  o                 = liftEGF2 PS.compose+  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+--   'Species', the idea is that 'labelled' can be applied directly to+--   an expression of the Species DSL.  In particular, @labelled s !!+--   n@ is the number of labelled s-structures on an underlying set of+--   size n.  For example:+--+-- > > take 10 $ labelled octopi+-- > [0,1,3,14,90,744,7560,91440,1285200,20603520]+--+--   gives the number of labelled octopi on 0, 1, 2, 3, ... 9 elements.++labelled :: EGF -> [Integer]+labelled (EGF f) = map numerator . zipWith (*) (map fromInteger facts) . map unLR +                 $ PS.coeffs f++-- A previous version of this module used an EGF library which+-- explicitly computed with EGF's.  However, it turned out to be much+-- slower than just computing explicitly with normal power series and+-- zipping/unzipping with factorial denominators as necessary, which+-- is the current approach.+--+-- instance Species (EGF.T Integer) where+--   singleton = EGF.fromCoeffs [0,1]+--   set       = EGF.fromCoeffs $ repeat 1+--   list      = EGF.fromCoeffs facts+--   o         = EGF.compose+--   nonEmpty  (EGF.Cons (_:xs)) = EGF.Cons (0:xs)+--   nonEmpty  x = x+--+-- labelled :: EGF.T Integer -> [Integer]+-- labelled = EGF.coeffs+--
+ Math/Combinatorics/Species/Types.hs view
@@ -0,0 +1,304 @@+{-# LANGUAGE NoImplicitPrelude+           , EmptyDataDecls+           , TypeFamilies+           , TypeOperators+           , FlexibleContexts+           , GeneralizedNewtypeDeriving+  #-}++-- | Some common types used by the species library.+module Math.Combinatorics.Species.Types+    ( -- * Lazy multiplication+      +      LazyRing(..)+    , LazyQ+    , LazyZ++      -- * Series types++    , EGF(..)+    , egfFromCoeffs+    , liftEGF+    , liftEGF2++    , GF(..)+    , gfFromCoeffs+    , liftGF+    , liftGF2++    , CycleIndex(..)+    , ciFromMonomials+    , liftCI+    , liftCI2++    , filterCoeffs+    , selectIndex++      -- * Higher-order Show++    , ShowF(..)+    , RawString(..)++      -- * Structure functors+      -- $struct++    , Const(..)+    , Identity(..)+    , Sum(..)+    , Prod(..)+    , Comp(..)+    , Cycle(..)+    , Star(..)++      -- * Type-level species+      -- $typespecies    +      +    , Z, S, X, (:+:), (:*:), (:.:), Der, E, C, NonEmpty+    , StructureF+    ) where++import Data.List (intercalate, genericReplicate)+import NumericPrelude+import PreludeBase++import qualified MathObj.PowerSeries as PS+import qualified MathObj.MultiVarPolynomial as MVP+import qualified MathObj.Monomial as Monomial++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import qualified Algebra.Differential as Differential+import qualified Algebra.ZeroTestable as ZeroTestable+import qualified Algebra.Field as Field++import Data.Lub (parCommute, HasLub(..), flatLub)++--------------------------------------------------------------------------------+--  Lazy multiplication  -------------------------------------------------------+--------------------------------------------------------------------------------++-- | If @T@ is an instance of @Ring@, then @LazyRing T@ is isomorphic+--   to T but with a lazy multiplication: @0 * undefined = undefined * 0+--   = 0@.+newtype LazyRing a = LR { unLR :: a }+  deriving (Eq, Ord, Additive.C, ZeroTestable.C, Field.C)++instance HasLub (LazyRing a) where+  lub = flatLub++instance Show a => Show (LazyRing a) where+  show (LR r) = show r++instance (Eq a, Ring.C a) => Ring.C (LazyRing a) where+  (*) = parCommute lazyTimes+    where lazyTimes (LR 0) _ = LR 0+          lazyTimes (LR 1) x = x+          lazyTimes (LR a) (LR b) = LR (a*b)+  fromInteger = LR . fromInteger++type LazyQ = LazyRing Rational+type LazyZ = LazyRing Integer++--------------------------------------------------------------------------------+--  Series types  --------------------------------------------------------------+--------------------------------------------------------------------------------++-- | Exponential generating functions, for counting labelled species.+newtype EGF = EGF (PS.T LazyQ)+  deriving (Additive.C, Ring.C, Differential.C, Show)++egfFromCoeffs :: [LazyQ] -> EGF+egfFromCoeffs = EGF . PS.fromCoeffs++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) +         -> EGF -> EGF -> EGF+liftEGF2 f (EGF x) (EGF y) = EGF (f x y)++-- | Ordinary generating functions, for counting unlabelled species.+newtype GF = GF (PS.T Integer)+  deriving (Additive.C, Ring.C, Show)++gfFromCoeffs :: [Integer] -> GF+gfFromCoeffs = GF . PS.fromCoeffs++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) +         -> GF -> GF -> GF+liftGF2 f (GF x) (GF y) = GF (f x y)++-- | Cycle index series.+newtype CycleIndex = CI (MVP.T Rational)+  deriving (Additive.C, Ring.C, Differential.C, Show)++ciFromMonomials :: [Monomial.T Rational] -> CycleIndex+ciFromMonomials = CI . MVP.Cons++liftCI :: (MVP.T Rational -> MVP.T Rational)+        -> CycleIndex -> CycleIndex+liftCI f (CI x) = CI (f x)++liftCI2 :: (MVP.T Rational -> MVP.T Rational -> MVP.T Rational)+        -> CycleIndex -> CycleIndex -> CycleIndex+liftCI2 f (CI x) (CI y) = CI (f x y)++-- Some series utility functions++-- | Filter the coefficients of a series according to a predicate.+filterCoeffs :: (Additive.C a) => (Integer -> Bool) -> [a] -> [a]+filterCoeffs p = zipWith (filterCoeff p) [0..]+    where filterCoeff p n x | p n       = x+                            | otherwise = Additive.zero++-- | Set every coefficient of a series to 0 except the selected+--   index. Truncate any trailing zeroes.+selectIndex :: (Ring.C a, Eq a) => Integer -> [a] -> [a]+selectIndex n xs = xs'+    where mx = safeIndex n xs+          safeIndex _ []     = Nothing+          safeIndex 0 (x:_)  = Just x+          safeIndex n (_:xs) = safeIndex (n-1) xs+          xs' = case mx of+                  Just 0 -> []+                  Just x -> genericReplicate n 0 ++ [x]+                  _      -> []++--------------------------------------------------------------------------------+--  Higher-order Show  ---------------------------------------------------------+--------------------------------------------------------------------------------++-- | When generating species, we build up a functor representing+--   structures of that species; in order to display generated+--   structures, we need to know that applying the computed functor to+--   a Showable type will also yield something Showable.+class Functor f => ShowF f where+  showF :: (Show a) => f a -> String++instance ShowF [] where+  showF = show++-- | 'RawString' is like String, but with a Show instance that doesn't+--   add quotes or do any escaping.  This is a (somewhat silly) hack+--   needed to implement a 'ShowF' instance for 'Comp'.+newtype RawString = RawString String+instance Show RawString where+  show (RawString s) = s++--------------------------------------------------------------------------------+--  Structure functors  --------------------------------------------------------+--------------------------------------------------------------------------------++-- $struct+-- Functors used in building up structures for species generation.++-- | The constant functor.+newtype Const x a = Const x+instance Functor (Const x) where+  fmap _ (Const x) = Const x+instance (Show x) => Show (Const x a) where+  show (Const x) = show x+instance (Show x) => ShowF (Const x) where+  showF = show++-- | The identity functor.+newtype Identity a = Identity a+instance Functor Identity where+  fmap f (Identity x) = Identity (f x)+instance (Show a) => Show (Identity a) where+  show (Identity x) = show x+instance ShowF Identity where+  showF = show++-- | Functor coproduct.+newtype Sum f g a = Sum  { unSum  :: Either (f a) (g a) }+instance (Functor f, Functor g) => Functor (Sum f g) where+  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+instance (ShowF f, ShowF g) => ShowF (Sum f g) where+  showF (Sum (Left fa)) = "inl(" ++ showF fa ++ ")"+  showF (Sum (Right ga)) = "inr(" ++ showF ga ++ ")"++-- | Functor product.+newtype Prod f g a = Prod { unProd :: (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) = show x+instance (ShowF f, ShowF g) => ShowF (Prod f g) where+  showF (Prod (fa, ga)) = "(" ++ showF fa ++ "," ++ showF ga ++ ")"++-- | Functor composition.+data Comp f g a = Comp { unComp :: (f (g a)) }+instance (Functor f, Functor g) => Functor (Comp f g) where+  fmap f (Comp fga) = Comp (fmap (fmap f) fga)+instance (Show (f (g a))) => Show (Comp f g a) where+  show (Comp x) = show x+instance (ShowF f, ShowF g) => ShowF (Comp f g) where+  showF (Comp fga) = showF (fmap (RawString . showF) fga)++-- | 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)+instance (Show a) => Show (Cycle a) where+  show (Cycle xs) = "{" ++ intercalate "," (map show xs) ++ "}"+instance ShowF Cycle 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+instance Functor Star where+  fmap _ Star = Star+  fmap f (Original a) = Original (f a)+instance (Show a) => Show (Star a) where+  show Star = "*"+  show (Original a) = show a+instance ShowF Star where+  showF = show++--------------------------------------------------------------------------------+--  Type-level species  --------------------------------------------------------+--------------------------------------------------------------------------------++-- $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.++data Z+data S n+data X+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+--   species with type-level representation @s@, on the underlying set+--   @a@, has type @StructureF s a@.+type family StructureF t :: * -> *+type instance StructureF Z            = Const Integer+type instance StructureF (S s)        = Const Integer+type instance StructureF X            = 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 (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
@@ -0,0 +1,62 @@+-- | An interpretation of species as ordinary generating functions,+--   which count unlabelled structures.+module Math.Combinatorics.Species.Unlabelled +    ( unlabelled ) where++import Math.Combinatorics.Species.Types+import Math.Combinatorics.Species.Class+import Math.Combinatorics.Species.Algebra+import Math.Combinatorics.Species.CycleIndex++import qualified MathObj.PowerSeries as PS++import qualified Algebra.Differential as Differential++import NumericPrelude+import PreludeBase hiding (cycle)++instance Differential.C GF where+  differentiate = error "unlabelled differentiation must go via cycle index series."++instance Species GF where+  singleton         = gfFromCoeffs [0,1]+  set               = gfFromCoeffs (repeat 1)+  cycle             = set+  o                 = error "unlabelled composition must go via cycle index series."+  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++-- | Extract the coefficients of an ordinary generating function as a+--   list of Integers.  In particular, @unlabelled s !!  n@ is the+--   number of unlabelled s-structures on an underlying set of size n.+--   For example:+--+-- > > take 10 $ unlabelled octopi+-- > [0,1,2,3,5,7,13,19,35,59]+--+--   gives the number of unlabelled octopi on 0, 1, 2, 3, ... 9 elements.+--+--   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+--   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]+unlabelled s +  | needsZ s = unlabelledCoeffs . zToGF . reflect $ s+  | otherwise             = unlabelledCoeffs . reflect $ s
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ species.cabal view
@@ -0,0 +1,30 @@+name:           species+version:        0.1+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.2.3+tested-with:    GHC == 6.10.3+author:         Brent Yorgey+maintainer:     Brent Yorgey <byorgey@cis.upenn.edu>+category:       Math+synopsis:       Combinatorial species library++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.++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,+                 lub >= 0.0.5 && < 0.1+  exposed-modules:+    Math.Combinatorics.Species+    Math.Combinatorics.Species.Class+    Math.Combinatorics.Species.Types+    Math.Combinatorics.Species.Labelled+    Math.Combinatorics.Species.Unlabelled+    Math.Combinatorics.Species.CycleIndex+    Math.Combinatorics.Species.Algebra+    Math.Combinatorics.Species.Generate+  extensions: NoImplicitPrelude