Posts Tagged: Gale-Shapely


19
Sep 11

Imperative Pseudocode to Pure Functional Algorithm with Gale-Shapely and F#

Continuing from last time, let’s look at how one goes from imperative pseudocode to pure functional using Gale-Shapely as an example.

Overall, to convert an algorithm from imperative to functional is a fairly simple process once you understand how to convert from a while loop to recursion with accumulators. This post is just a more advanced version of what I talked about in my From Imperative to Computation Expressions post. In fact, if you haven’t already I suggest you read it first. I’ll be assuming you understand how to perform that conversion in this article.  If you’re still having trouble, another good article which is a bit easier is The Ted Neward F# Folding Challenge.

The conversion of an algorithm is a two stage process: first identify algorithmic cases, implied mutable data structures, and alternate immutable data structures.  Then convert the given loops into recursion while leveraging pattern matching.  I know it may seem difficult at first, but after reading this I think you’ll have a good idea of how to get there.

So, let’s identify the cases.

function stableMatching {   
    Initialize all m ? M and w ? W to free
    // Loop Termination Case on
    // check for “free m with unproposed w” and
 
    // implicit ranking of W for each m in M
   
    while ? free man m who still has a
            woman w to propose to {      
       w = m’s highest ranked such woman
               who he has not proposed to yet
      
// She’s Single Case 
       if w is free
         (m, w) become engaged
       // She’s Engaged Case 
       else some pair (m’, w) already exists
         // She Picks m Sub-Case 

         if w prefers m to m’
           (m, w) become engaged
           m’ becomes free
         // She Picks m’ Sub-Case 
         else
           (m’, w) remain engaged
    }
}

Starting from the top, we can just ignore the imperative initialization.  However, you’ll notice that a great deal is going on in that while clause. 

First, it defines our loop termination by looking for a “free m who still has a w to propose to”.  This is interesting because it seems to be begging for some kind of data structure lookup.  Second it defines a implicit ranking of each member of W by each member of M.  Note that this is not mentioned in the initialization phase.

The rest of this algorithm reads like a simple list of cases.  To make this plain, let’s list them out along with state changes.

  1. no single m in M with unproposed w 
    — execution terminates
  2. m proposes to unengaged w
    — w is no longer in m proposals
    — m is no longer single
    — m and w are engaged
  3. m proposes to w engaged to m’
    a.  She switches to m
          — w is no longer in m proposals
          — m is no longer single
          — m and w are engaged
          — m’ is single
    b.  She stays with m’
          — w is no longer in m proposals
          — m’ and w stay engaged
          — m remains single

The mechanics of what exactly we do in these cases depends on our data structures.  So we can’t get much further without figuring that out.  To identify what data structures are needed we’ll need to identify what exactly it is that needs to be kept track of.  Only once we know that can we pick our immutable data structures appropriately. 

Looking above, it appears that we’ll need to keep track of:

  1. Given a woman, is she engaged and, if so, who is she engaged to? (need to look it up)
  2. Which men are single? (just need one at a time, order doesn’t matter)
  3. For each man, which is his next most desirable match that he has not yet proposed to? (just need one at a time, order matters)

Note that we don’t have to keep track of which men are engaged to which women, the question is never asked.  This is a minimal set of requirements here.  No extra stuff allowed.  I’m serious.

Moving on, in an imperative mutable version you might use these data structures:

  1. An array indexed by w to the m index engaged to (-1 if single)
  2. An array indexed by m to the w index engaged to (-1 if single)
  3. An array indexed by m where each element is an ordered linked list of unproposed w indices.

However, what would satisfy these same requirements but be immutable?  Well, if we step out of the mutation mindset it becomes obvious pretty quickly:

  1. An engagement map of women to men
  2. An immutable linked list of single men
  3. Define a man to include his index as well as an ordered unproposed woman immutable linked list

Instead of scanning arrays, or querying mutable structures we simply decompose our data structures as much as needed and recompose them into the form we need on the next call.   This may sound difficult, but it’s really not.  The fact that we have pattern matching and our cases can be defined in terms of the shape of our data structures actually makes this very simple to do.  That is, once you get the hang of it.

