Haskell / ２つのリストの要素を組み合わせたい（リストモナド）

新旧２つのコーヒーメニューアイテムリストがあり、 そこから同じコーヒー名をもつ新旧アイテムの組み合わせをつくりたい、という問題を考える。

ひとつの方法（方法A）は、ユニークなコーヒー名リストを作成し、 それを使って、新旧２つのリストからそのコーヒー名を持つアイテムを取り出し、新旧アイテムをタプルにする。

もうひとつの方法（方法B）は、新旧２つのコーヒーメニューアイテムリストの各要素ごとの 全ての組み合わせを生成しておき、 その中かから、新旧のアイテムでコーヒー名が一致している組み合わせだけを残す。

方法Aは発想としては分かりやすいけれども、もしひとつのリスト内に同じコーヒー名を持つアイテムが含まれていると困る。 その場合を考慮してコードをかけばよいのだろうけれど、ややこしい気がする。

データ

こんなデータを処理することを考える。

type Name = String
type Price = Int

data Item = Item Name Price deriving (Show)
type ItemSet = (Item, Item)

itemName :: Item -> Name
itemName (Item v _) = v


oldItems :: [Item]
oldItems =
  [ Item "Caffe Americano" 400
  , Item "Pike Place Roast" 450
  , Item "Caffe Misto" 500
  ]

nowItems :: [Item]
nowItems =
  [ Item "Caffe Americano" 420
  , Item "Pike Place Roast" 480
  , Item "Caffe Misto" 580
  ]

方法A

import Data.List

itemNames :: [Name]
itemNames = nub $ map (\item -> itemName item) (oldItems ++ nowItems)

itemSets' :: [ItemSet]
itemSets' = zip oldItems' nowItems'
  where
    oldItems' = map (\name -> findItemByItemName name oldItems) itemNames
    nowItems' = map (\name -> findItemByItemName name nowItems) itemNames
    findItemByItemName :: Name -> [Item] -> Item
    findItemByItemName name items =
      head $ filter (\item -> (itemName item) == name) items

itemNames でユニークなコーヒー名リストをつくり、それを使って新旧のリストから該当アイテムをピックアップして zip する。 もしリスト中に複数該当するアイテムがあった場合は先頭を採用。 該当アイテムが無い場合は考慮していない。

itemSets の内容はこれ:

[ (Item "Caffe Americano" 400, Item "Caffe Americano" 420)
, (Item "Pike Place Roast" 450, Item "Pike Place Roast" 480)
, (Item "Caffe Misto" 500, Item "Caffe Misto" 580)
]

方法B

リスト内包表記を使って、すべての組合わせをつくる:

allItemSets = [(oldItem, nowItem) | oldItem <- oldItems, nowItem <- nowItems]

リスト内包表記を使わなくても do 構文でリストモナドとして同じ機能が記述できる。

allItemSets = do
  oldItem <- oldItems
  nowItem <- nowItems
  return (oldItem, nowItem)

このすべての組み合わせから、コーヒー名が一致している組み合わせだけを残す。

itemSets :: [ItemSet]
itemSets =
  filter
    (\itemSet -> (itemName $ fst itemSet) == (itemName $ snd itemSet))
    allItemSets

おっと、guard を使えば allItemSets と itemSets をひとつにまとめることができます。 このように:

itemSets = do
 oldItem <- oldItems
 nowItem <- nowItems
 guard (itemName oldItem == itemName nowItem)
 return (oldItem, nowItem)

guard を使うには Control.Monad のインポートが必要:

import Control.Monad (guard)

itemSets の内容は方法Aの場合と同じになります。

方法Bの方がコードが短いだけでなく、イレギュラーなデータに対しても機能します。

たとえば、次のように古いリスト( oldItems ) には Pike Place Roast のアイテムが存在しなかった場合。

oldItems :: [Item]
oldItems =
  [ Item "Caffe Americano" 400
  , Item "Caffe Misto" 500
  ]

nowItems :: [Item]
nowItems =
  [ Item "Caffe Americano" 420
  , Item "Pike Place Roast" 480
  , Item "Caffe Misto" 580
  ]

itemSets の内容は以下の通り（Pike Place Roast のアイテムセットは出力されない）:

[ (Item "Caffe Americano" 400, Item "Caffe Americano" 420)
, (Item "Caffe Misto" 500, Item "Caffe Misto" 580)
]

また、別の例として、新しいアイテムリスト（nowItems）には、（間違って）Caffe Misto が２件含まれる場合:

oldItems :: [Item]
oldItems =
  [ Item "Caffe Americano" 400
  , Item "Caffe Misto" 500
  ]

nowItems :: [Item]
nowItems =
  [ Item "Caffe Americano" 420
  , Item "Pike Place Roast" 480
  , Item "Caffe Misto" 580
  , Item "Caffe Misto" 620
  ]

itemSets の内容は以下の通り（Cafe Misto のセットが２つ用意される）:

[ (Item "Caffe Americano" 400, Item "Caffe Americano" 420)
, (Item "Caffe Misto" 500, Item "Caffe Misto" 580)
, (Item "Caffe Misto" 500, Item "Caffe Misto" 620)
]

まとめ

すべての組合わせを生成しておいて、そこからほしいデータのみを抽出する方法はイレギュラーなデータにも強い。

完成したコード main.hs:

import Control.Monad (guard)

type Name = String
type Price = Int

data Item = Item Name Price deriving (Show)
type ItemSet = (Item, Item)

itemName :: Item -> Name
itemName (Item v _) = v


oldItems :: [Item]
oldItems =
  [ Item "Caffe Americano" 400
  , Item "Pike Place Roast" 450
  , Item "Caffe Misto" 500
  ]

nowItems :: [Item]
nowItems =
  [ Item "Caffe Americano" 420
  , Item "Pike Place Roast" 480
  , Item "Caffe Misto" 580
  ]

itemSets :: [ItemSet]
itemSets = do
  oldItem <- oldItems
  nowItem <- nowItems
  guard (itemName oldItem == itemName nowItem)
  return (oldItem, nowItem)