Safe Haskell | Safe |
---|---|
Language | Haskell98 |
- amb :: [b] -> AmbT r m b
- aPartitionOfSize :: (Eq a, Monad m) => Int -> [a] -> AmbT r m [[a]]
- aPartitionOf :: (Eq t, Monad m) => [t] -> AmbT r m [[t]]
- aPermutationOf :: [a] -> AmbT r m [a]
- aSplitOf :: [a] -> AmbT r m ([a], [a])
- anIntegerBetween :: (Monad m, Num b, Ord b) => b -> b -> AmbT r m b
- aSubsetOf :: [AmbT r m a] -> AmbT r m [a]
- aMemberOf :: [b] -> AmbT r m b
- aBoolean :: AmbT r m Bool
- isPossible :: Amb Bool Bool -> Bool
- isPossibleT :: Monad m => AmbT Bool m Bool -> m Bool
- isNecessary :: Amb Bool Bool -> Bool
- isNecessaryT :: Monad m => AmbT Bool m Bool -> m Bool
- allValues :: Amb t t -> [t]
- allValuesT :: Monad m => AmbT t m t -> m [t]
- oneValue :: Amb a a -> a
- oneValueT :: Monad m => AmbT b m b -> m b
- tell' :: Monad m => [r] -> AmbT r m ()
- tellState :: (Monoid s, MonadState s m) => s -> m ()
- uponFailure :: AmbT r m a -> AmbT r m ()
- runAmbT :: Monad m => AmbT t m t -> m (t, [t])
- runAmbTI :: Monad m => AmbT a m a -> AmbT a m a -> m (a, [a])
- ambCC :: ((a -> AmbT r m a1) -> AmbT r m a) -> AmbT r m a
- forEffects :: Monad m => ((t, [t]) -> r) -> (t1 -> AmbT t m t) -> AmbT t m t1 -> m r
- data AmbT r m a = AmbT {}
- type AmbT' m a = forall r. AmbT r m a
- type Amb r = AmbT r Identity
- type Amb' a = AmbT' Identity a
- module Control.Applicative
Overview
A nondeterministic computation makes a series of choices which it
can then backtrack to. You can select between computations with
'(|)' or mplus
and abort a line of computation with empty
or
mzero
As an example, here is a program which computes Pythagorean triples of a certain size.
import Control.Monad import Control.Monad.Amb pyTriple :: (Num t, Ord t) => t -> Amb r (t, t, t) pyTriple n = do a <-anIntegerBetween
1 n b <-anIntegerBetween
(a + 1) n c <-anIntegerBetween
(b + 1) n when (a*a + b*b /= c*c)empty
return (a,b,c)
You can run this computation and ask for one or more of its possible values.
>>>
oneValue $ pyTriple 20
(3,4,5)
>>>
allValues $ pyTriple 20
[(3,4,5),(5,12,13),(6,8,10),(8,15,17),(9,12,15),(12,16,20)]
Creating computations
amb :: [b] -> AmbT r m b Source
Just for fun. This is McCarthy's amb
operator and is a synonym
for aMemberOf
.
aPartitionOfSize :: (Eq a, Monad m) => Int -> [a] -> AmbT r m [[a]] Source
Generate all partitions of a given size of this list.
aPartitionOf :: (Eq t, Monad m) => [t] -> AmbT r m [[t]] Source
Generate all partitions of this list.
aPermutationOf :: [a] -> AmbT r m [a] Source
Generate all permutations of a list.
anIntegerBetween :: (Monad m, Num b, Ord b) => b -> b -> AmbT r m b Source
Generate all numbers between the given bounds, inclusive.
aSubsetOf :: [AmbT r m a] -> AmbT r m [a] Source
Generate each subset of any size from the given list.
aBoolean :: AmbT r m Bool Source
The most basic primitive that everything else is built out
of. Generates True
and False
.
Running computations
isPossible :: Amb Bool Bool -> Bool Source
Run a nondeterministic computation and return True
if any result is True
, False
otherwise.
isPossibleT :: Monad m => AmbT Bool m Bool -> m Bool Source
Run a nondeterministic computation and return True
if any result is True
, False
otherwise.
isNecessary :: Amb Bool Bool -> Bool Source
Run a nondeterministic computation and return True
if all possible results are True
, False
otherwise.
isNecessaryT :: Monad m => AmbT Bool m Bool -> m Bool Source
Run a nondeterministic computation and return True
if all possible results are True
, False
otherwise.
allValues :: Amb t t -> [t] Source
Run a nondeterministic computation and return a list of all results that the computation can produce. Note that this function is not lazy its result.
allValuesT :: Monad m => AmbT t m t -> m [t] Source
Run a nondeterministic computation and return a list of all results that the computation can produce. Note that this function is not lazy its result.
oneValue :: Amb a a -> a Source
Run a nondeterministic computation and return a result of that computation.
oneValueT :: Monad m => AmbT b m b -> m b Source
Run a nondeterministic computation and return a result of that computation.
Low-level internals
tellState :: (Monoid s, MonadState s m) => s -> m () Source
A helper to inject state into the backtracking stack
uponFailure :: AmbT r m a -> AmbT r m () Source
When the nondeterministic computation backtracks past this state, execute this nondeterministic computation. Generally used to undo side effects.
runAmbT :: Monad m => AmbT t m t -> m (t, [t]) Source
Run the nondeterministic computation. This is internal.
runAmbTI :: Monad m => AmbT a m a -> AmbT a m a -> m (a, [a]) Source
Run the nondeterministic computation. This is internal.
ambCC :: ((a -> AmbT r m a1) -> AmbT r m a) -> AmbT r m a Source
call/cc lifted into the nondeterministic monad. This implements the backtracking behaviour which allows Amb to try different code paths and return multiple results.
forEffects :: Monad m => ((t, [t]) -> r) -> (t1 -> AmbT t m t) -> AmbT t m t1 -> m r Source
A low-level internal function which executes a nondeterministic computation for its nondeterministic side-effects, such as its ability to produce different results.
Types
AmbT r m a
is a computation whose current value is of type a
and which will ultimately return a value of type r
. The same as
ContT
.
module Control.Applicative