Will Kurt Get Programming in Haskell, use Applicatives for Lesson 17 exercises.

lesson17Applicative.hs

{-
Makes the code much simpler than using cycle and other methods for Cartesian sums
-}

module PTableApplicative where 

import Control.Applicative (liftA2)

type Events = [String]
type Probs = [Double]

data PTable = PTable Events Probs 

-- Define a function that combines two lists using a binary function
cartCombine :: (a -> b -> c) -> [a] -> [b] -> [c]
cartCombine func l1 l2 = func <$> l1 <*> l2


{-
cartCombine :: (a -> b -> c) -> [a] -> [b] -> [c]
cartCombine func l1 l2 = liftA2 func l1 l2
-}
-- Define a function that combines two lists of events
combineEvents :: Events -> Events -> Events 
combineEvents = cartCombine (\x y -> mconcat [x, "-", y])

-- Define a function that combines two lists of probabilities
combineProbs :: Probs -> Probs -> Probs 
combineProbs = cartCombine (*)

createPTable :: Events -> Probs -> PTable 
createPTable events probs = PTable events normalizedProbs 
    where totalProbs = sum probs
          normalizedProbs = map (\x -> x/totalProbs) probs

-- Define how to combine two probability tables
instance Semigroup PTable where 
    (<>) :: PTable -> PTable -> PTable
    (<>) ptable1 (PTable [] []) = ptable1  -- If the second table is empty, return the first table
    (<>) (PTable [] []) ptable2 = ptable2  -- If the first table is empty, return the second table
    (<>) (PTable e1 p1) (PTable e2 p2) = createPTable (combineEvents e1 e2) (combineProbs p1 p2)  -- If both tables have data, combine them

showPair :: String -> Double -> String 
showPair event prob = mconcat [event, "|", show prob, "\n"]

instance Show PTable where 
    show :: PTable -> String
    show (PTable events probs) = mconcat pairs 
        where pairs = zipWith showPair events probs 

coinProbs = [0.5, 0.5]
coinEvents = ["heads", "tails"]

spinnerProbs = [0.1, 0.2, 0.7]
spinnerEvents = ["red", "blue", "green"]

coin :: PTable 
coin = createPTable coinEvents coinProbs

spinner :: PTable 
spinner  = createPTable spinnerEvents spinnerProbs