Haskell - подвести итоги списка вероятностей

Я прохожу через Learn You A Haskell и только что закончил часть "Еще на несколько монад". В этой части мы создали newtype Prob a = Prob { getProb :: [(a, Rational)] } и создал Monad пример для этого. Это позволяет нам вычислять вероятности результатов в недетерминированных вычислениях как следующее:

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)]

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

Конечно, это не дает очень красивый результат:

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

Читателю было предложено написать аккуратную функцию, чтобы суммировать все Falseи все Trueс, так что мы получаем [(True,9 % 40),(False,31 % 40)], Мне удалось сделать это, вроде. Это работает для этого конкретного случая, но я чувствую, что это не полезная функция вообще, так как это настолько специализировано. Вот что я придумал:

sumProbs :: Prob Bool -> Prob Bool
sumProbs (Prob ps) = let (trues, falses) = partition fst ps
                         ptrue = reduce trues
                         pfalse = reduce falses
                     in Prob [ptrue, pfalse]
                     where reduce = foldr1 (\(b,r) (_,r') -> (b,r+r'))

Я хотел бы обобщить это, чтобы работать для любого Eq a => Prob a, но пока не повезло. Я думал о том, возможно, используя Map вместе с unionWith или что-то типа того. Или, может быть, я могу использовать тот факт, что (a,b) имеет Functor b пример? Я думаю, что мне не хватает более простого и элегантного решения.

Итак, подведем итог: как я могу написать функцию sumProbs :: (Eq a) => Prob a -> Prob a что суммирует все вероятности, которые имеют одинаковое значение (ключ)?

2 ответа

Решение

Если вы используете Data.Map, затем fromListWith а также toList Сделаю:

import Data.Map (toList, fromListWith)

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

sumProbs :: (Ord a) => Prob a -> Prob a
sumProbs = Prob . toList . fromListWith (+) . getProb

Расслабляющий Ord a в Eq a потребует менее эффективного квадратичного вычисления; что-то вроде:

sumProbs :: (Eq a) => Prob a -> Prob a
sumProbs = Prob . foldr go [] . getProb
    where
    go (x, y) = run
        where
        run [] = (x, y):[]
        run ((a, b):rest)
            | x == a    = (x, y + b): rest
            | otherwise = (a, b): run rest

С помощью Map это хорошая идея, но вам нужно Ord a в дополнение к Eq a, Если вы согласны с этим, тогда мы можем сделать более простое решение для списка: просто замените partition с сочетанием sortBy а также groupBy:

import Data.List (groupBy, sortBy)
import Data.Function (on)

sumProbs :: (Ord a) => Prob a -> Prob a
sumProbs (Prob ps) = Prob . map reduce
                   . groupBy ((==)`on`fst)
                   $ sortBy (compare`on`fst) ps
Другие вопросы по тегам