計算機科学のブログ

data Events = Events [String] deriving (Show)

data Probs = Probs [Double] deriving (Show)

cartCombine :: (a -> b -> c) -> [a] -> [b] -> [c]
cartCombine func l1 l2 =
  let nToAdd = length l2
      repeatedL1 = map (take nToAdd . repeat) l1
      newL1 = mconcat repeatedL1
      cycledL2 = cycle l2
   in zipWith func newL1 cycledL2

instance Semigroup Events where
  (<>) (Events e1) (Events e2) =
    let combiner = \x y -> mconcat [x, "-", y]
     in Events $ cartCombine combiner e1 e2

instance Semigroup Probs where
  (<>) (Probs p1) (Probs p2) = Probs $ cartCombine (*) p1 p2

coinEvents :: Events
coinEvents = Events ["heads", "tails"]

coinProbs :: Probs
coinProbs = Probs [0.5, 0.5]

spinnerEvents :: Events
spinnerEvents = Events ["red", "blue", "green"]

spinnerProbs :: Probs
spinnerProbs = Probs [0.1, 0.2, 0.7]

main = do
  print $ (<>) coinEvents spinnerEvents
  print $ (<>) coinProbs spinnerProbs

% runghc sample2.hs
Events ["heads-red","heads-blue","heads-green","tails-red","tails-blue","tails-green"]
Probs [5.0e-2,0.1,0.35,5.0e-2,0.1,0.35]
%