Personal tools

Amb

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
m (update)
(Code is much nicer now. One less type parameter. Is 'r' the correct name for that, though?)
Line 10: Line 10:
 
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 36: Line 36:
 
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 49: Line 49:
   
 
<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 56: Line 56:
 
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 63: Line 63:
 
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 73: Line 73:
 
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>

Revision as of 15:39, 28 March 2008

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