To see this in action, let’s break up the code in the last article and discuss each chunk.

 1: open System
 2: 
 3: // a Bachelor is an identity index and an 
 4: // ordered list of women indicies to approach.
 5: type Bachelor = int * int list

Here we see the definition of a bachelor, it’s a tuple of an integer and a list of integers. This is effectively a pair containing an index and a list of woman indices. Note that in this example all men are of type Bachelor.

 7: // Some notation:
 8: // wi = woman index (int)
 9: // mi = man index (int)
10: // mi' = woman's current partner index (int)
11: // m = man with index and unapproached women indices (Bachelor)
12: // mSingle = men that are single (Bachelor list)
13: // wEngaged = engagements from women to men (int, Bachelor)

We’ll keep this notation around just so you have easy reference.

15: let funGS (comp: _ -> _ -> float) (M: _ array) (W: _ array) =
16:   let Windices = [ 0 .. W.Length - 1 ]
17:   // List of men with women in order of desire  
18:   let Munproposed = 
19:     List.init M.Length 
20:       (fun mi -> 
21:            let sortFun wi = 1.0 - (comp M.[mi] W.[wi])
22:            mi, Windices |> List.sortBy sortFun)

Windices is just a list of numbers from 0 to the number of woman tokens. Doing this first makes the calculation of Munproposed less expensive.

Munproposed is our initial set of all single men. Here List.init is used to call the given lambda to generate each element. As you can see by the last line within that lambda, each element of the list is a tuple containing the index of that man and a list of women indices sorted by the given desirability function, sortFun.

23:   // Recursively solve stable marriages
24:   let rec findMarriages mSingle wEngaged =
25:     match mSingle with
26:     // No single guys left with desired women, we're done
27:     | [] -> wEngaged
28:     // Guy is out of luck, remove from singles
29:     | (mi, []) :: bachelors -> findMarriages bachelors wEngaged

These are our first two cases, if the mSingle list pattern matches with [], we know it’s empty and so we are done.

In the second case we are pattern matching on the structure of singles list as well as it’s first element.  The syntax (mi, []) matches on a tuple of an index and an empty inner list.  This list is the list of yet unproposed to women and so if it’s empty we know that this guy is out of options and so it’s ok to drop him from the list of bachelors.  We do this by simply recursing on bachelors, which is the tail of the mSingle list.

30:     // He's got options!
31:     | (mi, wi :: rest) :: bachelors -> 
32:       let m = mi, rest

This is our general purpose match, and is the structure we expect to see in most cases.  Here the head is fully decomposed into a man index (mi), his next first choice woman index (wi), the rest of the women (rest) and the rest of the single men (bachelors).

Immediately afterward we define m to be that given man index (mi) and the rest of the women tokens (rest).  As two tokens are only ever compared once, m should no longer contain wi in his ordered list of proposals.  This is the form he will take until the algorithm ends or he is evaluated again after being placed in the mSingle pool.

