Haskell版 フリーモナドを用いた曲レコメンデーション
2025-08-19 21:00:25
原文: Song recommendations with Haskell free monads by Mark Seemann
驚くほど簡単なリファクタリング
この記事は連載 関数型プログラミングによる設計の代替アプローチ の一部です。概要としては、Haskell、F#、C# を用いて、ある例題に対して内部アーキテクチャをさまざまな形で示しています。これまでに取り上げた内容については、初回記事 に含まれている目次を参照してください。
今回の記事では、データサイズが十分に大きい場合の問題にフリーモナドを用いて対処する方法 を示します。具体的には、アルゴリズムの前段階の結果に応じて、データを少しずつ読み込む必要がある場合です。題材となる問題は、他ユーザーの音楽再生履歴、いわゆる「スクロブル」データに基づいて曲レコメンデーションのリストを計算することです。
Git リポジトリで追いかけたい場合、今回の記事のコードは Haskell リポジトリの free ブランチに含まれています。
出発点
曲レコメンデーションのHaskellへの移植 で提示したコードから書き始めるのではなく、Haskell版 コンビネータを用いた曲レコメンデーション での中間的なリファクタリング段階から始めます。
getRecommendations :: SongService a => a -> String -> IO [Song]
getRecommendations srvc un = do
-- 1. 自ユーザーのトップスクロブルを取得
-- 2. 同じ曲を聴いた他ユーザーを取得
-- 3. そのユーザーのトップスクロブルを取得
-- 4. 曲を集約してレコメンドを生成
-- Impure
scrobbles <- getTopScrobbles srvc un
-- Pure
let scrobblesSnapshot = take 100 $ sortOn (Down . scrobbleCount) scrobbles
-- Impure
recommendations <-
join <$>
traverse (\scrobble ->
fmap join $
traverse (\otherListener ->
fmap scrobbledSong .
take 10 .
sortOn (Down . songRating . scrobbledSong) .
filter (songHasVerifiedArtist . scrobbledSong) <$>
getTopScrobbles srvc (userName otherListener)) .
take 20 <$>
sortOn (Down . userScrobbleCount) .
filter ((10_000 <=) . userScrobbleCount) =<<
getTopListeners srvc (songId $ scrobbledSong scrobble))
scrobblesSnapshot
-- Pure
return $ take 200 $ sortOn (Down . songRating) recommendations
この段階を出発点とする理由は、IORef を排除したことで、残っている IO バインドのコードが SongService のメソッドだけになっているためです。
次の計画は、SongService 型クラスをフリーモナドに置き換えることです。型クラスの置き換えが済めば、IO は完全になくなり、フリーモナドに置き換わります。そのため、まず IO に関わる他の要素を取り除いておく方が簡単です。もし IO を残したままリファクタリングを始めると、作業は難しくなります。Kent Beck が書いたように、
「望む変更ごとに、その変更を簡単にできるようにし（警告: それ自体は難しいかもしれない）、次にその簡単になった変更を行う」
中間段階のコードから始めることで、変更を簡単にできます。
ファンクタ
まず、取り除く対象となる型クラスは以下です。
class SongService a where
getTopListeners :: a -> Int -> IO [User]
getTopScrobbles :: a -> String -> IO [Scrobble]
このような「インターフェース」を命令の直和型に変換する作業は定式化されているので、自動化さえ可能だと思います（もしそれに値するなら）。型クラスの各メソッドを直和型のケースとして表現すればよいのです。
data SongInstruction a =
GetTopListeners Int ([User] -> a)
| GetTopScrobbles String ([Scrobble] -> a)
deriving (Functor)
直和型で定義された SongInstruction は、小さなドメイン固有言語（DSL）の命令集合を表現しています。今回の DSL には、GetTopListeners と GetTopScrobbles の2種類の命令しかありません。
フリーモナドを初めて見る読者は「a とは何か？」と疑問に思うかもしれません。a は「キャリア型」と呼ばれるものです。例えば F-代数 を扱ったことがなければ慣れるまで時間がかかりますが、キャリア型は「可能性」を表します。定義上は任意の型ですが、プログラムを評価または実行するときには、その a が評価の戻り値型になります。
SongInstruction は Functor であるため、型 a を型 b に写すことが可能です。つまり、DSL で記述した小さな「プログラム」の中で、a 型パラメータは複数の具体的な型を持つことができます。
まとめると、SongInstruction a は現時点では単なる Functor であり、まだ Monad ではありません。
フリーモナド
必要であれば、SongInstruction a（正確にはその Free ラッパー）を Monad にするための型エイリアスを導入できます。
type SongProgram = Free SongInstruction
Free ラッパーは Control.Monad.Free から提供されます。
以降に示すコード例では、型エイリアス SongFree を使用していません。ただし、テストを実行したときにGlasgow Haskell Compiler が推論する型がこのエイリアスに一致するため、紹介しています。事実上、この記事で扱うフリーモナドはこの型エイリアスです。
アクションから関数へ
getRecommendations アクションを Free (SongInstruction [Song]) を返す関数に変える作業は、予想よりも簡単でした。
私は可能な限り型宣言を省略する方針を採用しているため、リファクタリングは容易でした。型推論システムが関数やアクションの型の変更を呼び出し元まで伝播させてくれるからです。ただしこの記事では読者の理解を助けるため、一部のコードに型注釈を追加しています（Git リポジトリには存在しません）。
まず、「プログラム命令」を生成できるいくつかのヘルパーメソッドを追加しました。
getTopListeners sid = liftF $ GetTopListeners sid id
getTopScrobbles un = liftF $ GetTopScrobbles un id
liftF 関数は Functor（ここでは SongInstruction）をフリーモナドに包み込みます。これにより、DSL でプログラムを書きやすくなります。
getRecommendations に必要な変更は、4か所で srvc を削除することだけでした。
getRecommendations :: MonadFree SongInstruction m => String -> m [Song]
getRecommendations un = do
-- 1. 自ユーザーのトップスクロブルを取得
-- 2. 同じ曲を聴いた他ユーザーを取得
-- 3. そのユーザーのトップスクロブルを取得
-- 4. 曲を集約してレコメンドを生成
-- Impure
scrobbles <- getTopScrobbles un
-- Pure
let scrobblesSnapshot = take 100 $ sortOn (Down . scrobbleCount) scrobbles
-- Impure
recommendations <-
join <$>
traverse (\scrobble ->
fmap join $
traverse (\otherListener ->
fmap scrobbledSong .
take 10 .
sortOn (Down . songRating . scrobbledSong) .
filter (songHasVerifiedArtist . scrobbledSong) <$>
getTopScrobbles (userName otherListener)) .
take 20 <$>
sortOn (Down . userScrobbleCount) .
filter ((10_000 <=) . userScrobbleCount) =<<
getTopListeners (songId $ scrobbledSong scrobble))
scrobblesSnapshot
-- Pure
return $ take 200 $ sortOn (Down . songRating) recommendations
コードの大部分は以前と同じですが、変更点は srvc が getRecommendations、getTopListeners、getTopScrobbles のパラメータではなくなったことです。
ここで戻り値型が m [Song] になっていることがわかります。ここで m は任意の MonadFree SongInstruction です。
インタープリター
曲レコメンデーションのHaskellへの移植 で説明したように、私は FakeSongService をテストダブル として使っています。SongService はなくなりましたが、FakeSongService の実装を SongInstruction プログラムのインタープリターとして再利用できます。
interpret :: FakeSongService -> Free SongInstruction a -> a
interpret (FakeSongService ss us) = iter eval
where
eval (GetTopListeners sid next) =
next $
uncurry User <$>
Map.toList (sum <$> Map.filter (Map.member sid) us)
eval (GetTopScrobbles un next) =
next $
fmap (\(sid, c) -> Scrobble (ss ! sid) c) $
Map.toList $
Map.findWithDefault Map.empty un us
このインタープリターを 曲レコメンデーションのHaskellへの移植 に示した SongService のインスタンスと比べると、関数はほとんど同じで、return が next に置き換わっていることと、わずかな差分しかありません。
テストの変更
今回のリファクタリングで最も大変だったのは、テストコードの調整です。脳に収まるコードの書き方 で述べたように、私はテスト対象システム（SUT）とテストコードを同じコミットで変更することを好みません。しかし今回は、より段階的に進める技術が私にはありませんでした。
課題は、SongService のメソッドが IO バインドされていたため、テストが IO で実行されていたことです。特に QuickCheck のプロパティテストでは、ioProperty や monadicIO コンビネータを削除する必要がありました。それに伴い、一部のアサーションも調整しました。例えば "One user, some songs" テストは次のようになります。
testProperty "One user, some songs" $ \
(ValidUserName user)
(fmap getSong -> songs)
-> do
scrobbleCounts <- vectorOf (length songs) $ choose (1, 100)
let scrobbles = zip songs scrobbleCounts
let srvc = foldr (uncurry (scrobble user)) emptyService scrobbles
let actual = interpret srvc $ getRecommendations user
return $ counterexample "Should be empty" (null actual)
getRecommendations の適用の左側にインタープリターがある点に注目してください。interpret は任意の Free SongInstruction a を a に還元します。したがって、Free SongInstruction [Song] を [Song] に評価し、それが actual の型になります。
テストコードの変更は全体的にメリットが大きいと考えています。すべてのテストが純粋になり、IO で実行されなくなったためです。結果としてテストがシンプルになりました。
最終的なリファクタリング
これまで紹介したコードは、フリーモナドに移行するための良い出発点にすぎません。よく使われるヘルパー関数を抽出すると、次のような getRecommendations 関数にできます。
getRecommendations un = do
-- 1. 自ユーザーのトップスクロブルを取得
-- 2. 同じ曲を聴いた他ユーザーを取得
-- 3. そのユーザーのトップスクロブルを取得
-- 4. 曲を集約してレコメンドを生成
userTops <- getTopScrobbles un <&> getUsersOwnTopScrobbles
otherListeners <-
traverse (getTopListeners . (songId . scrobbledSong)) userTops <&>
getOtherUsersWhoListenedToTheSameSongs . join
songs <-
traverse (getTopScrobbles . userName) otherListeners <&>
getTopScrobblesOfOtherUsers . join
return $ aggregateTheSongsIntoRecommendations songs
この関数は 曲レコメンデーションのHaskellへの移植 に示したバリエーションと非常によく似ています。相違点は、srvc パラメータが存在しない点です。
まとめ
他言語でいうインターフェースに相当する型クラスからのリファクタリングは非常に簡単で、「目的は何か」と疑問に思うかもしれません。最大の利点は、選択肢を制限できることです。数年前にポッドキャストで議論したように、制約は自由をもたらす のです。今回のリファクタリングでは、「何でもできる」IO から、限られた命令集合に移行しています。
もちろん「本物の」インタープリター（テスト専用ではないもの）は IO で動作する可能性があります。この記事で紹介した別のインタープリター のようにです。しかし、一般的にインタープリターは小規模で安定しており、フリーモナドで記述するプログラムよりも複雑さが少ないと考えています。したがって、レビュー対象となる「何でもできるコード」の量が減ります。
結論として、Haskell でのフリーモナドへのリファクタリングは大きな困難を伴いませんでした。次は、F# におけるフリーモナドへのリファクタリングがどれほど簡単なのかを検討します。