packages feed

species 0.3.0.1 → 0.3.0.2

raw patch · 16 files changed

+699/−399 lines, 16 files

Files

+ CHANGES view
@@ -0,0 +1,11 @@+0.3        12 June 2010+  * A bunch of new features including:+    - Template Haskell support for deriving instances for user-defined data types+    - simplifier+    - Newton-Raphson iteration+  +0.3.0.1    30 June 2010+  * Fix broken dependency versions++0.3.0.2    15 July 2010+  * General cleanup, and added documentation
Math/Combinatorics/Species.hs view
@@ -33,8 +33,6 @@       -- $synonyms      , oneHole-    , madeOf-    , (><), (@@)     , x, sets, cycles     , linOrds     , subsets
Math/Combinatorics/Species/AST.hs view
@@ -6,17 +6,42 @@            , RankNTypes   #-} --- | A data structure to reify combinatorial species.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.AST+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Various data structures representing reified combinatorial species+-- expressions.  See also "Math.Combinatorics.Species.AST.Instances".+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.AST     (-      TSpeciesAST(..), SizedSpeciesAST(..)+      -- * Basic species expression AST+      SpeciesAST(..)++      -- * Typed, sized species expression AST+    , TSpeciesAST(..)++      -- ** Size annotations+    , SizedSpeciesAST(..)     , interval, annI, getI, stripI++      -- ** Existentially wrapped AST     , ESpeciesAST(..), wrap, unwrap+    , erase, erase', unerase++      -- * ASTFunctor class (codes for higher-order functors)     , ASTFunctor(..) -    , needsZ, needsZE+      -- * Miscellaneous AST operations -    , SpeciesAST(..), erase, erase', unerase+    , needsCI+     , substRec      ) where@@ -33,22 +58,58 @@ import NumericPrelude import PreludeBase hiding (cycle) --- | Reified combinatorial species.  Note that 'TSpeciesAST' has a---   phantom type parameter which also reflects the structure, so we---   can write quasi-dependently-typed functions over species, in---   particular for species enumeration.+------------------------------------------------------------+--  Untyped AST  -------------------------------------------+------------------------------------------------------------++-- | A basic, untyped AST type for species expressions, for easily+-- doing things like analysis, simplification, deriving isomorphisms,+-- and so on.  Converting between 'SpeciesAST' and the typed variant+-- 'ESpeciesAST' can be done with 'unerase' and 'erase'.+data SpeciesAST where+  Zero          :: SpeciesAST+  One           :: SpeciesAST+  N             :: Integer -> SpeciesAST+  X             :: SpeciesAST+  E             :: SpeciesAST+  C             :: SpeciesAST+  L             :: SpeciesAST+  Subset        :: SpeciesAST+  KSubset       :: Integer -> SpeciesAST+  Elt           :: SpeciesAST+  (:+:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST+  (:*:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST+  (:.:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST+  (:><:)        :: SpeciesAST -> SpeciesAST -> SpeciesAST+  (:@:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST+  Der           :: SpeciesAST -> SpeciesAST+  OfSize        :: SpeciesAST -> (Integer -> Bool) -> SpeciesAST+  OfSizeExactly :: SpeciesAST -> Integer -> SpeciesAST+  NonEmpty      :: SpeciesAST -> SpeciesAST+  Rec           :: ASTFunctor f => f -> SpeciesAST+  Omega         :: SpeciesAST++------------------------------------------------------------+--  Typed, sized AST  --------------------------------------+------------------------------------------------------------++-- | A variant of 'SpeciesAST' with a phantom type parameter which+--   also reflects the structure, so we can write+--   quasi-dependently-typed functions over species, in particular for+--   species enumeration. -- --   Of course, the non-uniform type parameter means that---   'TSpeciesAST' cannot be an instance of the 'Species' class;---   for that purpose the existential wrapper 'ESpeciesAST' is---   provided.+--   'TSpeciesAST' cannot be an instance of the 'Species' class; for+--   that purpose the existential wrapper 'ESpeciesAST' is provided. -- --   'TSpeciesAST' is defined via mutual recursion with --   'SizedSpeciesAST', which pairs a 'TSpeciesAST' with an interval --   annotation indicating (a conservative approximation of) the label---   set sizes for which the species actually yields any structures.---   A value of 'SizedSpeciesAST' is thus an annotated species---   expression tree with interval annotations at every node.+--   set sizes for which the species actually yields any structures;+--   this information makes enumeration faster and also prevents it+--   from getting stuck in infinite recursion in some cases.  A value+--   of 'SizedSpeciesAST' is thus an annotated species expression tree+--   with interval annotations at every node. data TSpeciesAST (s :: * -> *) where    TZero     :: TSpeciesAST Void    TOne      :: TSpeciesAST Unit@@ -123,48 +184,24 @@ stripI :: SizedSpeciesAST s -> TSpeciesAST s stripI (Sized _ s) = s --- | Retrieve the interval annotation.+-- | Retrieve the interval annotation from a 'SizedSpeciesAST'. getI :: SizedSpeciesAST s -> Interval getI (Sized i _) = i --- | Type class for codes which can be interpreted as higher-order---   functors.-class (Typeable f, Show f, Typeable1 (Interp f (Mu f))) => ASTFunctor f where-  apply :: Typeable1 g => f -> TSpeciesAST g -> TSpeciesAST (Interp f g)---- | 'needsZ' 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.-needsZ :: SpeciesAST -> Bool-needsZ L            = True-needsZ (f :+: g)    = needsZ f || needsZ g-needsZ (f :*: g)    = needsZ f || needsZ g-needsZ (_ :.: _)    = True-needsZ (_ :><: _)   = True-needsZ (_ :@: _)    = True-needsZ (Der _)      = True-needsZ (OfSize f _) = needsZ f-needsZ (OfSizeExactly f _) = needsZ f-needsZ (NonEmpty f) = needsZ f-needsZ (Rec _)      = True    -- Newton-Raphson iteration uses composition-needsZ _             = False- -- | An existential wrapper to hide the phantom type parameter to --   'SizedSpeciesAST', so we can make it an instance of 'Species'. data ESpeciesAST where   Wrap :: Typeable1 s => SizedSpeciesAST s -> ESpeciesAST --- | Smart wrap constructor which also adds an appropriate interval---   annotation.+-- | Construct an 'ESpeciesAST' from a 'TSpeciesAST' by adding an+--   appropriate interval annotation and hiding the type. wrap :: Typeable1 s => TSpeciesAST s -> ESpeciesAST wrap = Wrap . annI --- | Unwrap the existential wrapper and get out a typed AST.  You can+-- | Unwrap an existential wrapper to get out a typed AST.  You can --   get out any type you like as long as it is the right one. -----   CAUTION: Don't try this at home.+--   CAUTION: Don't try this at home! unwrap :: Typeable1 s => ESpeciesAST -> TSpeciesAST s unwrap (Wrap f) = gcast1'                 . stripI@@ -179,41 +216,12 @@                 getArg :: c x -> x ()                 getArg = undefined --- | A version of 'needsZ' for 'ESpeciesAST'.-needsZE :: ESpeciesAST -> Bool-needsZE = needsZ . erase---- | A plain old untyped variant of the species AST, for more easily---   doing things like analysis, simplification, deriving---   isomorphisms, and so on.  Converting between 'ESpeciesAST' and---   'SpeciesAST' can be done with 'erase' and 'unerase'.-data SpeciesAST where-  Zero          :: SpeciesAST-  One           :: SpeciesAST-  N             :: Integer -> SpeciesAST-  X             :: SpeciesAST-  E             :: SpeciesAST-  C             :: SpeciesAST-  L             :: SpeciesAST-  Subset        :: SpeciesAST-  KSubset       :: Integer -> SpeciesAST-  Elt           :: SpeciesAST-  (:+:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST-  (:*:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST-  (:.:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST-  (:><:)        :: SpeciesAST -> SpeciesAST -> SpeciesAST-  (:@:)         :: SpeciesAST -> SpeciesAST -> SpeciesAST-  Der           :: SpeciesAST -> SpeciesAST-  OfSize        :: SpeciesAST -> (Integer -> Bool) -> SpeciesAST-  OfSizeExactly :: SpeciesAST -> Integer -> SpeciesAST-  NonEmpty      :: SpeciesAST -> SpeciesAST-  Rec           :: ASTFunctor f => f -> SpeciesAST-  Omega         :: SpeciesAST---- | Erase the type and interval information from a species AST.+-- | Erase the type and interval information from an existentially+-- wrapped species AST. erase :: ESpeciesAST -> SpeciesAST erase (Wrap s) = erase' (stripI s) +-- | Erase the type and interval information from a typed species AST. erase' :: TSpeciesAST f -> SpeciesAST erase' TZero                = Zero erase' TOne                 = One@@ -269,6 +277,41 @@   where nonEmpty (Wrap f)    = wrap $ TNonEmpty f unerase (Rec f)             = wrap $ TRec f unerase Omega               = wrap TOmega++------------------------------------------------------------+--  ASTFunctor class  --------------------------------------+------------------------------------------------------------++-- | 'ASTFunctor' is a type class for codes which can be interpreted+--   (via the 'Interp' type family) as higher-order functors over+--   species expressions.  The 'apply' method allows such codes to be+--   applied to a species AST.  The indirection is needed to implement+--   recursive species.+class (Typeable f, Show f, Typeable1 (Interp f (Mu f))) => ASTFunctor f where+  apply :: Typeable1 g => f -> TSpeciesAST g -> TSpeciesAST (Interp f g)++------------------------------------------------------------+--  Miscellaneous AST operations  --------------------------+------------------------------------------------------------++-- | 'needsCI' is a predicate which checks whether a species expression+--   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.+needsCI :: SpeciesAST -> Bool+needsCI L            = True+needsCI (f :+: g)    = needsCI f || needsCI g+needsCI (f :*: g)    = needsCI f || needsCI g+needsCI (_ :.: _)    = True+needsCI (_ :><: _)   = True+needsCI (_ :@: _)    = True+needsCI (Der _)      = True+needsCI (OfSize f _) = needsCI f+needsCI (OfSizeExactly f _) = needsCI f+needsCI (NonEmpty f) = needsCI f+needsCI (Rec _)      = True    -- Newton-Raphson iteration uses composition+needsCI _            = False  -- | Substitute an expression for recursive occurrences. substRec :: ASTFunctor f => f -> SpeciesAST -> SpeciesAST -> SpeciesAST
Math/Combinatorics/Species/AST/Instances.hs view
@@ -1,11 +1,27 @@ {-# LANGUAGE GADTs #-} --- | Type class instances for 'TSpeciesAST', 'ESpeciesAST', and---   'SpeciesAST', in a separate module to avoid a dependency cycle---   between "Math.Combinatorics.Species.AST" and---   "Math.Combinatorics.Species.Class".+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.AST.Instances+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Type class instances for 'TSpeciesAST', 'ESpeciesAST', and+-- 'SpeciesAST', in a separate module to avoid a dependency cycle+-- between "Math.Combinatorics.Species.AST" and+-- "Math.Combinatorics.Species.Class".+--+-- This module also contains functions for reifying species+-- expressions to ASTs and reflecting ASTs back into other species+-- instances, which are in this module since they depend on the AST+-- type class instances.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.AST.Instances-    ( reify, reflectT, reflectU, reflect )+    ( reify, reifyE, reflect, reflectT, reflectE )     where  import NumericPrelude@@ -22,7 +38,19 @@  import Data.Typeable +------------------------------------------------------------+--  SpeciesAST instances  ----------------------------------+------------------------------------------------------------+ -- grr -- can't autoderive this because of Rec constructor! =P++-- | Species expressions can be compared for /structural/ equality.+--   (Note that if @s1@ and @s2@ are /isomorphic/ species we do not+--   necessarily have @s1 == s2@.)+--+--   Note, however, that species containing an 'OfSize' constructor+--   will always compare as @False@ with any other species, since we+--   cannot decide function equality. instance Eq SpeciesAST where   Zero                == Zero                 = True   One                 == One                  = True@@ -45,70 +73,80 @@   NonEmpty f1         == NonEmpty f2          = f1 == f2   Rec f1              == Rec f2               = typeOf f1 == typeOf f2   Omega               == Omega                = True-  _ == _                                        = False+  _ == _                                      = False ++-- argh, can't derive this either.  ugh.+-- | An (arbitrary) 'Ord' instance, so that we can put species+--   expressions in canonical order when simplifying. instance Ord SpeciesAST where-  compare x y | x == y = EQ-  compare Zero _ = LT-  compare _ Zero = GT-  compare One _     = LT-  compare _ One     = GT-  compare (N m) (N n) = compare m n-  compare (N _) _ = LT-  compare _ (N _) = GT-  compare X _ = LT-  compare _ X = GT-  compare E _ = LT-  compare _ E = GT-  compare C _ = LT-  compare _ C = GT-  compare L _ = LT-  compare _ L = GT-  compare Subset _ = LT-  compare _ Subset = GT-  compare (KSubset j) (KSubset k) = compare j k-  compare (KSubset _) _ = LT-  compare _ (KSubset _) = GT-  compare Elt _ = LT-  compare _ Elt = GT-  compare (f1 :+: g1) (f2 :+: g2) | f1 == f2 = compare g1 g2+  compare x y  | x == y             = EQ+  compare Zero _                    = LT+  compare _ Zero                    = GT+  compare One _                     = LT+  compare _ One                     = GT+  compare (N m) (N n)               = compare m n+  compare (N _) _                   = LT+  compare _ (N _)                   = GT+  compare X _                       = LT+  compare _ X                       = GT+  compare E _                       = LT+  compare _ E                       = GT+  compare C _                       = LT+  compare _ C                       = GT+  compare L _                       = LT+  compare _ L                       = GT+  compare Subset _                  = LT+  compare _ Subset                  = GT+  compare (KSubset j) (KSubset k)   = compare j k+  compare (KSubset _) _             = LT+  compare _ (KSubset _)             = GT+  compare Elt _                     = LT+  compare _ Elt                     = GT+  compare (f1 :+: g1) (f2 :+: g2)   | f1 == f2  = compare g1 g2                                     | otherwise = compare f1 f2-  compare (_ :+: _) _ = LT-  compare _ (_ :+: _) = GT-  compare (f1 :*: g1) (f2 :*: g2) | f1 == f2 = compare g1 g2+  compare (_ :+: _) _               = LT+  compare _ (_ :+: _)               = GT+  compare (f1 :*: g1) (f2 :*: g2)   | f1 == f2  = compare g1 g2                                     | otherwise = compare f1 f2-  compare (_ :*: _) _ = LT-  compare _ (_ :*: _) = GT-  compare (f1 :.: g1) (f2 :.: g2) | f1 == f2 = compare g1 g2+  compare (_ :*: _) _               = LT+  compare _ (_ :*: _)               = GT+  compare (f1 :.: g1) (f2 :.: g2)   | f1 == f2  = compare g1 g2                                     | otherwise = compare f1 f2-  compare (_ :.: _) _ = LT-  compare _ (_ :.: _) = GT-  compare (f1 :><: g1) (f2 :><: g2) | f1 == f2 = compare g1 g2-                                      | otherwise = compare f1 f2-  compare (_ :><: _) _ = LT-  compare _ (_ :><: _) = GT-  compare (f1 :@: g1) (f2 :@: g2) | f1 == f2 = compare g1 g2+  compare (_ :.: _) _               = LT+  compare _ (_ :.: _)               = GT+  compare (f1 :><: g1) (f2 :><: g2) | f1 == f2  = compare g1 g2                                     | otherwise = compare f1 f2-  compare (_ :@: _) _ = LT-  compare _ (_ :@: _) = GT-  compare (Der f1) (Der f2) = compare f1 f2-  compare (Der _) _ = LT-  compare _ (Der _) = GT-  compare (OfSize f1 p1) (OfSize f2 p2) = compare f1 f2-  compare (OfSize _ _) _ = LT-  compare _ (OfSize _ _) = GT+  compare (_ :><: _) _              = LT+  compare _ (_ :><: _)              = GT+  compare (f1 :@: g1) (f2 :@: g2)   | f1 == f2  = compare g1 g2+                                    | otherwise = compare f1 f2+  compare (_ :@: _) _               = LT+  compare _ (_ :@: _)               = GT+  compare (Der f1) (Der f2)         = compare f1 f2+  compare (Der _) _                 = LT+  compare _ (Der _)                 = GT+  compare (OfSize f1 p1) (OfSize f2 p2)+                                    = compare f1 f2+  compare (OfSize _ _) _            = LT+  compare _ (OfSize _ _)            = GT   compare (OfSizeExactly f1 k1) (OfSizeExactly f2 k2)-    | f1 == f2 = compare k1 k2-    | otherwise = compare f1 f2-  compare (OfSizeExactly _ _) _ = LT-  compare _ (OfSizeExactly _ _) = GT-  compare (NonEmpty f1) (NonEmpty f2) = compare f1 f2-  compare (NonEmpty _) _ = LT-  compare _ (NonEmpty _) = GT-  compare (Rec f1) (Rec f2) = compare (show $ typeOf f1) (show $ typeOf f2)-  compare Omega _ = LT-  compare _ Omega = GT+                                    | f1 == f2  = compare k1 k2+                                    | otherwise = compare f1 f2+  compare (OfSizeExactly _ _) _     = LT+  compare _ (OfSizeExactly _ _)     = GT+  compare (NonEmpty f1) (NonEmpty f2)+                                    = compare f1 f2+  compare (NonEmpty _) _            = LT+  compare _ (NonEmpty _)            = GT+  compare (Rec f1) (Rec f2)         = compare (show $ typeOf f1) (show $ typeOf f2)+  compare Omega _                   = LT+  compare _ Omega                   = GT +-- | Display species expressions in a nice human-readable form.  Note+--   that we commit the unforgivable sin of omitting a corresponding+--   Read instance.  This will hopefully be remedied in a future+--   version. instance Show SpeciesAST where   showsPrec _ Zero                = shows (0 :: Int)   showsPrec _ One                 = shows (1 :: Int)@@ -141,11 +179,15 @@   showsPrec _ (NonEmpty f)        = showsPrec 11 f . showChar '+'   showsPrec _ (Rec f)             = shows f +-- | Species expressions are additive. instance Additive.C SpeciesAST where   zero   = Zero   (+)    = (:+:)   negate = error "negation is not implemented yet!  wait until virtual species..." +-- | Species expressions form a ring.  Well, sort of.  Of course the+--   ring laws actually only hold up to isomorphism of species, not up+--   to structural equality. instance Ring.C SpeciesAST where   (*) = (:*:)   one = One@@ -156,9 +198,12 @@   w ^ 1 = w   f ^ n = f * (f ^ (n-1)) +-- | Species expressions are differentiable. instance Differential.C SpeciesAST where   differentiate = Der +-- | Species expressions are an instance of the 'Species' class, so we+--   can use the Species class DSL to build species expression ASTs. instance Species SpeciesAST where   singleton     = X   set           = E@@ -168,8 +213,8 @@   ksubset k     = KSubset k   element       = Elt   o             = (:.:)-  cartesian     = (:><:)-  fcomp         = (:@:)+  (><)          = (:><:)+  (@@)          = (:@:)   ofSize        = OfSize   ofSizeExactly = OfSizeExactly   nonEmpty      = NonEmpty@@ -202,61 +247,71 @@   differentiate (Wrap f) = wrap (TDer f)  instance Species ESpeciesAST where-  singleton                         = wrap TX-  set                               = wrap TE-  cycle                             = wrap TC-  linOrd                            = wrap TL-  subset                            = wrap TSubset-  ksubset k                         = wrap $ TKSubset k-  element                           = wrap TElt-  o (Wrap f) (Wrap g)               = wrap $ f :.:: g-  cartesian (Wrap f) (Wrap g)       = wrap $ f :><:: g-  fcomp (Wrap f) (Wrap g)           = wrap $ f :@:: g-  ofSize (Wrap f) p                 = wrap $ TOfSize f p-  ofSizeExactly (Wrap f) n          = wrap $ TOfSizeExactly f n-  nonEmpty (Wrap f)                 = wrap $ TNonEmpty f-  rec f                             = wrap $ TRec f-  omega                             = wrap TOmega+  singleton                 = wrap TX+  set                       = wrap TE+  cycle                     = wrap TC+  linOrd                    = wrap TL+  subset                    = wrap TSubset+  ksubset k                 = wrap $ TKSubset k+  element                   = wrap TElt+  o (Wrap f) (Wrap g)       = wrap $ f :.:: g+  Wrap f >< Wrap g          = wrap $ f :><:: g+  Wrap f @@ Wrap g          = wrap $ f :@:: g+  ofSize (Wrap f) p         = wrap $ TOfSize f p+  ofSizeExactly (Wrap f) n  = wrap $ TOfSizeExactly f n+  nonEmpty (Wrap f)         = wrap $ TNonEmpty f+  rec f                     = wrap $ TRec f+  omega                     = wrap TOmega --- | Reify a species expression into an AST.  Of course, this is just---   the identity function with a usefully restricted type.  For+------------------------------------------------------------+--  Reify/reflect  -----------------------------------------+------------------------------------------------------------++-- | Reify a species expression into an AST.  (Actually, this is just+--   the identity function with a usefully restricted type.)  For --   example: -- -- > > reify octopus -- > C . TL+ -- > > reify (ksubset 3) -- > E3 * TE--reify :: ESpeciesAST -> ESpeciesAST+reify :: SpeciesAST -> SpeciesAST reify = id +-- | The same as reify, but produce a typed, size-annotated AST.+reifyE :: ESpeciesAST -> ESpeciesAST+reifyE = id+ -- | Reflect an AST back into any instance of the 'Species' class.-reflectU :: Species s => SpeciesAST -> s-reflectU Zero                = 0-reflectU One                 = 1-reflectU (N n)               = fromInteger n-reflectU X                   = singleton-reflectU E                   = set-reflectU C                   = cycle-reflectU L                   = linOrd-reflectU Subset              = subset-reflectU (KSubset k)         = ksubset k-reflectU Elt                 = element-reflectU (f :+: g)           = reflectU f + reflectU g-reflectU (f :*: g)           = reflectU f * reflectU g-reflectU (f :.: g)           = reflectU f `o` reflectU g-reflectU (f :><: g)          = reflectU f >< reflectU g-reflectU (f :@: g)           = reflectU f @@ reflectU g-reflectU (Der f)             = oneHole (reflectU f)-reflectU (OfSize f p)        = ofSize (reflectU f) p-reflectU (OfSizeExactly f n) = ofSizeExactly (reflectU f) n-reflectU (NonEmpty f)        = nonEmpty (reflectU f)-reflectU (Rec f)             = rec f-reflectU Omega               = omega+reflect :: Species s => SpeciesAST -> s+reflect Zero                = 0+reflect One                 = 1+reflect (N n)               = fromInteger n+reflect X                   = singleton+reflect E                   = set+reflect C                   = cycle+reflect L                   = linOrd+reflect Subset              = subset+reflect (KSubset k)         = ksubset k+reflect Elt                 = element+reflect (f :+: g)           = reflect f + reflect g+reflect (f :*: g)           = reflect f * reflect g+reflect (f :.: g)           = reflect f `o` reflect g+reflect (f :><: g)          = reflect f >< reflect g+reflect (f :@: g)           = reflect f @@ reflect g+reflect (Der f)             = oneHole (reflect f)+reflect (OfSize f p)        = ofSize (reflect f) p+reflect (OfSizeExactly f n) = ofSizeExactly (reflect f) n+reflect (NonEmpty f)        = nonEmpty (reflect f)+reflect (Rec f)             = rec f+reflect Omega               = omega +-- | Reflect a typed AST back into any instance of the 'Species'+-- class. reflectT :: Species s => TSpeciesAST f -> s-reflectT = reflectU . erase'+reflectT = reflect . erase' --- | Reflect an AST back into any instance of the 'Species' class.-reflect :: Species s => ESpeciesAST -> s-reflect = reflectU . erase+-- | Reflect an existentially wrapped typed AST back into any+-- instance of the 'Species' class.+reflectE :: Species s => ESpeciesAST -> s+reflectE = reflect . erase
Math/Combinatorics/Species/Class.hs view
@@ -1,9 +1,20 @@ {-# 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+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- 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@@ -12,9 +23,14 @@       -- * Convenience methods      , oneHole-    , madeOf-    , (><), (@@)     , x++      -- ** Plurals++      -- | It can be grammatically convenient to define plural+      -- versions of species as synonyms for the singular versions.+      -- For example, we can use @'set' ``o`` 'nonEmpty' 'sets'@+      -- instead of @'set' ``o`` 'nonEmpty' 'set'@.     , sets     , cycles     , linOrds@@ -61,78 +77,71 @@ --   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 'ESpeciesAST' (reified---   species expressions). class (Differential.C s) => Species s where -  -- | The species TX of singletons. TX puts a singleton structure on an-  --   underlying set of size 1, and no structures on any other-  --   underlying sets.+  -- | The species @X@ of singletons. Puts a singleton structure on an+  --   underlying label set of size 1, and no structures on any other+  --   underlying label sets.  'x' is also provided as a synonym.   singleton :: s -  -- | The species TE of sets.  TE puts a singleton structure on any-  --   underlying set.-  set       :: s+  -- | The species @E@ of sets.  Puts a singleton structure on /any/+  --   underlying label set.+  set :: s -  -- | The species C of cyclical orderings (cycles/rings).-  cycle     :: s+  -- | The species @C@ of cyclical orderings (cycles/rings).+  cycle :: s -  -- | The species TL of linear orderings (lists): since linear+  -- | The species @L@ of linear orderings (lists). Since linear   --   orderings are isomorphic to cyclic orderings with a hole, we-  --   may take TL = C' as the default implementation; linOrd is-  --   included in the 'Species' class so it can be special-cased for-  --   enumeration.-  linOrd    :: s+  --   may take @'linOrd' = 'oneHole' 'cycle'@ as the default+  --   implementation; 'linOrd' is included in the 'Species' class so it+  --   can be special-cased for enumeration.+  linOrd :: s   linOrd = oneHole cycle -  -- | The species p of subsets is given by p = TE * TE. 'subset' has a-  --   default implementation of @set * set@, but is included in the-  --   'Species' class so it can be overridden when enumerating-  --   structures: since subset is defined as @set * set@, the-  --   enumeration 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-  --   enumerate subset/complement pairs, you can use @set * set@+  -- | The species @p@ of subsets is given by @'subset' = 'set' *+  --   'set'@. 'subset' is included in the 'Species' class so it can+  --   be overridden when enumerating structures: by default the+  --   enumeration code would generate 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+  --   enumerate subset/complement pairs, you can use @'set' * 'set'@   --   directly.   subset :: s   subset = set * set -  -- | Subsets of size exactly k, p[k] = E_k * TE.  Included with a-  --   default definition in the 'Species' class for the same reason-  --   as 'subset'.+  -- | Subsets of size exactly k, @'ksubset' k = ('set'+  -- ``ofSizeExactly`` k) * 'set'@.  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 = TX * TE.  Included with a default-  --   definition in 'Species' class for the same reason as 'subset'-  --   and 'ksubset'.+  -- | Structures of the species @e@ of elements are just elements of+  --   the underlying set, @'element' = 'singleton' * 'set'@.  Included+  --   with a default definition in 'Species' class for the same+  --   reason as 'subset' and 'ksubset'.   element :: s-  element = x * set+  element = singleton * 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+  -- | Partitional composition.  To form all @(f ``o`` g)@-structures on+  --   the underlying label 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+  -- | Cartisian product of two species.  An @(f '><' g)@-structure+  -- consists of an @f@-structure superimposed on a @g@-structure over+  -- the same underlying set.+  (><) :: 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+  -- | Functor composition of two species.  An @(f '@@' g)@-structure+  --   consists of an @f@-structure on the set of all @g@-structures.+  (@@) :: s -> s -> s    -- | Only put a structure on underlying sets whose size satisfies   --   the predicate.-  ofSize    :: s -> (Integer -> Bool) -> s+  ofSize :: s -> (Integer -> Bool) -> s    -- | Only put a structure on underlying sets of the given size.  A   --   default implementation of @ofSize (==k)@ is provided, but this@@ -146,50 +155,41 @@   --   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 :: s -> s   nonEmpty = flip ofSize (>0)    -- | 'rec f' is the least fixpoint of (the interpretation of) the   --   higher-order species constructor 'f'.   rec :: ASTFunctor f => f -> s -  -- XXX  don't export this!+  -- | Omega is the pseudo-species which only puts a structure on+  --   infinite label sets.  Of course this is not really a species,+  --   but it is sometimes a convenient fiction to use Omega to stand+  --   in for recursive occurrences of a species.   omega :: 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.+-- | A convenient synonym for differentiation.  @'oneHole'+-- 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 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+x = singleton  sets :: Species s => s-sets       = set+sets = set  cycles :: Species s => s-cycles     = cycle+cycles = cycle  -- $derived_ops -- Some derived operations on species. --- | Combinatorially, the operation of pointing picks out a+-- | Intuitively, the operation of pointing picks out a --   distinguished element from an underlying set.  It is equivalent---   to the operator @x d/dx@.+--   to the operator @x d/dx@: @'pointed' s = 'singleton' * 'differentiate' s@. pointed :: Species s => s -> s pointed = (x *) . Differential.differentiate @@ -205,18 +205,19 @@  -- | An octopus is a cyclic arrangement of lists, so called because --   the lists look like \"tentacles\" attached to the cyclic---   \"body\": Oct = C o TE+ .+--   \"body\": @'octopus' = 'cycle' ``o`` 'nonEmpty' 'linOrds'@. octopi, octopus :: Species s => s octopus = cycle `o` nonEmpty linOrds octopi  = octopus --- | The species of set partitions is just the composition TE o TE+,---   that is, sets of nonempty sets.+-- | The species of set partitions is just the composition @'set'+-- ``o`` 'nonEmpty' 'sets'@. partitions, partition :: Species s => s partition  = set `o` nonEmpty sets partitions = partition --- | A permutation is a set of disjoint cycles: S = TE o C.+-- | A permutation is a set of disjoint cycles: @'permutation' = 'set'+-- ``o`` 'cycles'@. permutations, permutation :: Species s => s permutation = set `o` cycles permutations = permutation@@ -224,8 +225,8 @@ subsets :: Species s => s subsets = subset --- | The species Bal of ballots consists of linear orderings of---   nonempty sets: Bal = TL o TE+.+-- | The species of ballots consists of linear orderings of+--   nonempty sets: @'ballot' = 'linOrd' ``o`` 'nonEmpty' 'sets'@. ballots, ballot :: Species s => s ballot = linOrd `o` nonEmpty sets ballots = ballot@@ -234,15 +235,16 @@ 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.+--   subset of the set of all size-two subsets of the vertices:+--   @'simpleGraph' = 'subset' '@@' ('ksubset' 2)@. simpleGraphs, simpleGraph :: Species s => s simpleGraph = subset @@ (ksubset 2) simpleGraphs = simpleGraph  -- | A directed graph (with loops) is a subset of all pairs drawn---   (with replacement) from the set of vertices: D = p \@\@ (e ><---   e).  It can also be thought of as the species of binary relations.+--   (with replacement) from the set of vertices: @'subset' '@@'+--   ('element' '><' 'element')@.  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
@@ -2,9 +2,20 @@            , 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+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- An interpretation of species expressions as 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@@ -41,30 +52,34 @@ import NumericPrelude import PreludeBase hiding (cycle) +-- | An interpretation of species expressions as cycle index series.+-- For the definition of the 'CycleIndex' type, see+-- "Math.Combinatorics.Species.Types". instance Species CycleIndex where-  singleton = CI $ MVP.x 1-  set       = ciFromMonomials . map partToMonomial . concatMap intPartitions $ [0..]+  singleton  = CI $ MVP.x 1+  set        = ciFromMonomials . map partToMonomial . concatMap intPartitions $ [0..] -  cycle     = ciFromMonomials . concatMap cycleMonomials $ [1..]+  cycle      = ciFromMonomials . concatMap cycleMonomials $ [1..] -  o = liftCI2 MVP.compose+  o          = liftCI2 MVP.compose -  cartesian = liftCI2 . MVP.lift2 $ \x y -> hadamard x y+  (><)       = liftCI2 . MVP.lift2 $ hadamard -  fcomp     = zFComp+  (@@)       = 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--  rec f = case newtonRaphsonRec f 10 of-            Nothing -> error $ "Unable to express " ++ show f ++ " in the form T = TX*R(T)."-            Just ls -> ls+  ofSizeExactly s n+             = (liftCI . MVP.lift1 $+                 ( takeWhile ((==n) . Monomial.pDegree)+                 . dropWhile ((<n) . Monomial.pDegree))) s +  rec f      = case newtonRaphsonRec f 10 of+                 Nothing -> error $+                   "Unable to express " ++ show f ++ " in the form T = TX*R(T)."+                 Just ls -> ls  -- | Convert an integer partition to the corresponding monomial in the---   cycle index series for the species of sets.+--   cycle index series for the species of sets: 1/aut(js) * prod_i xi^ji. partToMonomial :: CycleType -> Monomial.T Rational partToMonomial js = Monomial.Cons (ezCoeff js) (M.fromList js) 
Math/Combinatorics/Species/Enumerate.hs view
@@ -7,7 +7,19 @@            , DeriveDataTypeable   #-} --- | Enumeration of labelled and unlabelled species.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Enumerate+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Enumeration (i.e. exhaustive generation of structures) of both+-- labelled and unlabelled species.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Enumerate     (       -- * Enumeration methods@@ -21,10 +33,6 @@     , enumerateAll     , enumerateAllU -    -- * Where all the work actually happens--    , enumerate', enumerateE-     -- * Tools for dealing with structure types      , Enumerable(..)@@ -32,6 +40,10 @@     , Structure(..), extractStructure, unsafeExtractStructure     , structureType, showStructureType +    -- * Where all the work actually happens++    , enumerate', enumerateE+     ) where  import Math.Combinatorics.Species.Class@@ -56,10 +68,8 @@ -- --   Unfortunately, 'TSpeciesAST' cannot be made an instance of --   'Species', so if we want to be able to enumerate structures given---   an expression of the 'Species' DSL as input, we must take---   'ESpeciesAST' as input, which existentially wraps the phantom---   structure type---but this means that the output list type must be---   existentially quantified as well; see 'enumerateE'.+--   an expression of the 'Species' DSL as input, the output must be+--   existentially quantified; see 'enumerateE'. -- --   Generating structures over base elements from a /multiset/ --   unifies labelled and unlabelled generation into one framework.@@ -166,9 +176,9 @@ --   In particular, if @structureType s@ prints @\"T\"@, then you can --   safely use 'enumerate' and friends by writing ----- > enumerate s ls :: [T TL]+-- > enumerate s ls :: [T a] -----   where @ls :: [TL]@.+--   where @ls :: [a]@. -- --   For example, --@@ -179,6 +189,11 @@ -- > ,<[1,2,3]>,<[1],[3,2]>,<[1],[2,3]>,<[3,1],[2]> -- > ,<[1,3],[2]>,<[2,1],[3]>,<[1,2],[3]>,<[2],[1],[3]> -- > ,<[1],[2],[3]>]+--+-- Note, however, that providing a type annotation on 'enumerate' in+-- this way is usually only necessary at the @ghci@ prompt; when used+-- in the context of a larger program the type of a call to+-- 'enumerate' can often be inferred. structureType :: ESpeciesAST -> String structureType (Wrap s) = showStructureType . extractType $ (stripI s)   where extractType :: forall s. Typeable1 s => TSpeciesAST s -> TypeRep@@ -186,7 +201,7 @@  -- | 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+--   "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 ""@@ -210,16 +225,16 @@         dropQuals = reverse . takeWhile (/= '.') . reverse  -- | 'enumerateE' is a variant of 'enumerate'' which takes an---   (existentially quantified) 'ESpeciesAST' and returns a list of---   structures wrapped in the (also existentially quantified)---   'Structure' type.  This is also not meant to be used directly.---   Instead, you should use one of the other @enumerateX@ methods.+--   (existentially quantified) typed AST and returns a list of+--   existentially quantified structures.  This is also not meant to+--   be used directly.  Instead, you should use one of the other+--   @enumerateX@ methods. enumerateE :: ESpeciesAST -> Multiset a -> [Structure a] enumerateE (Wrap s) m-  | fromIntegral (sum (MS.getCounts m)) `I.elem` (getI s) = map Structure (enumerate' (stripI s) m)+  | fromIntegral (sum (MS.getCounts m)) `I.elem` (getI s)+    = map Structure (enumerate' (stripI s) m)   | otherwise = [] - -- XXX add examples to all of these.  -- | @enumerate s ls@ computes a complete list of distinct@@ -254,7 +269,8 @@ --   enumerating the structures of a particular species, see the --   'structureType' function.  To be able to use your own custom data --   type in an enumeration, just make your data type an instance of---   the 'Enumerable' type class.+--   the 'Enumerable' type class; this can be done for you+--   automatically by "Math.Combinatorics.Species.TH". -- --   If an invalid type annotation is given, 'enumerate' will call --   'error' with a helpful error message.  This should not be much of@@ -263,15 +279,15 @@ --   will sometimes work and sometimes fail.  However, those who like --   their functions total can use 'extractStructure' to make a --   version of 'enumerate' (or the other variants) with a return type---   of @[Either String (f a)]@ (which will return an annoying ton of---   duplicate error message) or @Either String [f a]@ (which has the+--   of @['Either' 'String' (f a)]@ (which will return an annoying ton of+--   duplicate error messages) or @'Either' 'String' [f a]@ (which has the --   unfortunate property of being much less lazy than the current --   versions, since it must compute the entire list before deciding---   whether to return @Left@ or @Right@).+--   whether to return @'Left'@ or @'Right'@). -- --   For slight variants on 'enumerate', see 'enumerateL', --   'enumerateU', and 'enumerateM'.-enumerate :: (Enumerable f, Typeable a, Eq a) => ESpeciesAST -> [a] -> [f a]+enumerate :: (Enumerable f, Typeable a, Eq a) => SpeciesAST -> [a] -> [f a] enumerate s = enumerateM s . MS.fromListEq  -- | Labelled enumeration: given a species expression and a list of@@ -280,7 +296,7 @@ --   for the enumeration does not match the species expression (via an --   'Enumerable' instance), call 'error' with an error message --   explaining the mismatch.-enumerateL :: (Enumerable f, Typeable a) =>  ESpeciesAST -> [a] -> [f a]+enumerateL :: (Enumerable f, Typeable a) =>  SpeciesAST -> [a] -> [f a] enumerateL s = enumerateM s . MS.fromDistinctList  -- | Unlabelled enumeration: given a species expression and an integer@@ -291,7 +307,7 @@ -- --   Note that @'enumerateU' s n@ is equivalent to @'enumerate' s --   (replicate n ())@.-enumerateU ::  Enumerable f => ESpeciesAST -> Int -> [f ()]+enumerateU ::  Enumerable f => SpeciesAST -> Int -> [f ()] enumerateU s n = enumerateM s (MS.fromCounts [((),n)])  -- | General enumeration: given a species expression and a multiset of@@ -299,16 +315,16 @@ --   the given labels. If the type given for the enumeration does not --   match the species expression, call 'error' with a message --   explaining the mismatch.-enumerateM :: (Enumerable f, Typeable a) => ESpeciesAST -> Multiset a -> [f a]-enumerateM s m = map unsafeExtractStructure $ enumerateE s m+enumerateM :: (Enumerable f, Typeable a) => SpeciesAST -> Multiset a -> [f a]+enumerateM s m = map unsafeExtractStructure $ enumerateE (unerase s) m  -- | Lazily enumerate all unlabelled structures.-enumerateAllU :: Enumerable f => ESpeciesAST -> [f ()]+enumerateAllU :: Enumerable f => SpeciesAST -> [f ()] enumerateAllU s = concatMap (enumerateU s) [0..]  -- | Lazily enumerate all labelled structures, using [1..] as the --   labels.-enumerateAll :: Enumerable f => ESpeciesAST -> [f Int]+enumerateAll :: Enumerable f => SpeciesAST -> [f Int] enumerateAll s = concatMap (\n -> enumerateL s (take n [1..])) [0..]  -- | The 'Enumerable' class allows you to enumerate structures of any@@ -321,8 +337,9 @@ --   custom data type as the target of the enumeration if you don't --   want to. -----   See "Math.Combinatorics.Species.TRec" for some example instances---   of 'Enumerable'.+--   You should only rarely have to explicitly make an instance of+--   'Enumerable' yourself; Template Haskell code to derive instances+--   for you is provided in "Math.Combinatorics.Species.TH". class Typeable1 (StructTy f) => Enumerable (f :: * -> *) where   -- | The standard structure type (see   --   "Math.Combinatorics.Species.Structures") that will map into @f@.
Math/Combinatorics/Species/Labelled.hs view
@@ -2,14 +2,26 @@            , GeneralizedNewtypeDeriving            , PatternGuards   #-}--- | An interpretation of species as exponential generating functions,---   which count labelled structures.++-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Labelled+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- An interpretation of species as exponential generating functions,+-- which count labelled structures.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Labelled     ( labelled     ) where  -- A previous version of this module used an EGF library which--- explicitly computed with EGF's.  However, it turned out to be much+-- explicitly computed with EGFs.  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.@@ -31,16 +43,18 @@ facts = 1 : zipWith (*) [1..] facts  instance Species EGF where-  singleton         = egfFromCoeffs [0,1]-  set               = egfFromCoeffs (map (1%) facts)-  cycle             = egfFromCoeffs (0 : map (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 $ gn-                                                                       in (fs `safeIndex` gn')-                                                                            * toRational (FQ.factorial gn' / FQ.factorial n))-                                                          (zip [0..] $ zipWith (*) (map fromIntegral facts) gs)+  singleton  = egfFromCoeffs [0,1]+  set        = egfFromCoeffs (map (1%) facts)+  cycle      = egfFromCoeffs (0 : map (1%) [1..])+  o          = liftEGF2 PS.compose+  (><)       = liftEGF2 . PS.lift2 $ \xs ys ->+                 zipWith3 mult xs ys (map fromIntegral facts)+                   where mult x y z = x * y * z+  (@@)       = liftEGF2 . PS.lift2 $ \fs gs ->+                 map (\(n,gn) -> let gn' = numerator $ gn+                                 in  (fs `safeIndex` gn') *+                                     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)@@ -55,17 +69,17 @@             Just ls -> ls  -- | Extract the coefficients of an exponential generating function as---   a list of Integers.  Since 'EGF' is an instance of 'Species', the+--   a list of 'Integer's.  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---   (note that @labelled s@ is guaranteed to be an infinite list).+--   of the species DSL.  In particular, @'labelled' s '!!'  n@ is the+--   number of labelled @s@-structures on an underlying set of size @n@+--   (note that @'labelled' s@ is guaranteed to be an infinite list). --   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.+--   gives the number of labelled octopi on 0, 1, 2, 3, ... 9 labels.  labelled :: EGF -> [Integer] labelled (EGF f) = (++repeat 0)
Math/Combinatorics/Species/NewtonRaphson.hs view
@@ -1,12 +1,27 @@ {-# LANGUAGE NoImplicitPrelude   #-} --- | Newton-Raphson's iterative method for computing with recursive---   species.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.CycleIndex+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- The Newton-Raphson iterative method for computing with recursive+-- species.  Any species @T@ which can be written in the form @T =+-- X*R(T)@ (the species of "@R@-enriched rooted trees") may be+-- computed by a quadratically converging iterative process.  In fact+-- we may also compute species of the form @T = N + X*R(T)@ for any+-- integer species @N@, by iteratively computing @T' = X*R(T' + N)@+-- and then adding @N@.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.NewtonRaphson     (       newtonRaphsonIter-    , inits'     , newtonRaphson     , newtonRaphsonRec     , solveForR@@ -17,7 +32,7 @@  import Math.Combinatorics.Species.Class import Math.Combinatorics.Species.AST-import Math.Combinatorics.Species.AST.Instances (reflectU)+import Math.Combinatorics.Species.AST.Instances (reflect) import Math.Combinatorics.Species.Simplify  import Data.Typeable@@ -25,10 +40,12 @@ import Control.Monad (guard) import Data.List (delete) --- | @newtonRaphson r k a@ assumes that @a@ is a species having---   contact of order @k@ with species @t = x * (r `o` t)@ (that is, @a@---   and @t@ agree on all label sets of size up to and including @k@),---   and returns a new species with contact of order @2k+2@ with @t@.+-- | A single iteration of the Newton-Raphson method.+--   @newtonRaphsonIter r k a@ assumes that @a@ is a species having+--   contact of order @k@ with species @t = x '*' (r ``o`` t)@ (that+--   is, @a@ and @t@ agree on all label sets of size up to and+--   including @k@), and returns a new species with contact of order+--   @2k+2@ with @t@. -- --   See BLL section 3.3. newtonRaphsonIter :: Species s => s -> Integer -> s -> s@@ -40,22 +57,32 @@         as = zipWith (+) ps                (map (sum . zipWith (*) qs) $ map reverse (inits' as)) +-- | Lazier version of inits.+inits' :: [a] -> [[a]] inits' xs = [] : inits'' xs-inits'' []     = []-inits'' (x:xs) = map (x:) (inits' xs)+  where inits'' []     = []+        inits'' (x:xs) = map (x:) (inits' xs) --- | Given a species @r@ and a desired accuracy @k@, @newtonRaphson r---   k@ computes a species which has contact at least @k@ with the---   species @t = x * (r `o` t)@.+-- | Given a species @r@ and a desired accuracy @k@, @'newtonRaphson'+--   r k@ computes a species which has contact at least @k@ with the+--   species @t = x '*' (r ``o`` t)@. newtonRaphson :: Species s => s -> Integer -> s newtonRaphson r n = newtonRaphson' 0 0   where newtonRaphson' a k           | k >= n = a           | otherwise = newtonRaphson' (newtonRaphsonIter r k a) (2*k + 2) +-- | @'newtonRaphsonRec' f k@ tries to compute the recursive species+--   represented by the code @f@ up to order at least @k@, using+--   Newton-Raphson iteration.  Returns 'Nothing' if @f@ cannot be+--   written in the form @f = X*R(f)@ for some species @R@. newtonRaphsonRec :: (ASTFunctor f, Species s) => f -> Integer -> Maybe s newtonRaphsonRec code k = fmap (\(n,r) -> n + newtonRaphson r k) (solveForR code) +-- | Given a code @f@ representing a recursive species, try to find an+--   integer species N and species R such that @f = N + X*R(f)@.  If+--   such species can be found, return @'Just' (N,R)@; otherwise+--   return 'Nothing'. solveForR :: (ASTFunctor f, Species s) => f -> Maybe (s, s) solveForR code = do   let terms = sumOfProducts . erase' $ apply code (TRec code)@@ -68,15 +95,15 @@                       ([N n] : ts) -> (N n, ts)                       ts          -> (Zero, ts) -  -- Now we need to be able to factor an TX out of the rest.+  -- Now we need to be able to factor an X out of the rest.   guard $ all (X `elem`) terms' -  -- XXX this is wrong, what if there are still occurrences of TX remaining?-  -- Now replace every recursive occurrence by (n + TX).+  -- XXX this is wrong, what if there are still occurrences of X remaining?+  -- Now replace every recursive occurrence by (n + X).   let r = foldr1 (+) $ map ( foldr1 (*)                            . map (substRec code (n + x))                            . delete X)                        terms' -  return (reflectU n, reflectU r)+  return (reflect n, reflect r) 
Math/Combinatorics/Species/Simplify.hs view
@@ -1,7 +1,18 @@ {-# LANGUAGE NoImplicitPrelude, GADTs #-} --- | Functions to manipulate and simplify species expressions---   according to algebraic species isomorphisms.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Simplify+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Functions to manipulate and simplify species expressions according+-- to algebraic species isomorphisms.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Simplify     ( simplify, sumOfProducts     ) where@@ -15,6 +26,8 @@ import Data.List (genericLength) import Data.Typeable +-- | Given a species expression @s@, return a species expression+--   in normal form which represents a species isomorphic to @s@. simplify :: SpeciesAST -> SpeciesAST simplify Zero          = Zero simplify One           = One
Math/Combinatorics/Species/Structures.hs view
@@ -6,7 +6,19 @@            , EmptyDataDecls   #-} --- | Types used for expressing generic structures when enumerating species.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Structures+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Types used for expressing generic structures when enumerating+-- species.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Structures     ( -- * Structure functors       -- $struct@@ -116,14 +128,14 @@           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.+-- | Cycle structure.  A value of type @'Cycle' a@ is implemented as+--   @[a]@, but thought of as a directed cycle. newtype Cycle a = Cycle { getCycle :: [a] }   deriving (Functor, Typeable) instance (Show a) => Show (Cycle a) where   show (Cycle xs) = "<" ++ intercalate "," (map show xs) ++ ">" --- | Set structure.  A value of type 'Set a' is implemented as '[a]',+-- | 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)@@ -142,10 +154,12 @@   show Star = "*"   show (Original a) = show a --- | Higher-order fixpoint. @'Mu' f a@ is morally isomorphic to @f ('Mu'---   f) a@, except that we actually need a level of indirection.  In---   fact @'Mu' f a@ is isomorphic to @'Interp' f ('Mu' f) a@; @f@ is a---   placeholder which is interpreted by the 'Interp' type function.+-- XXX add some examples for Mu/Interp++-- | Higher-order fixpoint. @'Mu' f a@ is morally isomorphic to @f+--   ('Mu' f) a@, except that we actually need a level of indirection.+--   In fact @'Mu' f a@ is isomorphic to @'Interp' f ('Mu' f) a@; @f@+--   is a code which is interpreted by the 'Interp' type function. data Mu f a = Mu { unMu :: Interp f (Mu f) a }   deriving Typeable 
Math/Combinatorics/Species/TH.hs view
@@ -11,7 +11,7 @@     * need function to compute a (default) species from a Struct.      - currently have structToSp :: Struct -> Q Exp.-     - [TX] refactor it into two pieces, Struct -> SpeciesAST and SpeciesAST -> Q Exp.+     - [X] refactor it into two pieces, Struct -> SpeciesAST and SpeciesAST -> Q Exp.     * should really go through and add some comments to things!      Unfortunately I wasn't good about that when I wrote the code... =P@@ -28,9 +28,24 @@  -} --- | Code to derive species instances for user-defined data types.-module Math.Combinatorics.Species.TH where+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.CycleIndex+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Use Template Haskell to automatically derive species instances for+-- user-defined data types.+--+----------------------------------------------------------------------------- +module Math.Combinatorics.Species.TH+       ( deriveDefaultSpecies+       , deriveSpecies+       ) where+ import NumericPrelude import PreludeBase hiding (cycle) @@ -370,11 +385,46 @@ -- XXX need to add something to check whether the type and given -- species are compatible. +-- | Generate default species declarations for the given user-defined+--   data type.  To use it:+--+--   > {-# LANGUAGE TemplateHaskell,+--   >              TypeFamilies,+--   >              DeriveDataTypeable,+--   >              FlexibleInstances,+--   >              UndecidableInstances #-}+--   >+--   > data MyType = ...+--   >+--   > $(deriveDefaultSpecies ''MyType)+--+--   Yes, you really do need all those extensions.  And don't panic+--   about the @UndecidableInstances@; the instances generated+--   actually are decidable, but GHC just can't tell.+--+--   This is what you get:+--+--     * An 'Enumerable' instance for @MyType@ (and various other+--     supporting things like a code and an 'ASTFunctor' instance if+--     your data type is recursive)+--+--     * A declaration of @myType :: Species s => s@ (the same name as+--     the type constructor but with the first letter lowercased)+--+--   You can then use @myType@ in any species expression, or as input+--   to any function expecting a species.  For example, to count your+--   data type's distinct shapes, you can do+--+--   > take 10 . unlabelled $ myType+-- deriveDefaultSpecies :: Name -> Q [Dec] deriveDefaultSpecies nm = do   st <- nameToStruct nm   deriveSpecies nm (structToSp st) +-- | Like 'deriveDefaultSpecies', except that you specify the species+-- expression that your data type should be isomorphic to.  Note: this+-- is currently experimental (read: bug-ridden). deriveSpecies :: Name -> SpeciesAST -> Q [Dec] deriveSpecies nm sp = do   st <- nameToStruct nm
Math/Combinatorics/Species/Types.hs view
@@ -2,8 +2,19 @@            , GeneralizedNewtypeDeriving   #-} --- | Some common types used by the species library, along with some---   utility functions.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Types+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- Some common types used by the species library, along with some+-- utility functions.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Types     ( -- * Miscellaneous @@ -26,6 +37,8 @@     , liftCI     , liftCI2 +      -- * Series utility functions+     , filterCoeffs     , selectIndex @@ -47,13 +60,13 @@ import qualified Algebra.Field as Field  -- | A representation of the cycle type of a permutation.  If @c ::---   CycleType@ and @(k,n) `elem` c@, then the permutation has @n@+--   CycleType@ and @(k,n) ``elem`` c@, then the permutation has @n@ --   cycles of size @k@. type CycleType = [(Integer, Integer)] ------------------------------------------------------------------------------------  Series types  -----------------------------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------+--  Series types  ------------------------------------------+------------------------------------------------------------  -- | Exponential generating functions, for counting labelled species. newtype EGF = EGF { unEGF :: PS.T Rational }@@ -98,7 +111,9 @@         -> CycleIndex -> CycleIndex -> CycleIndex liftCI2 f (CI x) (CI y) = CI (f x y) --- Some series utility functions+------------------------------------------------------------+--  Some series utility functions  -------------------------+------------------------------------------------------------  -- | Filter the coefficients of a series according to a predicate. filterCoeffs :: (Additive.C a) => (Integer -> Bool) -> [a] -> [a]
Math/Combinatorics/Species/Unlabelled.hs view
@@ -1,5 +1,16 @@--- | An interpretation of species as ordinary generating functions,---   which count unlabelled structures.+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.CycleIndex+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- An interpretation of species as ordinary generating functions,+-- which count unlabelled structures.+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Unlabelled     ( unlabelled ) where @@ -17,33 +28,34 @@ import NumericPrelude import PreludeBase hiding (cycle) -needsCI :: String -> a-needsCI op = error ("unlabelled " ++ op ++ " must go via cycle index series.")+ciErr :: String -> a+ciErr op = error ("unlabelled " ++ op ++ " must go via cycle index series.")  instance Differential.C GF where-  differentiate = needsCI "differentiation"+  differentiate = ciErr "differentiation"  instance Species GF where   singleton         = gfFromCoeffs [0,1]   set               = gfFromCoeffs (repeat 1)   cycle             = set-  o                 = needsCI "composition"-  cartesian         = needsCI "cartesian product"-  fcomp             = needsCI "functor composition"+  o                 = ciErr "composition"+  (><)              = ciErr "cartesian product"+  (@@)              = ciErr "functor composition"   ofSize s p        = (liftGF . PS.lift1 $ filterCoeffs p) s   ofSizeExactly s n = (liftGF . PS.lift1 $ selectIndex n) s -  rec f = case newtonRaphsonRec f 100 of-            Nothing -> error $ "Unable to express " ++ show f ++ " in the form T = TX*R(T)."-            Just ls -> ls+  rec f             = case newtonRaphsonRec f 100 of+                        Nothing -> error $+                          "Unable to express " ++ show f ++ " in the form T = TX*R(T)."+                        Just ls -> ls  unlabelledCoeffs :: GF -> [Integer] unlabelledCoeffs (GF p) = PS.coeffs p ++ repeat 0  -- | 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---   (@unlabelled s@ is guaranteed to be infinite).  For example:+--   list of Integers.  In particular, @'unlabelled' s '!!'  n@ is the+--   number of unlabelled @s@-structures on an underlying set of size+--   @n@ (@unlabelled s@ is guaranteed to be infinite).  For example: -- -- > > take 10 $ unlabelled octopi -- > [0,1,2,3,5,7,13,19,35,59]@@ -52,7 +64,7 @@ -- --   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 'ESpeciesAST' rather than the expected 'GF'.  The reason+--   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, --   other operations such as composition and differentiation do not!@@ -64,7 +76,7 @@ --   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 :: ESpeciesAST -> [Integer]+unlabelled :: SpeciesAST -> [Integer] unlabelled s-  | needsZE s  = unlabelledCoeffs . zToGF . reflect $ s+  | needsCI s = unlabelledCoeffs . zToGF . reflect $ s   | otherwise = unlabelledCoeffs . reflect $ s
Math/Combinatorics/Species/Util/Interval.hs view
@@ -1,9 +1,21 @@ {-# LANGUAGE NoImplicitPrelude   #-}--- | A simple implementation of intervals of natural numbers, for use---   in tracking the possible sizes of structures of a species.  For---   example, the species TX + TX^2 + TX^3 will correspond to the---   interval [1,3].++-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Combinatorics.Species.Util.Interval+-- Copyright   :  (c) Brent Yorgey 2010+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  byorgey@cis.upenn.edu+-- Stability   :  experimental+--+-- A simple implementation of intervals of natural numbers, for use in+-- tracking the possible sizes of structures of a species.  For+-- example, the species @x + x^2 + x^3@ will correspond to the+-- interval [1,3].+--+-----------------------------------------------------------------------------+ module Math.Combinatorics.Species.Util.Interval     (     -- * The 'NatO' type@@ -33,6 +45,7 @@ data NatO = Nat Integer | Omega   deriving (Eq, Ord, Show) +-- | The infinite 'NatO' value. omega :: NatO omega = Omega @@ -75,8 +88,8 @@ --   represents the values 2,3,4,5; [2,omega] represents all integers --   greater than 1; intervals where the first endpoint is greater than the --   second also represent the empty interval.-data Interval = I { iLow  :: NatO-                  , iHigh :: NatO+data Interval = I { iLow  :: NatO -- ^ Get the lower endpoint of an 'Interval'+                  , iHigh :: NatO -- ^ Get the upper endpoint of an 'Interval'                   }   deriving Show 
species.cabal view
@@ -1,5 +1,5 @@ name:           species-version:        0.3.0.1+version:        0.3.0.2 license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -14,6 +14,7 @@                 e.g. counting labelled or unlabelled structures, or generating                 a list of all labeled structures for a species. homepage:       http://www.cis.upenn.edu/~byorgey/species+extra-source-files: CHANGES source-repository head   type:     darcs   location: http://code.haskell.org/~byorgey/code/species