33:       match wEngaged |> Map.tryFind wi with
34:       // She's single! m is now engaged!
35:       | None -> findMarriages bachelors (wEngaged |> Map.add wi m)
36:       // She's already engaged, let the best man win!
37:       | Some (m') –> 
38: let mi', _ = m'

Now that we have fully matched out everything masculine, it’s time to turn to the feminine. 

Here we look in the wEngaged map to find out if wi is single.  This is done by a using Map.tryFind which returns None if the given key is not in the map and Some(value) if it is.

If the Map.tryFind call returns None we know she is single and so recurse with the rest of our single men (bachelors) and our wEngaged map is extended via Map.add to contain a new mapping from the woman index (wi) to the given man (m).

If she’s engaged our pattern match automatically decomposes the given option type and we know exactly who she is engaged to (m’).

39:         if comp W.[wi] M.[mi] > comp W.[wi] M.[mi'] then 
40:           // Congrats mi, he is now engaged to wi
41:           // The previous suitor (mi') is bested 
42:           findMarriages 
43:             (m' :: bachelors) 
44:             (wEngaged |> Map.add wi m)
45:         else
46:           // The current bachelor (mi) lost, better luck next time
47:           findMarriages 
48:             (m :: bachelors) 
49:             wEngaged

This is the core comparison logic.  Here we determine which bachelor gets her hand.  This is pretty straightforward from an imperative perspective as we’re using the oh-so familiar if statement.

In the first case the new contender (m) wins.  We append the loser (m’) back on to the head of what will be mSingle next time around with the syntax (m’ :: bachelors).  Similar to what happens if she’s single, we add a mapping from the woman index (wi) to the man instance (m) via the call to Map.add.  Note that this will override the former mapping from wi to m’.

If the current bachelor loses we simply append him back to the head of the bachelors list and try again next time around.  You’ll get her next time bro.

50:   findMarriages Munproposed Map.empty
51:   // Before returning, remove unproposed lists from man instances  
52:   |> Map.map (fun wi m -> let mi, _ = m in mi)  

The final section is just how we set up our recursion.  We start with the full list of single men and their ranked lady lists (Munproposed) and an empty map of relationships (Map.empty).  When the algorithm exits we make one last pass through our returned wEngaged map in order to strip out all of the lists of unproposed to women.  It’s just baggage now anyway.

Well that’s how you get from imperative pseudocode to a pure functional implementation.  All of the code here, as well as a really nasty imperative version to compare it to is available on my GitHub page

If you liked this post, have any questions, or feel like I missed something important I hope you’ll comment here on it.  We’ll all benefit from the knowledge shared. 

namespace System
type Bachelor = int * int list

Full name: Snippet.Bachelor

Multiple items

val int : ‘T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

——————–

type int<‘Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

  type: int<‘Measure>

  implements: IComparable

  implements: IConvertible

  implements: IFormattable

  implements: IComparable<int<‘Measure>>

  implements: IEquatable<int<‘Measure>>

  inherits: ValueType

——————–

type int = int32

Full name: Microsoft.FSharp.Core.int

  type: int

  implements: IComparable

  implements: IFormattable

  implements: IConvertible

  implements: IComparable<int>

  implements: IEquatable<int>

  inherits: ValueType

type ‘T list = List<‘T>

Full name: Microsoft.FSharp.Collections.list<_>

  type: ‘T list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<‘T>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<‘T>

  implements: Collections.IEnumerable

val funGS : (‘a -> ‘a -> float) -> ‘a array -> ‘a array -> Map<int,int>

Full name: Snippet.funGS

val comp : (‘a -> ‘a -> float)
Multiple items

val float : ‘T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

——————–

type float<‘Measure> = float

Full name: Microsoft.FSharp.Core.float<_>

  type: float<‘Measure>

  implements: IComparable

  implements: IConvertible

  implements: IFormattable

  implements: IComparable<float<‘Measure>>

  implements: IEquatable<float<‘Measure>>

  inherits: ValueType

——————–

type float = Double

Full name: Microsoft.FSharp.Core.float

  type: float

  implements: IComparable

  implements: IFormattable

  implements: IConvertible

  implements: IComparable<float>

  implements: IEquatable<float>

  inherits: ValueType

Multiple items

val M : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

——————–

val M : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

type ‘T array = ‘T []

Full name: Microsoft.FSharp.Core.array<_>

  type: ‘T array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘T>

  implements: Collections.Generic.ICollection<‘T>

  implements: seq<‘T>

  implements: Collections.IEnumerable

  inherits: Array

Multiple items

val W : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

——————–

val W : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

val Windices : int list

  type: int list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<int>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<int>

  implements: Collections.IEnumerable

val W : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

property Array.Length: int
val Munproposed : (int * int list) list

  type: (int * int list) list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<int * int list>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<int * int list>

  implements: Collections.IEnumerable

Multiple items

module List

from Microsoft.FSharp.Collections

——————–

type List<‘T> =

  | ( [] )

  | ( :: ) of ‘T * ‘T list

  with

    interface Collections.IEnumerable

    interface Collections.Generic.IEnumerable<‘T>

    member Head : ‘T

    member IsEmpty : bool

    member Item : index:int -> ‘T with get

    member Length : int

    member Tail : ‘T list

    static member Cons : head:’T * tail:’T list -> ‘T list

    static member Empty : ‘T list

  end

Full name: Microsoft.FSharp.Collections.List<_>

  type: List<‘T>

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<‘T>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<‘T>

  implements: Collections.IEnumerable

val init : int -> (int -> ‘T) -> ‘T list

Full name: Microsoft.FSharp.Collections.List.init

val M : ‘a array

  type: ‘a array

  implements: ICloneable

  implements: Collections.IList

  implements: Collections.ICollection

  implements: Collections.IStructuralComparable

  implements: Collections.IStructuralEquatable

  implements: Collections.Generic.IList<‘a>

  implements: Collections.Generic.ICollection<‘a>

  implements: seq<‘a>

  implements: Collections.IEnumerable

  inherits: Array

val mi : int

  type: int

  implements: IComparable

  implements: IFormattable

  implements: IConvertible

  implements: IComparable<int>

  implements: IEquatable<int>

  inherits: ValueType

val sortFun : (int -> float)
val wi : int

  type: int

  implements: IComparable

  implements: IFormattable

  implements: IConvertible

  implements: IComparable<int>

  implements: IEquatable<int>

  inherits: ValueType

val sortBy : (‘T -> ‘Key) -> ‘T list -> ‘T list (requires comparison)

Full name: Microsoft.FSharp.Collections.List.sortBy

val findMarriages : ((int * int list) list -> Map<int,(int * int list)> -> Map<int,(int * int list)>)
val mSingle : (int * int list) list

  type: (int * int list) list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<int * int list>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<int * int list>

  implements: Collections.IEnumerable

val wEngaged : Map<int,(int * int list)>

  type: Map<int,(int * int list)>

  implements: IComparable

  implements: Collections.Generic.IDictionary<int,(int * int list)>

  implements: Collections.Generic.ICollection<Collections.Generic.KeyValuePair<int,(int * int list)>>

  implements: seq<Collections.Generic.KeyValuePair<int,(int * int list)>>

  implements: Collections.IEnumerable

val bachelors : (int * int list) list

  type: (int * int list) list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<int * int list>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<int * int list>

  implements: Collections.IEnumerable

val rest : int list

  type: int list

  implements: Collections.IStructuralEquatable

  implements: IComparable<List<int>>

  implements: IComparable

  implements: Collections.IStructuralComparable

  implements: Collections.Generic.IEnumerable<int>

  implements: Collections.IEnumerable

val m : int * int list
Multiple items

module Map

from Microsoft.FSharp.Collections

——————–

type Map<‘Key,’Value (requires comparison)> =

  class

    interface Collections.IEnumerable

    interface IComparable

    interface Collections.Generic.IEnumerable<Collections.Generic.KeyValuePair<‘Key,’Value>>

    interface Collections.Generic.ICollection<Collections.Generic.KeyValuePair<‘Key,’Value>>

    interface Collections.Generic.IDictionary<‘Key,’Value>

    new : elements:seq<‘Key * ‘Value> -> Map<‘Key,’Value>

    member Add : key:’Key * value:’Value -> Map<‘Key,’Value>

    member ContainsKey : key:’Key -> bool

    override Equals : obj -> bool

    member Remove : key:’Key -> Map<‘Key,’Value>

    member TryFind : key:’Key -> ‘Value option

    member Count : int

    member IsEmpty : bool

    member Item : key:’Key -> ‘Value with get

  end

Full name: Microsoft.FSharp.Collections.Map<_,_>

  type: Map<‘Key,’Value>

  implements: IComparable

  implements: Collections.Generic.IDictionary<‘Key,’Value>

  implements: Collections.Generic.ICollection<Collections.Generic.KeyValuePair<‘Key,’Value>>

  implements: seq<Collections.Generic.KeyValuePair<‘Key,’Value>>

  implements: Collections.IEnumerable

val tryFind : ‘Key -> Map<‘Key,’T> -> ‘T option (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.tryFind

union case Option.None: Option<‘T>
val add : ‘Key -> ‘T -> Map<‘Key,’T> -> Map<‘Key,’T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add

union case Option.Some: ‘T -> Option<‘T>
val m’ : int * int list
val mi’ : int

  type: int

  implements: IComparable

  implements: IFormattable

  implements: IConvertible

  implements: IComparable<int>

  implements: IEquatable<int>

  inherits: ValueType

val empty<‘Key,’T (requires comparison)> : Map<‘Key,’T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty

val map : (‘Key -> ‘T -> ‘U) -> Map<‘Key,’T> -> Map<‘Key,’U> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.map

val alignJaroWinkler : (‘a array -> ‘a array -> Map<int,int>)

Full name: Snippet.alignJaroWinkler


13
Sep 11

Record Linkage in F# – Token Matching, Stable Marriages and the Gale-Shapley algorithm

Initially, one of the biggest problems I found when trying to marry records was the god awful quality of much of data I often have to work with. It’s mostly old mainframe and database data with truncated fields, limited character sets and fields with nonsensical contents. Even worse, much of the data is the result of years of merged account lists from different sources and so global statistical techniques often fail quite spectacularly.

While naive compared to doing something along the lines of clustering, I have found that bag-of-words token matching has proven to be quite robust when comparing names. The idea is that if you consider a name as an unordered set of tokens, you can then find the best global alignment with some target name and that this will indicate the proper ordering in the majority of cases. Finally you can score these ordered tokens with an algorithm (like Jaro-Winker for example), average them, and end up with a good representation of the similarity of the two given names.

(Of course, name is just one of many things to look at. After all, I’m pretty sure that all these John Smiths aren’t the same guy.)

At first you might think finding this alignment is rather simple. Just score every permutation of the two sets of tokens and return the maximum, right? Well, this will work great for most traditional American names as they have only 2-3 tokens. Three factorial is only 6 different token arrangements to try, not a big deal at all. However, this method has serious limitations in practice. What happens when you run up against a 9 token Arabic name? Nine factorial is 362,880 different permutations to try, that’s a lot of grinding for just one record. That’s also just considering real names, if someone were to accidentally dump a paragraph into your algorithm you may just want to grab a snickers.

Don’t despair though, the stable marriages problem and the Gale-Shapely algorithm are here to help.

In the stable marriages problem you have two sets of things you want to match up with each other (described in an unambiguously sexist way as men and women), and each has a way of rating the others. The question is, how might we match up all the men and women so that there’s no two people who would rather be with each other than who they are already with. Note that this does not mean everyone gets their first choice, what we are looking for is global optimality of the pairs.

This sounds familiar right? It’s a slightly more complex version of exactly what we’re trying to do with tokens! So, the solution to this problem is called the Gale-Shapley algorithm, and get this, it’s only worst case O(M*W) where M is the number of men tokens and W is the number of women!

To turn this all into plain English, we can use this algorithm to align that 9-token name in at most 9 * 9 = 81 steps, and we’re guaranteed to get a result that is just as good!

It works like this: Men take turns proposing to each woman in order of preference. If she’s single they are immediately “engaged”, if she’s already engaged the woman picks the man she likes best and the loser goes back into the singles pool. This happens over and over until all single men are engaged or out of options.

In our case we’re actually creating sorted lists for each man of each woman ahead of time, so it’s O(M*WLog(W)), but it’s only a very minor increase in complexity, and how would you do that lazily anyhow?

First, let’s take a look at the Wikipedia article’s very imperative pseudocode:

function stableMatching { Initialize all m ? M and w ? W to free while ? free man m who still has a woman w to propose to { w = m's highest ranked such woman who he has not proposed to yet if w is free (m, w) become engaged else some pair (m', w) already exists if w prefers m to m' (m, w) become engaged m' becomes free else (m', w) remain engaged } }

Now, I’m not a big fan of imperative code so I wrote a pure functional version instead. Anyhow, having only two immutable data structures makes for a much easier read. It’s pretty much a long list of cases.

 1: open System
 2: 
 3: // a Bachelor is an identity index and an 
 4: // ordered list of women indicies to approach.
 5: type Bachelor = int * int list
 6: 
 7: // Some notation:
 8: // wi = woman index (int)
 9: // mi = man index (int)
10: // mi' = woman's current partner index (int)
11: // m = man with index and unapproached women indices (Bachelor)
12: // mSingle = men that are single (Bachelor list)
13: // wEngaged = engagements from women to men (int, Bachelor)
14: 
15: let funGS (comp: _ -> _ -> float) (M: _ array) (W: _ array) =
16:   let Windices = [ 0 .. W.Length - 1 ]
17:   // List of men with women in order of desire  
18:   let Munproposed = 
19:     List.init M.Length 
20:       (fun mi -> 
21:            let sortFun wi = 1.0 - (comp M.[mi] W.[wi])
22:            mi, Windices |> List.sortBy sortFun)
23:   // Recursively solve stable marriages
24:   let rec findMarriages mSingle wEngaged =
25:     match mSingle with
26:     // No single guys left with desired women, we're done
27:     | [] -> wEngaged
28:     // Guy is out of luck, remove from singles
29:     | (mi, []) :: bachelors -> findMarriages bachelors wEngaged
30:     // He's got options!
31:     | (mi, wi :: rest) :: bachelors -> 
32:       let m = mi, rest
33:       match wEngaged |> Map.tryFind wi with
34:       // She's single! m is now engaged!
35:       | None -> findMarriages bachelors (wEngaged |> Map.add wi m)
36:       // She's already engaged, let the best man win!
37:       | Some (m') -> 
38:         let mi', _ = m'
39:         if comp W.[wi] M.[mi] > comp W.[wi] M.[mi'] then 
40:           // Congrats mi, he is now engaged to wi
41:           // The previous suitor (mi') is bested 
42:           findMarriages 
43:             (m' :: bachelors) 
44:             (wEngaged |> Map.add wi m)
45:         else
46:           // The current bachelor (mi) lost, better luck next time
47:           findMarriages 
48:             (m :: bachelors) 
49:             wEngaged
50:   findMarriages Munproposed Map.empty
51:   // Before returning, remove unproposed lists from man instances  
52:   |> Map.map (fun wi m -> let mi, _ = m in mi)  
53: 
54: // By the supreme power of partial application I give you 
55: // Jaro-Winkler Token Alignment with Gale-Shapely in one line!
56: 
57: let alignJaroWinkler = funGS jaroWinkler

namespace System
type Bachelor = int * int list

Full name: Snippet.Bachelor

Multiple items

val int : 'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

——————–

type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

  type: int<'Measure>
  implements: IComparable
  implements: IConvertible
  implements: IFormattable
  implements: IComparable<int<'Measure>>
  implements: IEquatable<int<'Measure>>
  inherits: ValueType

——————–

type int = int32

Full name: Microsoft.FSharp.Core.int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

  type: 'T list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<'T>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<'T>
  implements: Collections.IEnumerable

val funGS : ('a -> 'a -> float) -> 'a array -> 'a array -> Map<int,int>

Full name: Snippet.funGS

val comp : ('a -> 'a -> float)
Multiple items

val float : 'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

——————–

type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>

  type: float<'Measure>
  implements: IComparable
  implements: IConvertible
  implements: IFormattable
  implements: IComparable<float<'Measure>>
  implements: IEquatable<float<'Measure>>
  inherits: ValueType

——————–

type float = Double

Full name: Microsoft.FSharp.Core.float

  type: float
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<float>
  implements: IEquatable<float>
  inherits: ValueType

Multiple items

val M : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

——————–

val M : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

type 'T array = 'T []

Full name: Microsoft.FSharp.Core.array<_>

  type: 'T array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'T>
  implements: Collections.Generic.ICollection<'T>
  implements: seq<'T>
  implements: Collections.IEnumerable
  inherits: Array

Multiple items

val W : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

——————–

val W : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

val Windices : int list

  type: int list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<int>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<int>
  implements: Collections.IEnumerable

val W : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

property Array.Length: int
val Munproposed : (int * int list) list

  type: (int * int list) list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<int * int list>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<int * int list>
  implements: Collections.IEnumerable

Multiple items

module List

from Microsoft.FSharp.Collections

——————–

type List<'T> =
  | ( [] )
  | ( :: ) of 'T * 'T list
  with
    interface Collections.IEnumerable
    interface Collections.Generic.IEnumerable<'T>
    member Head : 'T
    member IsEmpty : bool
    member Item : index:int -> 'T with get
    member Length : int
    member Tail : 'T list
    static member Cons : head:'T * tail:'T list -> 'T list
    static member Empty : 'T list
  end

Full name: Microsoft.FSharp.Collections.List<_>

  type: List<'T>
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<'T>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<'T>
  implements: Collections.IEnumerable

val init : int -> (int -> 'T) -> 'T list

Full name: Microsoft.FSharp.Collections.List.init

val M : 'a array

  type: 'a array
  implements: ICloneable
  implements: Collections.IList
  implements: Collections.ICollection
  implements: Collections.IStructuralComparable
  implements: Collections.IStructuralEquatable
  implements: Collections.Generic.IList<'a>
  implements: Collections.Generic.ICollection<'a>
  implements: seq<'a>
  implements: Collections.IEnumerable
  inherits: Array

val mi : int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType

val sortFun : (int -> float)
val wi : int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType

val sortBy : ('T -> 'Key) -> 'T list -> 'T list (requires comparison)

Full name: Microsoft.FSharp.Collections.List.sortBy

val findMarriages : ((int * int list) list -> Map<int,(int * int list)> -> Map<int,(int * int list)>)
val mSingle : (int * int list) list

  type: (int * int list) list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<int * int list>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<int * int list>
  implements: Collections.IEnumerable

val wEngaged : Map<int,(int * int list)>

  type: Map<int,(int * int list)>
  implements: IComparable
  implements: Collections.Generic.IDictionary<int,(int * int list)>
  implements: Collections.Generic.ICollection<Collections.Generic.KeyValuePair<int,(int * int list)>>
  implements: seq<Collections.Generic.KeyValuePair<int,(int * int list)>>
  implements: Collections.IEnumerable

val bachelors : (int * int list) list

  type: (int * int list) list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<int * int list>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<int * int list>
  implements: Collections.IEnumerable

val rest : int list

  type: int list
  implements: Collections.IStructuralEquatable
  implements: IComparable<List<int>>
  implements: IComparable
  implements: Collections.IStructuralComparable
  implements: Collections.Generic.IEnumerable<int>
  implements: Collections.IEnumerable

val m : int * int list
Multiple items

module Map

from Microsoft.FSharp.Collections

——————–

type Map<'Key,'Value (requires comparison)> =
  class
    interface Collections.IEnumerable
    interface IComparable
    interface Collections.Generic.IEnumerable<Collections.Generic.KeyValuePair<'Key,'Value>>
    interface Collections.Generic.ICollection<Collections.Generic.KeyValuePair<'Key,'Value>>
    interface Collections.Generic.IDictionary<'Key,'Value>
    new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
    member Add : key:'Key * value:'Value -> Map<'Key,'Value>
    member ContainsKey : key:'Key -> bool
    override Equals : obj -> bool
    member Remove : key:'Key -> Map<'Key,'Value>
    member TryFind : key:'Key -> 'Value option
    member Count : int
    member IsEmpty : bool
    member Item : key:'Key -> 'Value with get
  end

Full name: Microsoft.FSharp.Collections.Map<_,_>

  type: Map<'Key,'Value>
  implements: IComparable
  implements: Collections.Generic.IDictionary<'Key,'Value>
  implements: Collections.Generic.ICollection<Collections.Generic.KeyValuePair<'Key,'Value>>
  implements: seq<Collections.Generic.KeyValuePair<'Key,'Value>>
  implements: Collections.IEnumerable

val tryFind : 'Key -> Map<'Key,'T> -> 'T option (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.tryFind

union case Option.None: Option<'T>
val add : 'Key -> 'T -> Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add

union case Option.Some: 'T -> Option<'T>
val m' : int * int list
val mi' : int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType

val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty

val map : ('Key -> 'T -> 'U) -> Map<'Key,'T> -> Map<'Key,'U> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.map

val alignJaroWinkler : ('a array -> 'a array -> Map<int,int>)

Full name: Snippet.alignJaroWinkler

So break out your F# Interactive and try something like:

alignJaroWinkler [|"DUDE"; "DUDERSON"|] [|"D"; "RONNY"; "DUDERSON"|]

and you’ll hopefully get something back like this:

val it : Map = map [(0, 0); (2, 1)]

This is just a map from women tokens to men tokens. (0,0) indicates that “D” matched best with “DUDE” and (2,1) indicates that “DUDERSON” matched best with “DUDERSON”. Poor “RONNY” ended up being the old maid.

That’s it for today, but of course, there’s a whole lot more to cover here. We need to look at how to manipulate this output into something a bit nicer. I also have a bunch of tweaks and improvements to this pair of algorithms that I want to talk about. Finally, I want to sidetrack for a bit and tunnel into how one goes from from the horrible imperative pseudocode above, to the magnificent pure functional code underneath it.

As per usual, all of the code use in this post (and previous posts in the series) can be found on github.