Personal tools

Amb

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (update)
Current revision (22:05, 17 April 2008) (edit) (undo)
m (Categorize)
 
(One intermediate revision not shown.)
Line 1: Line 1:
 +
[[Category:Monad]] [[Category:Code]] [[Category:Idioms]]
This is an implementation of the [http://www.randomhacks.net/articles/2005/10/11/amb-operator <code>amb</code> operator] in Haskell. Interestingly, it is identical to the list monad: remove 'amb' and the examples below work fine (apart, of course, from the IO one).
This is an implementation of the [http://www.randomhacks.net/articles/2005/10/11/amb-operator <code>amb</code> operator] in Haskell. Interestingly, it is identical to the list monad: remove 'amb' and the examples below work fine (apart, of course, from the IO one).
Line 10: Line 11:
import Control.Monad.Identity
import Control.Monad.Identity
-
type Point r s m = () -> AmbT r s m s
+
newtype AmbT r m a = AmbT { unAmbT :: StateT [AmbT r m r] (ContT r m) a }
-
newtype AmbT r s m a = AmbT { unAmbT :: StateT [Point r s m] (ContT r m) a }
+
type Amb r = AmbT r Identity
-
type Amb r s = AmbT r s Identity
+
-
instance MonadTrans (AmbT r s) where
+
instance MonadTrans (AmbT r) where
lift = AmbT . lift . lift
lift = AmbT . lift . lift
-
instance (Monad m) => Monad (AmbT r s m) where
+
instance (Monad m) => Monad (AmbT r m) where
AmbT a >>= b = AmbT $ a >>= unAmbT . b
AmbT a >>= b = AmbT $ a >>= unAmbT . b
return = AmbT . return
return = AmbT . return
-
backtrack :: (Monad m) => AmbT r s m a
+
backtrack :: (Monad m) => AmbT r m a
backtrack = do xss <- AmbT get
backtrack = do xss <- AmbT get
case xss of
case xss of
[] -> fail "amb tree exhausted"
[] -> fail "amb tree exhausted"
-
(f:xs) -> do AmbT $ put xs
+
(f:xs) -> do AmbT $ put xs; f; return undefined
-
f ()
+
-
return undefined
+
-
addPoint :: (Monad m) => Point r s m -> AmbT r s m ()
+
addPoint :: (Monad m) => (() -> AmbT r m r) -> AmbT r m ()
-
addPoint x = AmbT $ modify (x:)
+
addPoint x = AmbT $ modify (x () :)
-
amb :: (Monad m) => [a] -> AmbT r s m a
+
amb :: (Monad m) => [a] -> AmbT r m a
amb [] = backtrack
amb [] = backtrack
amb (x:xs) = ambCC $ \exit -> do
amb (x:xs) = ambCC $ \exit -> do
Line 39: Line 37:
where ambCC f = AmbT $ callCC $ \k -> unAmbT $ f $ AmbT . k
where ambCC f = AmbT $ callCC $ \k -> unAmbT $ f $ AmbT . k
-
cut :: (Monad m) => AmbT r s m ()
+
cut :: (Monad m) => AmbT r m ()
cut = AmbT $ put []
cut = AmbT $ put []
-
runAmbT :: (Monad m) => AmbT r s m r -> m r
+
runAmbT :: (Monad m) => AmbT r m r -> m r
runAmbT (AmbT a) = runContT (evalStateT a []) return
runAmbT (AmbT a) = runContT (evalStateT a []) return
-
runAmb :: Amb r s r -> r
+
runAmb :: Amb r r -> r
runAmb = runIdentity . runAmbT
runAmb = runIdentity . runAmbT
</haskell>
</haskell>
Line 52: Line 50:
<haskell>
<haskell>
-
example :: Amb r Integer (Integer,Integer)
+
example :: Amb r (Integer,Integer)
example = do x <- amb [1,2,3]
example = do x <- amb [1,2,3]
y <- amb [4,5,6]
y <- amb [4,5,6]
Line 59: Line 57:
else amb []
else amb []
-
factor :: Integer -> Amb r Integer (Integer,Integer)
+
factor :: Integer -> Amb r (Integer,Integer)
factor a = do x <- amb [2..]
factor a = do x <- amb [2..]
y <- amb [2..x]
y <- amb [2..x]
Line 66: Line 64:
else amb []
else amb []
-
factorIO :: Integer -> AmbT r Integer IO (Integer,Integer)
+
factorIO :: Integer -> AmbT r IO (Integer,Integer)
factorIO a = do lift $ putStrLn $ "Factoring " ++ show a
factorIO a = do lift $ putStrLn $ "Factoring " ++ show a
x <- amb [2..]
x <- amb [2..]
Line 76: Line 74:
else do lift $ putStrLn $ "Nope (" ++ show (x*y) ++ ")"
else do lift $ putStrLn $ "Nope (" ++ show (x*y) ++ ")"
amb []
amb []
 +
</haskell>
 +
 +
The extra 'r' can be avoided if you're not using strict Haskell-98:
 +
 +
<haskell>
 +
type AmbT' m a = forall r. AmbT r m a
 +
type Amb' a = AmbT' Identity a
</haskell>
</haskell>

Current revision

This is an implementation of the amb operator in Haskell. Interestingly, it is identical to the list monad: remove 'amb' and the examples below work fine (apart, of course, from the IO one).

Notably, AmbT could be considered ListT done right. 

module Amb (AmbT, Amb, amb, cut, runAmbT, runAmb) where
 
import Control.Monad.Cont
import Control.Monad.State
import Control.Monad.Identity
 
newtype AmbT r m a = AmbT { unAmbT :: StateT [AmbT r m r] (ContT r m) a }
type Amb r = AmbT r Identity
 
instance MonadTrans (AmbT r) where
    lift = AmbT . lift . lift
 
instance (Monad m) => Monad (AmbT r m) where
    AmbT a >>= b = AmbT $ a >>= unAmbT . b
    return = AmbT . return
 
backtrack :: (Monad m) => AmbT r m a
backtrack = do xss <- AmbT get
               case xss of
                 [] -> fail "amb tree exhausted"
                 (f:xs) -> do AmbT $ put xs; f; return undefined
 
addPoint :: (Monad m) => (() -> AmbT r m r) -> AmbT r m ()
addPoint x = AmbT $ modify (x () :)
 
amb :: (Monad m) => [a] -> AmbT r m a
amb []     = backtrack
amb (x:xs) = ambCC $ \exit -> do
               ambCC $ \k -> addPoint k >> exit x
               amb xs
    where ambCC f = AmbT $ callCC $ \k -> unAmbT $ f $ AmbT . k
 
cut :: (Monad m) => AmbT r m ()
cut = AmbT $ put []
 
runAmbT :: (Monad m) => AmbT r m r -> m r
runAmbT (AmbT a) = runContT (evalStateT a []) return
 
runAmb :: Amb r r -> r
runAmb = runIdentity . runAmbT

And some examples: 

example :: Amb r (Integer,Integer)
example = do x <- amb [1,2,3]
             y <- amb [4,5,6]
             if x*y == 8
               then return (x,y)
               else amb []
 
factor :: Integer -> Amb r (Integer,Integer)
factor a = do x <- amb [2..]
              y <- amb [2..x]
              if x*y == a
                then return (x,y)
                else amb []
 
factorIO :: Integer -> AmbT r IO (Integer,Integer)
factorIO a = do lift $ putStrLn $ "Factoring " ++ show a
                x <- amb [2..]
                y <- amb [2..x]
                lift $ putStrLn $ "Trying " ++ show x ++ " and " ++ show y
                if x*y == a
                  then do lift $ putStrLn "Found it!"
                          return (x,y)
                  else do lift $ putStrLn $ "Nope (" ++ show (x*y) ++ ")"
                          amb []

The extra 'r' can be avoided if you're not using strict Haskell-98: 

type AmbT' m a = forall r. AmbT r m a
type Amb' a = AmbT' Identity a
Retrieved from "http://www.haskell.org/haskellwiki/Amb"

Categories: Monad | Code | Idioms