我如何使用递归方案在 Haskell 中表达这种概率分布
How can I use a recursion scheme to express this probability distribution in Haskell
这道题是部分理论/部分实现。背景假设:我正在使用 monad-bayes 库将概率分布表示为单子。分布 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
中抽取一个新字符 c
、将 st++[c]
送回 s
得到的分布,然后很快。我相信 iterateM s
或多或少是我想要的。为了使其成为我们可以实际查看的分布,假设如果我们击中某个角色,我们就会停止。然后 iterateMaybeM
工作。
理论问题:出于各种原因,如果我能用更一般的术语来表达这种分布,例如以一种在给定随机余代数的情况下推广到树的随机构造的方式,那将非常有用。看起来我在这里有某种变形(我意识到数学定义看起来像变形,但在代码中我想建立字符串,而不是将它们解构为概率)但我不能完全弄清楚细节,不是至少是因为概率单子的存在。
实际问题:例如,以使用递归方案库的方式在 Haskell 中实现它也很有用。
我不够聪明,无法通过递归方案对 monad 进行线程化处理,所以我依赖于 recursion-schemes-ext,它具有用于 运行 变形的 anaM 函数,并附加了 monadic 操作。
我在这里做了一个(非常丑陋的)概念证明:
{-# 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
一些笔记
- 我模拟了你的
s
功能,因为我不熟悉 monad-bayes
- 由于我们的最终列表在 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
这道题是部分理论/部分实现。背景假设:我正在使用 monad-bayes 库将概率分布表示为单子。分布 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
中抽取一个新字符 c
、将 st++[c]
送回 s
得到的分布,然后很快。我相信 iterateM s
或多或少是我想要的。为了使其成为我们可以实际查看的分布,假设如果我们击中某个角色,我们就会停止。然后 iterateMaybeM
工作。
理论问题:出于各种原因,如果我能用更一般的术语来表达这种分布,例如以一种在给定随机余代数的情况下推广到树的随机构造的方式,那将非常有用。看起来我在这里有某种变形(我意识到数学定义看起来像变形,但在代码中我想建立字符串,而不是将它们解构为概率)但我不能完全弄清楚细节,不是至少是因为概率单子的存在。
实际问题:例如,以使用递归方案库的方式在 Haskell 中实现它也很有用。
我不够聪明,无法通过递归方案对 monad 进行线程化处理,所以我依赖于 recursion-schemes-ext,它具有用于 运行 变形的 anaM 函数,并附加了 monadic 操作。
我在这里做了一个(非常丑陋的)概念证明:
{-# 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
一些笔记
- 我模拟了你的
s
功能,因为我不熟悉monad-bayes
- 由于我们的最终列表在 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