Song recommendations with F# free monads by Mark Seemann
With an extensive computation expression.
This article is part of a series called Alternative ways to design with functional programming. As the title suggests, it examines alternative functional-programming architectures. It does so by looking at the same overall example problem: Calculating song recommendations from a large data set of 'scrobbles'; records of playback data for many users. In the previous article, you saw how to implement the desired functionality using a free monad in Haskell. In this article, you'll see how to use a free monad in F#.
If you are following along in the accompanying Git repository, the code shown here is from the fsharp-free branch. The starting point is fsharp-port.
Functor #
A free monad enables you to define a monad from any functor. In this context, you start with the functor that models an instruction set for a domain-specific language (DSL). The goal is to replace the SongService interface with this instruction set.
As a reminder, this is the interface:
type SongService = abstract GetTopListenersAsync : songId : int -> Task<IReadOnlyCollection<User>> abstract GetTopScrobblesAsync : userName : string -> Task<IReadOnlyCollection<Scrobble>>
I'm following the F# free monad recipe, which, I'm happy to report, turned out to be easy to do.
First, the sum type:
type SongInstruction<'a> = | GetTopListeners of songId : int * (IReadOnlyCollection<User> -> 'a) | GetTopScrobbles of userName : string * (IReadOnlyCollection<Scrobble> -> 'a)
If you check with the F# free monad recipe and compare the SongService interface methods with the SongInstruction cases, you should be able to spot the similarity, and how to get from interface to discriminated union.
As shown in the previous article, in Haskell you can declaratively state that a type should be a Functor instance. In F# you have to implement it yourself.
module SongInstruction = let map f = function | GetTopListeners ( songId, next) -> GetTopListeners ( songId, next >> f) | GetTopScrobbles (userName, next) -> GetTopScrobbles (userName, next >> f)
Here I've put it in its own little module, in order to make it clear which kind of data the map function handles.
Monad #
The next step is to wrap the functor in a data structure that enables you to sequence the above instructions.
type SongProgram<'a> = | Free of SongInstruction<SongProgram<'a>> | Pure of 'a
A bind function is required to make this type a proper monad:
module SongProgram = let rec bind f = function | Free inst -> inst |> SongInstruction.map (bind f) |> Free | Pure inst -> f inst
Again, I'm slavishly following the F# free monad recipe; please refer to it for more details.
Computation expression #
Technically, that's all it takes to make it possible to write programs in the little DSL. Doing it exclusively with the above bind function would, however, but quite cumbersome, so you'll also appreciate some syntactic sugar in the form of a computation expression.
As you will see shortly, I needed to (temporarily) support some imperative language constructs, so I had to make it more involved than usually required.
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 ())
I had to do quite a bit of yak shaving before I got the For method right. Not surprisingly, Scott Wlaschin's series on computation expressions proved invaluable.
As you always do with computation expressions, you leave a builder object somewhere the rest of your code can see it:
let songProgram = SongProgramBuilder ()
You'll soon see an example of using a songProgram computation expression.
Lifted helpers #
Although not strictly required, I often find it useful to add a helper function for each case of the instruction type:
let getTopListeners songId = Free (GetTopListeners (songId, Pure)) let getTopScrobbles userName = Free (GetTopScrobbles (userName, Pure))
This just makes the user code look a bit cleaner.
Imperative-looking program #
With all that machinery in place, you can now write a referentially transparent function that implements the same algorithm as the original class method.
let getRecommendations userName = songProgram { // 1. Get user's own top scrobbles // 2. Get other users who listened to the same songs // 3. Get top scrobbles of those users // 4. Aggregate the songs into recommendations 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 }
Notice how much it resembles the original GetRecommendationsAsync method on the RecommendationsProvider class. Instead of songService.GetTopScrobblesAsync it just has getTopScrobbles, and instead of songService.GetTopListenersAsync it has getTopListeners. The whole computation is wrapped in songProgram, and the return type is SongProgram<IReadOnlyCollection<Song>>.
Perhaps you're wondering how the local state mutation (of recommendationCandidates) squares with my claim that this function is referentially transparent, but consider what referential transparency means. It means that you could replace a particular function call (say, getRecommendations "cat") with the value it returns. And you can. That the function used local mutation to arrive at that return value is of no concern to the caller.
Even so, later in this article, we'll refactor the code to something that looks more like a pure function. For now, however, we'll first see how to evaluate programs like the one returned by getRecommendations.
Interpreter #
Again, I follow the F# free monad recipe. Since I already have a class called FakeSongService, adding an Interpret method was the easiest implementation strategy. A private recursive function takes care of the implementation:
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
The implementation closely mirrors the original Fake interface implementation, where users and songs are class fields on FakeSongService. This class was first shown in Characterising song recommendations.
Since I added the interpret function in the class, we need a method that enables client code to call it:
member _.Interpret program = interpret program
It's now possible to rewrite all the tests.
Refactoring the tests #
Since the original GetRecommendationsAsync method was task-based, all tests had to run in task workflows. This is no longer necessary, as this simplified FsCheck property demonstrates:
[<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
Originally, this test had to be defined in terms of the task computation expression, but now it's a pure function. In the act phase the test calls getRecommendations user and pipes the returned program to srvc.Interpret. The result, actual, is a plain IReadOnlyCollection<Song> value.
Similarly, I was able to migrate all the example-based tests over, too.
[<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)
Once all tests were migrated over to the new getRecommendations function, I deleted the old RecommendationsProvider class as well as the SongService interface, since none of them were required any longer. Notice how I managed to move in smaller steps than in the previous article. As described in Code That Fits in Your Head, I used the Strangler pattern to move incrementally. I should also have done that with the Haskell code base, but fortunately I didn't run into trouble.
With all the tests migrated to pure functions, it's time to go back to getRecommendations to give it some refactoring love.
Traverse #
The local mutation in the above incarnation of getRecommendations is located within a doubly-nested loop. You typically need a traversal if you want to refactor such loops to expressions.
The traversal needs a map function, so we'll start with that.
let map f = bind (f >> Pure)
This function is included in the SongProgram module shown above. That's the reason it can call bind without a prefix. The same is true for the traverse function.
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
The local concat function concatenates two SongProgram values that contain sequences to a single SongProgram value containing the concatenated sequence. The traversal uses this helper function to fold over the xs.
Refactored program #
You can now go through all the usual motions of replacing the nested loops and the local mutation with traversal, extracting helper functions and so on. If you're interested in the small steps I took, you may consult the Git repository. Here, I only present the getRecommendations function in the state I decided to leave it.
let getRecommendations userName = songProgram { // 1. Get user's own top scrobbles // 2. Get other users who listened to the same songs // 3. Get top scrobbles of those users // 4. Aggregate the songs into recommendations 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 }
Notice the two applications of traverse, which replace the twice-nested loop.
The type of getRecommendations is unchanged, and all tests still pass.
Conclusion #
As expected, it required more boilerplate code to refactor the GetRecommendationsAsync method to a design based on a free monad, than the corresponding refactoring did in Haskell. Even so, following the F# free monad recipe made it was smooth sailing. I did, however, hit a snag, mostly of my own manufacture, when implementing support for for loops in the computation expression builder, but that problem turned out to be unrelated to the free monad.
Again, you may wonder what the point is. First, I'll refer you to the decision flowchart in the F# free monad recipe, as well as remind you that these articles are all intended to be descriptive rather than prescriptive. They only present what is possible. It's up to you to decide which option to choose.
Second, a SongProgram<'a> may look similar to an interface, but consider how much more restricted it is. A method that uses dependency injection is inherently impure; in such a method, everything may happen, including every kind of bug.
The F# type system does not check whether or not unconstrained side effects or non-determinism takes place, but still, a type like SongProgram<'a> strongly suggests that only SongProgram-related actions take place.
I think that free monads still have a place in F#, although mostly as a niche use case. In C#, on the other hand, free monads aren't useful because the language lacks features to make this kind of programming workable. Still, for demonstration purposes only, it can be done.
Next: Song recommendations with C# free monads.
