Copyright | (c) Brent Yorgey 2010 |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | byorgey@cis.upenn.edu |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
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.
- class C s => Species s where
- oneHole :: Species s => s -> s
- x :: Species s => s
- sets :: Species s => s
- cycles :: Species s => s
- necklace :: Species s => s
- necklaces :: Species s => s
- bracelets :: Species s => s
- linOrds :: Species s => s
- subsets :: Species s => s
- ksubsets :: Species s => Integer -> s
- elements :: Species s => s
- bag :: Species s => s
- bags :: Species s => s
- pointed :: Species s => s -> s
- octopus :: Species s => s
- octopi :: Species s => s
- partition :: Species s => s
- partitions :: Species s => s
- permutation :: Species s => s
- permutations :: Species s => s
- ballot :: Species s => s
- ballots :: Species s => s
- simpleGraph :: Species s => s
- simpleGraphs :: Species s => s
- directedGraph :: Species s => s
- directedGraphs :: Species s => s
The Species type class
class C s => Species s where Source #
The Species type class. Note that the Differential
constraint
requires s to be a differentiable ring, which means that every
instance must also implement instances for Algebra.Additive
(the species 0 and species addition, i.e. disjoint sum),
Algebra.Ring (the species 1 and species multiplication,
i.e. partitional product), and Algebra.Differential (species
differentiation, i.e. adjoining a distinguished element).
Note that the o
operation can be used infix to suggest common
notation for composition, and also to be read as an abbreviation
for "of", as in "top o' the mornin'": set `o` nonEmpty
sets
.
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.
The species E
of sets. Puts a singleton structure on any
underlying label set.
The species C
of cyclical orderings (cycles/rings).
The species of bracelets (i.e. cycles that can also be flipped).
The species L
of linear orderings (lists). Since linear
orderings are isomorphic to cyclic orderings with a hole, we
may take
as the default
implementation; linOrd
= oneHole
cycle
linOrd
is included in the Species
class so it
can be special-cased for enumeration.
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
directly.set
* set
ksubset :: Integer -> s Source #
Subsets of size exactly k,
. Included with a default definition
in the ksubset
k = (set
`ofSizeExactly` k) * set
Species
class for the same reason as subset
.
Structures of the species e
of elements are just elements of
the underlying set,
. Included
with a default definition in element
= singleton
* set
Species
class for the same
reason as subset
and ksubset
.
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.
Cartisian product of two species. An (f
-structure
consists of an ><
g)f
-structure superimposed on a g
-structure over
the same underlying set.
Functor composition of two species. An (f @@ g)
-structure
consists of an f
-structure on the set of all g
-structures.
ofSize :: s -> (Integer -> Bool) -> s Source #
Only put a structure on underlying sets whose size satisfies the predicate.
ofSizeExactly :: s -> Integer -> s Source #
Only put a structure on underlying sets of the given size. A
default implementation of ofSize (==k)
is provided, but this
method is included in the Species
class as a special case
since it can be more efficient: we get to turn infinite lists
of coefficients into finite ones.
Don't put a structure on the empty set. The default definition
uses ofSize
; included in the Species
class so it can be
overriden in special cases (such as when reifying species
expressions).
rec :: ASTFunctor f => f -> s Source #
rec f
is the least fixpoint of (the interpretation of) the
higher-order species constructor f
.
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.
Convenience methods
oneHole :: Species s => s -> s Source #
A convenient synonym for differentiation.
-structures look like oneHole
ff
-structures on a set formed by adjoining
a distinguished "hole" element to the underlying set.
Plurals and synonyms
It can be grammatically convenient to define plural
versions of species as synonyms for the singular versions.
For example, we can use
instead of set
o
nonEmpty
sets
.set
o
nonEmpty
set
Derived operations
Some derived operations on species.
Derived species
Some species that can be defined in terms of the primitive species operations.
partitions :: Species s => s Source #
permutation :: Species s => s Source #
A permutation is a set of disjoint cycles:
.permutation
= set
`o` cycles
permutations :: Species s => s Source #
A permutation is a set of disjoint cycles:
.permutation
= set
`o` cycles
simpleGraph :: Species s => s Source #
Simple graphs (undirected, without loops). A simple graph is a
subset of the set of all size-two subsets of the vertices:
.simpleGraph
= subset
@@ (ksubset
2)
simpleGraphs :: Species s => s Source #
Simple graphs (undirected, without loops). A simple graph is a
subset of the set of all size-two subsets of the vertices:
.simpleGraph
= subset
@@ (ksubset
2)
directedGraph :: Species s => s Source #