F#版 フリーモナドを用いた曲レコメンデーション
2025-08-25 23:00:25
原文: Song recommendations with F# free monads
拡張されたコンピュテーション式を用いて
この記事は 関数型プログラミングによる設計の代替アプローチ というシリーズの一部です。タイトルが示すとおり、代替的な 関数型プログラミングのアーキテクチャ を検討しています。その方法として、同じ例題を扱います。それは、多数のユーザーの再生データ（スクロブル）の大規模データセットから曲レコメンデーションを計算するという問題です。前回の記事では、Haskell におけるフリーモナドを用いた実装方法 を紹介しました。今回は、F# におけるフリーモナドの活用方法を見ていきます。
付随する Git リポジトリを追っている場合、この記事で示すコードは fsharp-free ブランチにあります。開始地点は fsharp-port ブランチです。
ファンクター
フリーモナドは、任意の ファンクター から モナド を定義することを可能にします。この文脈では、ドメイン固有言語（DSL）の命令セットをモデル化するファンクターから始めます。目的は、この命令セットによって SongService インターフェースを置き換えることです。
念のため、このインターフェースを振り返ってみましょう。
type SongService =
abstract GetTopListenersAsync : songId : int -> Task<IReadOnlyCollection<User>>
abstract GetTopScrobblesAsync : userName : string -> Task<IReadOnlyCollection<Scrobble>>
私は F# フリーモナドのレシピ に従っていますが、嬉しいことに簡単に実装できました。
まずは 直和型 からです。
type SongInstruction<'a> =
| GetTopListeners of songId : int * (IReadOnlyCollection<User> -> 'a)
| GetTopScrobbles of userName : string * (IReadOnlyCollection<Scrobble> -> 'a)
SongService インターフェースのメソッドと SongInstruction の各ケースを比較すると、両者の類似点や、インターフェースから判別共用体へ移行する方法が見えてくるでしょう。
前回の記事 で示したように、Haskell では型が Functor インスタンスであることを宣言的に指定できますが、F# では自分で実装する必要があります。
module SongInstruction =
let map f = function
| GetTopListeners ( songId, next) -> GetTopListeners ( songId, next >> f)
| GetTopScrobbles (userName, next) -> GetTopScrobbles (userName, next >> f)
ここでは map 関数が処理するデータの種類を明確にするため、独自の小さなモジュールにまとめています。
モナド
次のステップは、前述の命令を逐次実行できるようにファンクターをデータ構造でラップすることです。
type SongProgram<'a> =
| Free of SongInstruction<SongProgram<'a>>
| Pure of 'a
この型を正しいモナドにするためには bind 関数が必要です。
module SongProgram =
let rec bind f = function
| Free inst -> inst |> SongInstruction.map (bind f) |> Free
| Pure inst -> f inst
ここでも私は忠実に F# フリーモナドのレシピに従っています。詳細はそちらを参照してください。
コンピュテーション式
技術的には、ここまでで小さな DSL を使ってプログラムを書くことは可能になりました。しかし、上記の bind 関数だけを使って書くのは煩雑なので、コンピュテーション式 という構文糖衣を利用すると便利です。
すぐ後で示しますが、一時的に命令型の言語構造をサポートする必要があったため、通常よりも少し複雑な実装になっています。
type SongProgramBuilder () =
member _.Bind (x, f) = SongProgram.bind f x
member _.Return x = Pure x
member _.ReturnFrom x = x
member _.Zero () = Pure ()
member _.Delay f = f
member _.Run f = f ()
member this.While (guard, body) =
if not (guard ())
then this.Zero ()
else this.Bind (body (), fun () -> this.While (guard, body))
member this.TryWith (body, handler) =
try this.ReturnFrom (body ())
with e -> handler e
member this.TryFinally (body, compensation) =
try this.ReturnFrom (body ())
finally compensation ()
member this.Using (disposable : #System.IDisposable, body) =
let body' = fun () -> body disposable
this.TryFinally (body', fun () ->
match disposable with
| null -> ()
| disp -> disp.Dispose ())
member this.For (sequence : seq<_>, body) =
this.Using (sequence.GetEnumerator (), fun enum ->
this.While (enum.MoveNext, this.Delay (fun () -> body enum.Current)))
member _.Combine (x, y) = x |> SongProgram.bind (fun () -> y ())
For メソッドを正しく実装するためにかなり試行錯誤しました。予想どおり、Scott Wlaschin 氏による コンピュテーション式に関するシリーズ が非常に役立ちました。
コンピュテーション式を使う際はいつも行うのですが、ビルダーオブジェクトをコード全体から参照できる場所に置きます。
let songProgram = SongProgramBuilder ()
まもなく songProgram コンピュテーション式を使った例を紹介します。
リフトされたヘルパー関数
必須ではありませんが、命令型の各ケースに対応するヘルパー関数を追加しておくと便利なことがよくあります。
let getTopListeners songId = Free (GetTopListeners (songId, Pure))
let getTopScrobbles userName = Free (GetTopScrobbles (userName, Pure))
これにより呼び出し側のコードがよりすっきりと見えるようになります。
命令型に見えるプログラム
これまでの仕組みが整ったので、元のクラスメソッドと同じアルゴリズムを実装する参照透過な関数を書くことができます。
let getRecommendations userName = songProgram {
// 1. 自ユーザーのトップスクロブルを取得
// 2. 同じ曲を聴いた他ユーザーを取得
// 3. そのユーザーのトップスクロブルを取得
// 4. 曲を集約してレコメンドを生成
let! scrobbles = getTopScrobbles userName
let scrobblesSnapshot =
scrobbles
|> Seq.sortByDescending (fun s -> s.ScrobbleCount)
|> Seq.truncate 100
|> Seq.toList
let recommendationCandidates = ResizeArray ()
for scrobble in scrobblesSnapshot do
let! otherListeners = getTopListeners scrobble.Song.Id
let otherListenersSnapshot =
otherListeners
|> Seq.filter (fun u -> u.TotalScrobbleCount >= 10_000)
|> Seq.sortByDescending (fun u -> u.TotalScrobbleCount)
|> Seq.truncate 20
|> Seq.toList
for otherListener in otherListenersSnapshot do
// Impure
let! otherScrobbles = getTopScrobbles otherListener.UserName
// Pure
let otherScrobblesSnapshot =
otherScrobbles
|> Seq.filter (fun s -> s.Song.IsVerifiedArtist)
|> Seq.sortByDescending (fun s -> s.Song.Rating)
|> Seq.truncate 10
|> Seq.toList
otherScrobblesSnapshot
|> List.map (fun s -> s.Song)
|> recommendationCandidates.AddRange
let recommendations =
recommendationCandidates
|> Seq.sortByDescending (fun s -> s.Rating)
|> Seq.truncate 200
|> Seq.toList
:> IReadOnlyCollection<_>
return recommendations }
このコードが、RecommendationsProvider クラスの GetRecommendationsAsync メソッドにどれほど似ているかに注目してください。songService.GetTopScrobblesAsync の代わりに getTopScrobbles があり、songService.GetTopListenersAsync の代わりに getTopListeners があります。計算全体は songProgram に包まれており、戻り値の型は SongProgram<IReadOnlyCollection<Song>> です。
recommendationCandidates のローカルな状態変更と、先ほど述べた参照透過性の主張が矛盾しているのでは、と疑問に思うかもしれません。しかし、参照透過性とは何を意味するのでしょうか。それは、ある関数呼び出し（例えば getRecommendations "cat"）を、それが返す値で置き換えることができるという意味です。そして実際に置き換えることが可能です。その関数が値を導き出す過程でローカルな変更を行ったとしても、呼び出し側には関係がありません。
とはいえ、このあと記事の中でコードをリファクタリングし、純粋関数に近い形にしていきます。ただし今は、まず getRecommendations が返すようなプログラムを評価する方法を見ていきましょう。
インタープリター
ここでも F# のフリーモナドのレシピに従います。すでに FakeSongService というクラスがあるので、Interpret メソッドを追加するのが最も簡単な実装方針でした。内部ではプライベートな再帰関数が処理を担っています。
let rec interpret = function
| Pure x -> x
| Free (GetTopListeners (songId, next)) ->
users
|> Seq.filter (fun kvp -> kvp.Value.ContainsKey songId)
|> Seq.map (fun kvp -> user kvp.Key (Seq.sum kvp.Value.Values))
|> Seq.toList
|> next
|> interpret
| Free (GetTopScrobbles (userName, next)) ->
users.GetOrAdd(userName, ConcurrentDictionary<_, _> ())
|> Seq.map (fun kvp -> scrobble songs[kvp.Key] kvp.Value)
|> Seq.toList
|> next
|> interpret
この実装は、もともとの Fake インターフェイスの実装にきわめてよく似ています。そこでは users と songs が FakeSongService クラスのフィールドでした。このクラスは最初に「曲レコメンデーション問題の仕様化」で紹介されました。
クラスに interpret 関数を追加したので、クライアントコードから呼び出せるメソッドが必要です。
member _.Interpret program = interpret program
これで、すべてのテストを書き換えることができるようになりました。
テストのリファクタリング
元の GetRecommendationsAsync メソッドはタスクベースだったため、すべてのテストはタスクワークフロー内で実行する必要がありました。もうその必要はありません。このシンプルな FsCheck のプロパティがそれを示しています。
[<Property>]
let ``One user, some songs`` () =
gen {
let! user = Gen.userName
let! songs = Gen.arrayOf Gen.song
let! scrobbleCounts =
Gen.choose (1, 100) |> Gen.arrayOfLength songs.Length
return (user, Array.zip songs scrobbleCounts) }
|> Arb.fromGen |> Prop.forAll <| fun (user, scrobbles) ->
let srvc = FakeSongService ()
scrobbles |> Array.iter (fun (s, c) -> srvc.Scrobble (user, s, c))
let actual = getRecommendations user |> srvc.Interpret
Assert.Empty actual
もともとこのテストは task コンピュテーション式を使って定義する必要がありましたが、いまは純粋関数です。Act フェーズでは、テストが getRecommendations user を呼び出し、その返されたプログラムを srvc.Interpret に渡しています。結果である actual は単なる IReadOnlyCollection<Song> の値です。
同様に、実例ベースのテストもすべて移行することができました。
[<Fact>]
let ``One verified recommendation`` () =
let srvc = FakeSongService ()
srvc.Scrobble ("cat", song 1 false 6uy, 10)
srvc.Scrobble ("ana", song 1 false 5uy, 10)
srvc.Scrobble ("ana", song 2 true 5uy, 9_9990)
let actual = getRecommendations "cat" |> srvc.Interpret
Assert.Equal<Song> ([ song 2 true 5uy ], actual)
すべてのテストを新しい getRecommendations 関数に移行したので、不要になった RecommendationsProvider クラスや SongService インターフェイスを削除しました。ここで注目していただきたいのは、前回の記事よりも小さなステップで進められたことです。『脳に収まるコードの書き方』で紹介されているように、ストラングラーパターンを使って段階的に進めました。Haskell のコードベースでもそうすべきでしたが、幸い問題にはなりませんでした。
すべてのテストを純粋関数に移行できたので、次は getRecommendations のリファクタリングに取り組みます。
トラバース
先ほどの getRecommendations では、ローカルな状態変更が二重ループの中にありました。このようなループを式にリファクタリングしたい場合、通常はトラバーサルが必要です。
トラバーサルには map 関数が必要なので、まずそれを実装します。
let map f = bind (f >> Pure)
この関数は上で示した SongProgram モジュールに含まれています。そのため、bind をプレフィックスなしで呼び出せます。同じことが traverse 関数にも当てはまります。
let traverse f xs =
let concat xs ys = xs |> bind (fun x -> ys |> map (Seq.append x))
Seq.fold
(fun acc x -> concat acc (f x |> map Seq.singleton))
(Pure (Seq.empty))
xs
ローカル関数 concat は、シーケンスを含む 2 つの SongProgram 値を結合し、結合されたシーケンスを含む 1 つの SongProgram 値を返します。トラバーサルはこのヘルパー関数を使って xs を fold しています。
リファクタリング後のプログラム
これで、ネストしたループやローカルな状態変更をトラバーサルで置き換え、ヘルパー関数を抽出するなど、通常のリファクタリングの手順を踏むことができます。私が実際に踏んだ小さなステップに興味がある場合は、Git リポジトリを参照してください。ここでは、最終的に落ち着いた getRecommendations 関数だけを示します。
let getRecommendations userName = songProgram {
// 1. 自ユーザーのトップスクロブルを取得
// 2. 同じ曲を聴いた他ユーザーを取得
// 3. そのユーザーのトップスクロブルを取得
// 4. 曲を集約してレコメンドを生成
let! scrobbles = getTopScrobbles userName
let! otherlListeners =
getUsersOwnTopScrobbles scrobbles
|> SongProgram.traverse (fun s -> getTopListeners s.Song.Id)
let! otherScrobbles =
otherlListeners
|> Seq.collect getOtherUsersWhoListenedToTheSameSongs
|> SongProgram.traverse (fun u -> getTopScrobbles u.UserName)
return
otherScrobbles
|> Seq.collect getTopScrobblesOfUsers
|> aggregateTheSongsIntoRecommendations }
二重ループの代わりに 2 回の traverse が使われている点に注目してください。
getRecommendations の型は変わらず、すべてのテストも引き続き成功します。
結論
予想通り、GetRecommendationsAsync メソッドをフリーモナドベースの設計にリファクタリングするには、Haskell の場合よりも多くのボイラープレートコードが必要でした。それでも、F# のフリーモナドのレシピに従ったことで、作業自体はスムーズに進みました。ただし、コンピュテーション式ビルダーに for ループのサポートを実装する際に、自分の不注意で問題にぶつかりましたが、それはフリーモナドとは無関係の問題でした。
ここで改めて「結局これは何のためなのか」と思うかもしれません。まず、F# のフリーモナドレシピの中の意思決定フローチャートを参照してください。そして、これらの記事は何をすべきかを指示するものではなく、あくまで選べる道を示すものだという点を思い出してください。つまり、できることを提示しているだけであり、どの選択肢を取るかはあなた次第です。
次に、SongProgram<'a> はインターフェイスに似ているように見えるかもしれませんが、実際にははるかに制約が強いです。依存性注入を使うメソッドは本質的に不純であり、その中ではあらゆることが起こり得ますし、あらゆる種類のバグも入り込む可能性があります。
F# の型システムは、制約のない副作用や非決定性が発生するかどうかをチェックすることはできませんが、それでも SongProgram<'a> のような型は、SongProgram 関連の処理しか行われないことを強く示唆します。
私は、フリーモナドには F# において今でも居場所があると考えています。ただし、主にニッチな用途に限られるでしょう。一方で、C# ではこの種のプログラミングを可能にするための機能が不足しているため、フリーモナドは有用ではありません。それでも、デモ目的であれば実現 可能 ではあります。