Haskell - Zusammenfassende Wahrscheinlichkeitsliste

Question

Ich gehe durch Learn You A Haskell und habe gerade den Teil "Für ein paar Monaden mehr" abgeschlossen. In diesem Teil haben wir eine newtype Prob a = Prob { getProb :: [(a, Rational)] } erstellt und eine Monad Instanz dafür erstellt. Dies erlaubt uns, Wahrscheinlichkeiten der Ergebnisse in nicht-deterministischen Berechnungen zu berechnen wie folgt aus:

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

Natürlich ist dies nicht erzeugt ein sehr schönes Ergebnis:

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

Es wurde als Übung an den Leser, um eine ordentliche Funktion zu schreiben, um alle False s und alle True s zusammenzufassen, so erhalten wir [(True,9 % 40),(False,31 % 40)]. Ich habe es irgendwie geschafft. Es funktioniert für diesen speziellen Fall, aber ich habe das Gefühl, dass es überhaupt keine nützliche Funktion ist, da es so spezialisiert ist. Hier ist, was ich kam mit:

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

Ich würde es lieben, zu verallgemeinern für jeden Eq a => Prob a zu arbeiten, aber bisher kein Glück. Ich dachte daran, vielleicht eine Map zusammen mit unionWith oder etwas ähnliches zu verwenden. Oder kann ich die Tatsache ausnutzen, dass eine Functor b Instanz hat? Ich denke, ich vermisse eine einfachere, elegantere Lösung.

Also, um es zusammenzufassen: Wie kann ich eine Funktion schreiben sumProbs :: (Eq a) => Prob a -> Prob a, die alle Wahrscheinlichkeiten zusammenfasst, die den gleichen Wert (Schlüssel) teilen?

Answer 1

Wenn Sie Data.Map verwenden, dann fromListWith und toList tun:

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 

---

Relaxing Ord a-Eq a würde eine weniger effiziente quadratische Berechnung erfordern; etwas wie:

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 

Answer 2

Verwenden Sie Map ist eine gute Idee, aber Sie benötigen Ord a zusätzlich zu Eq a. Wenn Sie mit dem ok sind, dann können wir auch einfachere Lösung Liste: nur ersetzen partition mit einer Kombination aus sortBy und 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