diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -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 diff --git a/Math/Combinatorics/Species.hs b/Math/Combinatorics/Species.hs --- a/Math/Combinatorics/Species.hs +++ b/Math/Combinatorics/Species.hs @@ -33,8 +33,6 @@ -- $synonyms , oneHole - , madeOf - , (><), (@@) , x, sets, cycles , linOrds , subsets diff --git a/Math/Combinatorics/Species/AST.hs b/Math/Combinatorics/Species/AST.hs --- a/Math/Combinatorics/Species/AST.hs +++ b/Math/Combinatorics/Species/AST.hs @@ -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 diff --git a/Math/Combinatorics/Species/AST/Instances.hs b/Math/Combinatorics/Species/AST/Instances.hs --- a/Math/Combinatorics/Species/AST/Instances.hs +++ b/Math/Combinatorics/Species/AST/Instances.hs @@ -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 diff --git a/Math/Combinatorics/Species/Class.hs b/Math/Combinatorics/Species/Class.hs --- a/Math/Combinatorics/Species/Class.hs +++ b/Math/Combinatorics/Species/Class.hs @@ -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 diff --git a/Math/Combinatorics/Species/CycleIndex.hs b/Math/Combinatorics/Species/CycleIndex.hs --- a/Math/Combinatorics/Species/CycleIndex.hs +++ b/Math/Combinatorics/Species/CycleIndex.hs @@ -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 (( 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 (( 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) diff --git a/Math/Combinatorics/Species/Enumerate.hs b/Math/Combinatorics/Species/Enumerate.hs --- a/Math/Combinatorics/Species/Enumerate.hs +++ b/Math/Combinatorics/Species/Enumerate.hs @@ -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@. diff --git a/Math/Combinatorics/Species/Labelled.hs b/Math/Combinatorics/Species/Labelled.hs --- a/Math/Combinatorics/Species/Labelled.hs +++ b/Math/Combinatorics/Species/Labelled.hs @@ -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) diff --git a/Math/Combinatorics/Species/NewtonRaphson.hs b/Math/Combinatorics/Species/NewtonRaphson.hs --- a/Math/Combinatorics/Species/NewtonRaphson.hs +++ b/Math/Combinatorics/Species/NewtonRaphson.hs @@ -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) diff --git a/Math/Combinatorics/Species/Simplify.hs b/Math/Combinatorics/Species/Simplify.hs --- a/Math/Combinatorics/Species/Simplify.hs +++ b/Math/Combinatorics/Species/Simplify.hs @@ -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 diff --git a/Math/Combinatorics/Species/Structures.hs b/Math/Combinatorics/Species/Structures.hs --- a/Math/Combinatorics/Species/Structures.hs +++ b/Math/Combinatorics/Species/Structures.hs @@ -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 diff --git a/Math/Combinatorics/Species/TH.hs b/Math/Combinatorics/Species/TH.hs --- a/Math/Combinatorics/Species/TH.hs +++ b/Math/Combinatorics/Species/TH.hs @@ -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 diff --git a/Math/Combinatorics/Species/Types.hs b/Math/Combinatorics/Species/Types.hs --- a/Math/Combinatorics/Species/Types.hs +++ b/Math/Combinatorics/Species/Types.hs @@ -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] diff --git a/Math/Combinatorics/Species/Unlabelled.hs b/Math/Combinatorics/Species/Unlabelled.hs --- a/Math/Combinatorics/Species/Unlabelled.hs +++ b/Math/Combinatorics/Species/Unlabelled.hs @@ -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 diff --git a/Math/Combinatorics/Species/Util/Interval.hs b/Math/Combinatorics/Species/Util/Interval.hs --- a/Math/Combinatorics/Species/Util/Interval.hs +++ b/Math/Combinatorics/Species/Util/Interval.hs @@ -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 diff --git a/species.cabal b/species.cabal --- a/species.cabal +++ b/species.cabal @@ -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