在haskell中构建一个不确定的monad变换器

时间:2012-12-14 19:10:09

标签: haskell monad-transformers non-deterministic

我想在haskell中构建一个非确定性monad变换器,我相信它与ListT和http://www.haskell.org/haskellwiki/ListT_done_right提出的替代ListT的行为不同。第一个将monad与一个项目列表联系起来;第二个将monad与单个项目关联,但具有属性,即给定元素中的monadic动作会影响列表后续插槽中的monadic元素。目标是建立一个形式为

的monad变换器
data Amb m a = Cons (m a) (Amb m a) | Empty

这样列表的每个元素都有自己的monad与之相关联,并且连续元素具有独立的monad。在这篇文章的最后,我对这个monad应该给出的行为进行了一些演示。如果您知道如何获取ListT的某些变体来提供此行为,那么这也会有所帮助。

以下是我的尝试。它不完整,因为unpack函数未定义。我该如何定义它?这是一个不完整的定义它的尝试,但是当monad m包含Empty Amb列表时它不会处理这种情况:

unpack :: (Monad m) => m (Amb m a) -> Amb m a                                                                                                                 
unpack m = let first = join $ do (Cons x ys) <- m                                                                                                             
                                 return x                                                                                                                     
               rest =  do (Cons x ys) <- m                                                                                                                    
                          return ys                                                                                                                           
           in Cons first (unpack rest)   

完整(不完整)代码:

import Prelude hiding  (map, concat)                                                                                                                          
import Control.Monad                                                                                                                                          
import Control.Monad.Trans       

data Amb m a = Cons (m a) (Amb m a) | Empty                                                                                                                   

infixr 4 <:>                                                                                                                                                  
(<:>) = Cons                                                                                                                                                  

map :: Monad m => (a -> b) -> Amb m a -> Amb m b                                                                                                              
map f (Cons m xs) = Cons y (map f xs)                                                                                                                         
    where y = do a <- m                                                                                                                                       
                 return $ f a                                                                                                                                 
map f Empty = Empty                                                                                                                                           

unpack :: m (Amb m a) -> Amb m a                                                                                                                              
unpack m = undefined                                                                                                                                          


concat :: (Monad m) => Amb m (Amb m a) -> Amb m a                                                                                                             
concat (Cons m xs)  = (unpack m) `mplus` (concat xs)                                                                                                          
concat  Empty = Empty                                                                                                                                         

instance Monad m => Monad (Amb m) where                                                                                                                       
    return x = Cons (return x) Empty                                                                                                                          
    xs >>= f = let yss = map f xs                                                                                                                             
               in concat yss                                                                                                                                  

instance Monad m => MonadPlus (Amb m) where                                                                                                                   
    mzero = Empty                                                                                                                                             
    (Cons m xs) `mplus` ys = Cons m (xs `mplus` ys)                                                                                                           
    Empty `mplus` ys = ys                                                                                                                                     

instance MonadTrans Amb where                                                                                                                                 
    lift m = Cons m Empty        

所需行为的示例

此处,基本monad为State Int

instance Show a => Show (Amb (State Int) a) where                                                                                                             
    show m = (show .  toList) m                                                                                                                               


toList :: Amb (State Int) a -> [a]                                                                                                                            
toList Empty = []                                                                                                                                             
toList (n `Cons` xs) = (runState n 0 : toList xs)                                                                                                             


x = (list $ incr) >> (incr <:> incr <:> Empty)                                                                                                                
y = (list $ incr) >> (incr <:> (incr >> incr) <:> Empty)                                                                                                      

main = do                                                                                                                                                     
  putStr $ show x -- | should be [2, 2]                                                                                                                       
  putStr $ show y -- | should be [2, 3]   

感谢。

更新:LogicT没有按照我的意愿行事的一个例子。

以下是LogicT在上述简单示例中的作用:

import Control.Monad                                                                                                                                          
import Control.Monad.Logic                                                                                                                                    
import Control.Monad.State                                                                                                                                    

type LogicState = LogicT (State Int)                                                                                                                          


incr :: State Int Int                                                                                                                                         
incr = do i <- get                                                                                                                                            
          put (i + 1)                                                                                                                                         
          i' <- get                                                                                                                                           
          return i'                                                                                                                                           

incr' = lift incr                                                                                                                                             
y =  incr' >> (incr' `mplus` incr')                                                                                                                           

main = do                                                                                                                                                     
  putStrLn $ show (fst $ runState (observeAllT y) 0)   -- | returns [2,3], not [2,2]                                                                                                       

2 个答案:

答案 0 :(得分:3)

我相信你可以使用StateT。例如:

import Control.Monad.State

incr = modify (+1)
sample1 = incr `mplus` incr
sample2 = incr `mplus` (incr >> incr)

monomorphicExecStateT :: StateT Int [] a -> Int -> [Int]
monomorphicExecStateT = execStateT

main = do
    print (monomorphicExecStateT sample1 0) -- [1, 1]
    print (monomorphicExecStateT sample2 0) -- [1, 2]

答案 1 :(得分:1)

我不认为在一般情况下这是可能的(并且monad变换器应该能够转换任何monad)。你提到的解压缩选项一般不适用于monad - 它对应于操作:

extract :: (Comonad w) => w a -> a

这是对comonad的操作(monad的数学对偶)。

有些事情可以通过取(m(Amb ma))并将其映射几次以在每种情况下生成单个(ma)来“解包”它,但这需要您提前知道(或相反,从monad外部)创建了多少选择,如果没有某种形式的提取操作,你就无法知道。

在第二个ListT中,列表尾部依赖于monadic动作的原因是因为我们需要在某些情况下执行monadic动作以便找出生成了多少选项(因此列表的长度是)。