Safe Haskell | None |
---|
LogicGrowsOnTrees
Contents
Description
Basic functionality for building and exploring trees.
- type Tree = TreeT Identity
- type TreeIO = TreeT IO
- newtype TreeT m α = TreeT {
- unwrapTreeT :: ProgramT (TreeTInstruction m) m α
- class MonadPlus m => MonadExplorable m where
- cache :: Serialize x => x -> m x
- cacheGuard :: Bool -> m ()
- cacheMaybe :: Serialize x => Maybe x -> m x
- processPendingRequests :: m ()
- class (MonadPlus m, Monad (NestedMonad m)) => MonadExplorableTrans m where
- type NestedMonad m :: * -> *
- runAndCache :: Serialize x => NestedMonad m x -> m x
- runAndCacheGuard :: NestedMonad m Bool -> m ()
- runAndCacheMaybe :: Serialize x => NestedMonad m (Maybe x) -> m x
- exploreTree :: Monoid α => Tree α -> α
- exploreTreeT :: (Monad m, Monoid α) => TreeT m α -> m α
- exploreTreeTAndIgnoreResults :: Monad m => TreeT m α -> m ()
- exploreTreeUntilFirst :: Tree α -> Maybe α
- exploreTreeTUntilFirst :: Monad m => TreeT m α -> m (Maybe α)
- exploreTreeUntilFound :: Monoid α => (α -> Bool) -> Tree α -> (α, Bool)
- exploreTreeTUntilFound :: (Monad m, Monoid α) => (α -> Bool) -> TreeT m α -> m (α, Bool)
- allFrom :: (Foldable t, Functor t, MonadPlus m) => t α -> m α
- between :: (Enum n, MonadPlus m) => n -> n -> m n
- endowTree :: Monad m => Tree α -> TreeT m α
- data TreeTInstruction m α where
- Cache :: Serialize α => m (Maybe α) -> TreeTInstruction m α
- Choice :: TreeT m α -> TreeT m α -> TreeTInstruction m α
- Null :: TreeTInstruction m α
- ProcessPendingRequests :: TreeTInstruction m ()
- type TreeInstruction = TreeTInstruction Identity
Tree types
The following are the tree types that are accepted by most of the functions in this package. You do not need to know the details of their definitions unless you intend to write your own custom routines for running and transforming trees, in which case the relevant information is at the bottom of this page in the Implementation section.
There is one type of pure tree and two types of impure trees. In general, your tree should nearly always be pure if you are planning to make use of checkpointing or parallel exploring, as parts of the tree may be explored multiple times, some parts may not be run at all on a given processor, and whenever a leaf is hit there will be a jump to a higher node, so if your tree is impure then the result needs to not depend on how the tree is explored; an example of an acceptable use of an inner monad is when you want to memoize a pure function using a stateful monad.
If you need something like state in your tree, then you should consider nesting the tree monad in the state monad rather than vice-versa, because this will do things like automatically erasing the change in state that happened between an inner node and a leaf when the tree jumps back up from the leaf to an inner node, which will usually be what you want.
A tree running in the I/O monad, which you should only be using for doing things like reading data from an external file or database that will be constant for the entire run.
A tree run in an arbitrary monad.
Constructors
TreeT | |
Fields
|
Instances
MonadTrans TreeT | |
Eq α => Eq (Tree α) | Two |
Monad m => Monad (TreeT m) | |
Monad m => Functor (TreeT m) | |
Show α => Show (Tree α) | |
Monad m => MonadPlus (TreeT m) | For this type, |
Monad m => Applicative (TreeT m) | |
Monad m => Alternative (TreeT m) | The |
MonadIO m => MonadIO (TreeT m) | |
Monad m => MonadExplorableTrans (TreeT m) | |
Monad m => MonadExplorable (TreeT m) | |
Monad m => Monoid (TreeT m α) |
Explorable class features
Tree
s are instances of MonadExplorable
and MonadExplorableTrans
,
which are both subclasses of MonadPlus
. The additional functionality offered
by these type-classes is the ability to cache results so that a computation does
not need to be repeated when a node is explored a second time, which can happen
either when resuming from a checkpoint or when a workload has been stolen by
another processor, as the first step is to retrace the path through the tree
that leads to the stolen workload.
These features could have been provided as functions, but there are two reasons
why they were subsumed into type-classes: first, because one might want to
add another layer above the Tree
monad transformers in the monad stack
(as is the case in LogicGrowsOnTrees.Location), and second, because one might want
to run a tree using a simpler monad such as List for testing purposes.
NOTE: Caching a computation takes space in the Checkpoint
, so it is something
you should only do when the result is relatively small and the
computation is very expensive and is high enough in the search tree that
it is likely to be repeated often. If the calculation is low enough in
the search tree that it is unlikely to be repeated, is cheap enough so
that repeating it is not a big deal, or produces a result with an
incredibly large memory footprint, then you are probably better off not
caching the result.
class MonadPlus m => MonadExplorable m whereSource
The MonadExplorable
class provides caching functionality when exploring a
tree, as well as a way to give a worker a chance to process any pending
requests; at minimum cacheMaybe
needs to be defined.
Methods
cache :: Serialize x => x -> m xSource
Cache a value in case we explore this node again.
cacheGuard :: Bool -> m ()Source
This does the same thing as guard
but it caches the result.
cacheMaybe :: Serialize x => Maybe x -> m xSource
This function is a combination of the previous two; it performs a
computation which might fail by returning Nothing
, and if that happens
it then backtracks; if it passes then the result is cached and returned.
Note that the previous two methods are essentially specializations of this method.
processPendingRequests :: m ()Source
This function tells the worker to take a break to process any pending requests; it does nothing if we are not in a parallel setting.
NOTE: You should normally never need to use this function, as requests are processed whenever a choice point, a cache point, mzero, or a leaf in the decision tree has been encountered. However, if you have noticed that workload steals are taking such a large amount of time that workers are spending too much time sitting idle while they wait for a workload, and you can trace this as being due to a computation that takes so much time that it almost never gives the worker a chance to process requests, then you can use this method to ensure that requests are given a chance to be processed.
Instances
MonadExplorable [] | This instance performs no caching but is provided to make it easier to test running a tree using the List monad. |
MonadExplorable Maybe | This instance performs no caching but is provided to make it easier to test
running a tree using the |
Monad m => MonadExplorable (ListT m) | This instance performs no caching but is provided to make it easier to test
running a tree using the |
Monad m => MonadExplorable (MaybeT m) | This instance performs no caching but is provided to make it easier to test
running a tree using the |
Monad m => MonadExplorable (TreeT m) |
class (MonadPlus m, Monad (NestedMonad m)) => MonadExplorableTrans m whereSource
This class is like MonadExplorable
, but it is designed to work with monad
stacks; at minimum runAndCacheMaybe
needs to be defined.
Associated Types
type NestedMonad m :: * -> *Source
The next layer down in the monad transformer stack.
Methods
runAndCache :: Serialize x => NestedMonad m x -> m xSource
Runs the given action in the nested monad and caches the result.
runAndCacheGuard :: NestedMonad m Bool -> m ()Source
Runs the given action in the nested monad and then does the equivalent
of feeding it into guard
, caching the result.
runAndCacheMaybe :: Serialize x => NestedMonad m (Maybe x) -> m xSource
Instances
Monad m => MonadExplorableTrans (ListT m) | Like the |
Monad m => MonadExplorableTrans (MaybeT m) | Like the |
Monad m => MonadExplorableTrans (TreeT m) | |
Monad m => MonadExplorableTrans (LocatableTreeT m) | |
MonadExplorableTrans m => MonadExplorableTrans (LocatableT m) |
Functions
There are three kinds of functions in this module: functions that explore trees in various ways, functions that make it easier to build trees, and a function that changes the base monad of a pure tree.
...that explore trees
The following functions all take a tree as input and produce the result of exploring it as output. There are seven functions because there are two kinds of trees --- pure and impure --- and three ways of exploring a tree --- exploring everything and summing all results (i.e., in the leaves), exploring until the first result (i.e., in a leaf) is encountered and immediately returning, and gathering results (i.e., from the leaves) until they satisfy a condition and then returning --- plus a seventh function that explores a tree only for the side-effects.
Explores all the nodes in a pure tree and sums over all the results in the leaves.
Arguments
:: (Monad m, Monoid α) | |
=> TreeT m α | the (impure) tree to be explored |
-> m α | the sum over all results |
Explores all the nodes in an impure tree and sums over all the results in the leaves.
exploreTreeTAndIgnoreResultsSource
Explores a tree for its side-effects, ignoring all results.
Arguments
:: Monad m | |
=> TreeT m α | the (impure) tree to be explored |
-> m (Maybe α) | the first result found, if any |
Same as exploreTreeUntilFirst
, but taking an impure tree instead
of pure one.
Arguments
:: Monoid α | |
=> (α -> Bool) | a function that determines when the desired results have been found |
-> Tree α | the (pure) tree to be explored |
-> (α, Bool) | the result of the exploration, which includes the results that were found and a flag indicating if they matched the condition function |
Explores all the nodes in a tree, summing all encountered results (i.e., in
the leaves) until the current partial sum satisfies the condition provided
by the first function. The returned value is a pair where the first
component is all of the results that were found during the exploration and
the second component is True
if the exploration terminated early due to
the condition being met and False
otherwise.
NOTE: The condition function is assumed to have two properties: first, it
is assumed to return False
for mempty
, and second, it is assumed
that if it returns True
for x
then it also returns True
for
mappend x y
and mappend y x
for all values y
. The reason for
this is that the condition function is used to indicate when enough
results have been found, and so it should not be True
for mempty
as nothing has been found and if it is True
for x
then it should
not be False
for the sum of y
with x
as this would mean that
having more than enough results is no longer having enough results.
Arguments
:: (Monad m, Monoid α) | |
=> (α -> Bool) | a function that determines when the desired results have been
found; it is assumed that this function is |
-> TreeT m α | the (impure) tree to be explored |
-> m (α, Bool) | the result of the exploration, which includes the results that were found and a flag indicating if they matched the condition function |
Same as exploreTreeUntilFound
, but taking an impure tree instead of
a pure tree.
...that help building trees
The following functions all create a tree from various inputs.
Arguments
:: (Foldable t, Functor t, MonadPlus m) | |
=> t α | the list (or some other |
-> m α | a tree that generates the given list of results |
Returns a tree (or some other MonadPlus
) with all of the results in the
input list.
...that transform trees
Arguments
:: Monad m | |
=> Tree α | the pure tree to transformed into an impure tree |
-> TreeT m α | the resulting impure tree |
This function lets you take a pure tree and transform it into a tree with an arbitrary base monad.
Implementation
The implementation of the Tree
types uses the approach described in "The
Operational Monad Tutorial", published in
Issue 15 of The Monad.Reader;
specifically it uses the operational
package. The idea is that a list of
instructions are provided in TreeTInstruction
, and then the operational monad
does all the heavy lifting of turning them into a monad.
data TreeTInstruction m α whereSource
The core of the implementation of Tree
is mostly contained in this
type, which provides a list of primitive instructions for trees:
Cache
, which caches a value, Choice
, which signals a branch with two
choices, Null
, which indicates that there are no more results, and
ProcessPendingRequests
, which signals that a break should be taken from
exploration to process any pending requests (only meant to be used in
exceptional cases).
Constructors
Cache :: Serialize α => m (Maybe α) -> TreeTInstruction m α | |
Choice :: TreeT m α -> TreeT m α -> TreeTInstruction m α | |
Null :: TreeTInstruction m α | |
ProcessPendingRequests :: TreeTInstruction m () |
type TreeInstruction = TreeTInstruction IdentitySource
This is just a convenient alias for working with pure trees.