haskell - 我如何使用递归方案来表达 Haskell 中的概率分布

Question

这个问题部分是理论，部分是实现。背景假设:我正在使用 monad-bayes将概率分布表示为单子(monad)的库。分布 p(a|b) 可以表示为函数 MonadDist m => b -> m a。

假设我有一个条件概率分布s::MonadDist m => [Char] -> m Char。我想获得一个新的概率分布 sUnrolled::[Char] -> m [Char]，数学上定义为(我认为):

sUnrolled(chars|st) = 
              | len(chars)==1 -> s st
              | otherwise -> s(chars[-1]|st++chars[:-1]) * sUnrolled(chars[:-1]|st)

直观上，它是通过获取 st::[Char]、从 s st 采样新的 char c、馈送 st++[c] 返回到 s，依此类推。我相信 iterateM s 或多或少是我想要的。为了使其成为我们实际上可以查看的分布，假设如果我们遇到某个字符，我们就会停止。然后 iterateMaybeM 就可以工作了。

理论问题:出于各种原因，如果我能用更通用的术语来表达这种分布，例如在给定随机余代数的情况下推广到树的随机构造，那将非常有用。看起来我在这里有某种变形(我意识到数学定义看起来像变形，但在代码中我想构建字符串，而不是将它们解构为概率)但我不能完全弄清楚细节，不是至少是因为概率单子(monad)的存在。

实际问题:例如，在 Haskell 中以使用递归方案库的方式实现这一点也很有用。

Answer 1

我不够聪明，无法通过递归方案对单子(monad)进行线程化，因此我依赖于 recursion-schemes-ext，它具有 anaM 函数，用于运行附加单子(monad)操作的变形。

我在这里做了一个(非常丑陋的)概念证明:

{-# LANGUAGE FlexibleContexts #-}
import Data.Functor.Foldable (ListF(..), Base, Corecursive)
import Data.Functor.Foldable.Exotic (anaM)
import System.Random

s :: String -> IO (Maybe Char)
s st = do
  continue <- getStdRandom $ randomR (0, 2000 :: Int)
  if continue /= 0
    then do
    getStdRandom (randomR (0, length st - 1)) >>= return . Just . (st !!)
    else return Nothing


result :: (Corecursive t, Traversable (Base t), Monad m) => (String -> m (Base t String)) -> String -> m t
result f = anaM f

example :: String -> IO (Base String String)
example st = maybe Nil (\c -> Cons c $ c:st) <$> s st

final :: IO String
final = result example "asdf"

main = final >>= print

一些注释

1. 我模拟了您的 s 函数，因为我不熟悉 monad-bayes
2. 由于我们的最终列表位于 monad 内，因此我们必须严格构建它。这迫使我们制作一个有限的列表(我允许我的 s 函数随机停止在 2000 个字符左右)。

编辑:

下面是一个修改版本，它确认结果函数可以生成其他递归结构(在本例中为二叉树)。请注意，final 的类型和 example 的值是之前代码中唯一发生更改的两位。

{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
import Data.Functor.Foldable (ListF(..), Base, Corecursive(..))
import Data.Functor.Foldable.Exotic (anaM)
import Data.Monoid
import System.Random

data Tree a = Branch a (Tree a) (Tree a) | Leaf
  deriving (Show, Eq)
data TreeF a b = BranchF a b b | LeafF

type instance Base (Tree a) = TreeF a
instance Functor Tree where
  fmap f (Branch a left right) = Branch (f a) (f <$> left) (f <$> right)
  fmap f Leaf = Leaf
instance Functor (TreeF a) where
  fmap f (BranchF a left right) = BranchF a (f left) (f right)
  fmap f LeafF = LeafF
instance Corecursive (Tree a) where
  embed LeafF = Leaf
  embed (BranchF a left right) = Branch a left right
instance Foldable (TreeF a) where
  foldMap f LeafF = mempty
  foldMap f (BranchF a left right) = (f left) <> (f right)
instance Traversable (TreeF a) where
  traverse f LeafF = pure LeafF
  traverse f (BranchF a left right) = BranchF a <$> f left <*> f right

s :: String -> IO (Maybe Char)
s st = do
  continue <- getStdRandom $ randomR (0, 1 :: Int)
  if continue /= 0
    then getStdRandom (randomR (0, length st - 1)) >>= return . Just . (st !!)
    else return Nothing


result :: (Corecursive t, Traversable (Base t), Monad m) => (String -> m (Base t String)) -> String -> m t
result f = anaM f

example :: String -> IO (Base (Tree Char) String)
example st = maybe LeafF (\c -> BranchF c (c:st) (c:st)) <$> s st

final :: IO (Tree Char)
final = result example "asdf"

main = final >>= print