私は、Haskellで非決定論的なモナド変換子を構築したいと思います。これは、ListTやhttp://www.haskell.org/haskellwiki/ListT_done_rightで提案されている代替のListTとは異なる動作をすると思います。これらの最初のものは、モナドをアイテムのリストに関連付けます。2つ目は、モナドを個々のアイテムに関連付けますが、特定の要素のモナドアクションが、リストの後続のスロットのモナド要素に影響を与えるというプロパティを持っています。目標は、次の形式のモナド変換子を作成することです。
data Amb m a = Cons (m a) (Amb m a) | Empty
リストのすべての要素に独自のモナドが関連付けられ、連続する要素には独立したモナドが関連付けられます。この投稿の最後に、このモナドが与えるべき動作の種類について少し説明します。この動作を実現するためにListTのバリアントを取得する方法を知っている場合は、それも役立ちます。
以下は私の試みです。unpack関数が定義されていないため、不完全です。どうすれば定義できますか？Emptyこれを定義するための不完全な試みが1つありますが、モナドmに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
望ましい動作の例
ここで、ベースモナドは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]