使用 monads：折叠其部分内容

Question

我刚刚完成学习 Haskell 的学习，但我仍在努力学习如何使用 Monads。

在本章的最后for a few monads more作者给出了一个练习（倒数第二段）。具体来说，他鼓励我们编写一个函数，将所有 (False, Rational) 值折叠成单个值 (False, sum Rationals).

我已经写出本章中出现的所有代码，并将相关部分包含在此处

import Data.Ratio
import Control.Monad
import Control.Applicative
import Data.List (all)

newtype Prob a = Prob { getProb :: [(a, Rational)]} deriving (Show)

instance Functor Prob where
    fmap f (Prob xs) = Prob $ map (\(x, p) -> (f x, p)) xs

flatten :: Prob (Prob a) -> Prob a
flatten (Prob xs) = Prob $ concat $ map multAll xs
    where multAll (Prob innerxs, p) = map (\(x, r) -> (x, p*r)) innerxs

instance Applicative Prob where
    pure  = return
    (<*>) = ap

instance Monad Prob where
    return x = Prob [(x, 1%1)]
    m >>= f = flatten (fmap f m)
    fail _ = Prob []

data Coin = Heads | Tails deriving (Show, Eq)

coin :: Prob Coin
coin = Prob [(Heads, 1%2), (Tails, 1%2)]

loadedCoin :: Prob Coin
loadedCoin = Prob [(Heads, 1%10), (Tails, 9%10)]

flipThree :: Prob Bool
flipThree = do
    a <- coin
    b <- coin
    c <- loadedCoin
    return (all (== Tails) [a, b, c])

当我运行这个代码时，我得到

ghci> getProb  flipThree
[(False,1 % 40),(False,9 % 40),(False,1 % 40),(False,9 % 40),(False,1 % 40),(False,9 % 40),(False,1 % 40),(True,9 % 40)]

我想以某种方式过滤 flipThree 中第一个位置有 False 的元素，然后对相关概率求和。我已经编写了一些丑陋的非 monadic 代码来执行此操作，但我相信有更好的方法。

所需的输出将是

ghci> getProb  flipThree
[(False,31 % 40),(True,9 % 40)]

Answer 1

您想要的功能是

import Data.Function
import Data.List 

runProb :: Eq a => Prob a -> [(a, Rational)]
runProb =  map (\x -> (fst (head x), sum (map snd x))) 
         . groupBy ((==) `on` fst) 
         . getProb

所以

>runProb flipThree
[(False,31 % 40),(True,9 % 40)]

你也可以让你的类型成为 MonadPlus 的一个实例来排序得到这个结果 "directly":

instance MonadPlus Prob where 
  mzero = Prob [] 
  mplus (Prob x) (Prob y) = Prob (x++y) 

flipThree' = do
    a <- coin
    b <- coin
    c <- loadedCoin
    guard (all (== Tails) [a, b, c])

> runProb flipThree'
[((),9 % 40)]

使用 monads：折叠其部分内容

Using monads: folding over part of its contents

haskell