How can I use a recursion scheme to express this probability distribution in Haskell

Question

This question is part of the theory / part of the implementation. Estimated Assumption: I am using the monad-bayes library to represent probability distributions as monads. The distribution p (a | b) can be represented as a function MonadDist m => b -> m a.

Suppose I have a conditional probability distribution s :: MonadDist m => [Char] -> m Char. I want to get a new probability distribution sUnrolled :: [Char] -> m [Char]defined mathematically (I think) as:

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

Intuitively, this is the distribution that you will get by taking st :: [Char], taking a sample of char cfrom s st, loading st++[c]back into sand so on. I believe that iterateM smore or less what I want. To make this a distribution that we could really take a look at, let's say that if we hit a certain character, we will stop. Then it works iterateMaybeM.

Theory of the Question. For various reasons, it would be very useful if I could express this distribution in more general terms, for example, in a way that is generalized to the stochastic construction of a tree taking into account the stochastic coalgebra. It seems that I have some kind of anamorphism here (I understand that the mathematical definition looks like a catamorphism, but in the code I want to build lines, not deconstruct them in probability), but I can not completely parse the details, not at least due to the presence of a probabilistic monad.

Practical question: It would also be useful to implement this in Haskell in a way that used a recursion schema library, for example.

Answer 1

, , -ext, anaM .

( ) :

{-# 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
• , . ( s 2000 ).

EDIT:

, , ( , ) . 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