型によるプログラミング合成によるデザイン:SemigroupとMonoid シノニム、データ型、リファクタリング

入門Haskellプログラミング
 楽天ブックス
Yahoo!ショッピング
au PAY マーケット

開発環境

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT3(型によるプログラミング)、LESSON 17(合成によるデザイン:SemigroupとMonoid)、17.5(練習問題)Q17-2の解答を求めてみる。

コード

lesson/app/Main.hs

module Main where

import Lib

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

probs :: Probs
probs = Probs [0.5, 0.5]

main :: IO ()
main = do
  print $ events <> events
  print $ probs <> probs

lesson/src/Lib.hs

module Lib where

data Events = Events [String] deriving (Show)

instance Semigroup Events where
  (<>) (Events xs) (Events ys) =
    Events $ cartCombine (\x y -> mconcat [x, "-", y]) xs ys

instance Monoid Events where
  mempty = Events []
  mappend = (<>)

data Probs = Probs [Double] deriving (Show)

instance Semigroup Probs where
  (<>) (Probs xs) (Probs ys) =
    Probs $ cartCombine (*) xs ys

instance Monoid Probs where
  mempty = Probs []
  mappend = (<>)

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

入出力結果(Terminal, Zsh)

% stack exec lesson-exe
Events ["heads-heads","heads-tails","tails-heads","tails-tails"]
Probs [0.25,0.25,0.25,0.25]
%