Solve the Stable marriage problem using the Gale/Shapley algorithm.


Problem description

Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each woman ranks all the men in order of her preference.

A stable set of engagements for marriage is one where no man prefers a woman over the one he is engaged to, where that other woman also prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change.

Gale and Shapley proved that there is a stable set of engagements for any set of preferences and the first link above gives their algorithm for finding a set of stable engagements.


Task Specifics

Given ten males:

   abe, bob, col, dan, ed, fred, gav, hal, ian, jon

And ten females:

   abi, bea, cath, dee, eve, fay, gay, hope, ivy, jan

And a complete list of ranked preferences, where the most liked is to the left:

  abe: abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay
  bob: cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay
  col: hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan
  dan: ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi
   ed: jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay
 fred: bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay
  gav: gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay
  hal: abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee
  ian: hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve
  jon: abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope
   
  abi: bob, fred, jon, gav, ian, abe, dan, ed, col, hal
  bea: bob, abe, col, fred, gav, dan, ian, ed, jon, hal
 cath: fred, bob, ed, gav, hal, col, ian, abe, dan, jon
  dee: fred, jon, col, abe, ian, hal, gav, dan, bob, ed
  eve: jon, hal, fred, dan, abe, gav, col, ed, ian, bob
  fay: bob, abe, ed, ian, jon, dan, fred, gav, col, hal
  gay: jon, gav, hal, fred, bob, abe, col, ed, dan, ian
 hope: gav, jon, bob, abe, ian, dan, hal, ed, col, fred
  ivy: ian, col, hal, gav, fred, bob, abe, ed, jon, dan
  jan: ed, hal, gav, abe, bob, jon, col, ian, fred, dan

 Use the Gale Shapley algorithm to find a stable set of engagements
 Perturb this set of engagements to form an unstable set of engagements then check this new set for stability.

References

 The Stable Marriage Problem. (Eloquent description and background information).
 Gale-Shapley Algorithm Demonstration.
 Another Gale-Shapley Algorithm Demonstration.
 Stable Marriage Problem - Numberphile (Video).
 Stable Marriage Problem (the math bit) (Video).
 The Stable Marriage Problem and School Choice. (Excellent exposition)


constant men = {"abe","bob","col","dan","ed","fred","gav","hal","ian","jon"}
enum             abe , bob , col , dan , ed , fred , gav , hal , ian , jon
constant hen = {"abi","bea","cath","dee","eve","fay","gay","hope","ivy","jan"}
enum             abi , bea , cath , dee , eve , fay , gay , hope , ivy , jan
 
-- Given a complete list of ranked preferences, where the most liked is to the left: 
sequence mpref = repeat(0,length(men))
    mpref[abe]  = {abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay}
    mpref[bob]  = {cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay}
    mpref[col]  = {hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan}
    mpref[dan]  = {ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi}
    mpref[ed]   = {jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay}
    mpref[fred] = {bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay}
    mpref[gav]  = {gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay}
    mpref[hal]  = {abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee}
    mpref[ian]  = {hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve}
    mpref[jon]  = {abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope}
 
sequence hpref = repeat(0,length(hen))
    hpref[abi]  = {bob, fred, jon, gav, ian, abe, dan, ed, col, hal}
    hpref[bea]  = {bob, abe, col, fred, gav, dan, ian, ed, jon, hal}
    hpref[cath] = {fred, bob, ed, gav, hal, col, ian, abe, dan, jon}
    hpref[dee]  = {fred, jon, col, abe, ian, hal, gav, dan, bob, ed}
    hpref[eve]  = {jon, hal, fred, dan, abe, gav, col, ed, ian, bob}
    hpref[fay]  = {bob, abe, ed, ian, jon, dan, fred, gav, col, hal}
    hpref[gay]  = {jon, gav, hal, fred, bob, abe, col, ed, dan, ian}
    hpref[hope] = {gav, jon, bob, abe, ian, dan, hal, ed, col, fred}
    hpref[ivy]  = {ian, col, hal, gav, fred, bob, abe, ed, jon, dan}
    hpref[jan]  = {ed, hal, gav, abe, bob, jon, col, ian, fred, dan}
 
sequence engagements := repeat(0,length(hen))
sequence freemen = tagset(length(men))
printf(1,"Engagements:\n")
 
-- use the Gale Shapley algorithm to find a stable set of engagements:
while length(freemen) do
    integer man = freemen[1]
    freemen = freemen[2..$]
    integer fem, dumpee
    -- each male loops through all females in order of his preference until one accepts him
    for j=1 to length(mpref[man]) do
        fem = mpref[man][j]
        dumpee = engagements[fem]
        if dumpee=0
        or find(man,hpref[fem])<find(dumpee,hpref[fem]) then
            exit
        end if
    end for
    if dumpee!=0 then       -- if she was previously engaged
        freemen &= dumpee   -- he goes to the bottom of the list
        printf(1,"%s dumped %s and accepted %s\n",{hen[fem],men[dumpee],men[man]})
    else
        printf(1,"%s accepted %s\n",{hen[fem],men[man]})
    end if
    engagements[fem] := man -- the new engagement is registered
end while
 
printf(1,"\nCouples:\n")
for fem=1 to length(hen) do
    printf(1,"%s is engaged to %s\n",{hen[fem],men[engagements[fem]]})
end for
 
procedure stable()
bool unstable = false
    for fem=1 to length(hen) do
        integer man = engagements[fem]
        for j=1 to length(hen) do
            if find(fem,mpref[man])>find(j,mpref[man])
            and find(engagements[j],hpref[j])>find(man,hpref[j]) then
                if unstable=false then
                    printf(1,"\nThese couples are not stable.\n")
                    unstable = true
                end if
                printf(1,"%s is engaged to %s but would prefer %s and %s is engaged to %s but would prefer %s\n",
                         {men[man],hen[fem],hen[j],hen[j],men[engagements[j]],men[man]})
            end if
        end for
    end for
    if not unstable then
        printf(1,"\nThese couples are stable.\n")
    end if
end procedure
 
stable()
printf(1,"\nWhat if cath and ivy swap?\n")
engagements[cath]:=abe; engagements[ivy]:=bob
stable()
