The Stable Marriage Problem is a common puzzle presented to students in computer programming classes. I've had to write solutions to this problem in two languages now, and I wouldn't be very surprised if I write it one or two more times in the near future.

Okay - here's how the problem goes. Say there are a group of people who want to get married - x men and x women. For simplicity's sake, everyone's heterosexual. Every man writes down the names of the women in order of romantic preference, and each woman creates a similar list of the men. The programmer's job is to create, from these two lists, a stable marriage set - a list of marriages in which every person is paired up with exactly one member of the opposite sex, and no two people would both rather be with each other than with their current spouses. Any possible (nontrivial) set of lists that follow the initial rules will be able to provide at least one stable marriage solution.

That's a little confusing, I know, so here's an example case. Say that there are 6 people: Andy, Bob, and Chris are men; Daphne, Erica, and Fiona are women. the lists are like this:
  • Andy - Erica, Fiona, Daphne
  • Bob - Fiona, Daphne, Erica
  • Chris - Fiona, Erica, Daphne
  • Daphne - Chris, Bob, Andy
  • Erica - Bob, Andy, Chris
  • Fiona - Andy, Bob, Chris

Let's see - this one ends up being pretty simple. One stable marriage set would be Andy:Erica, Bob:Fiona, and Chris:Daphne. You can't just pick names randomly, however. Andy:Fiona, Bob:Daphne, and Chris:Erica would be unstable - Erica and Andy would rather be with each other than with Chris and Fiona (respectively), so the marriages are unstable.

A simple algorithm for the stable marriage problem goes like this:

  1. Read in all the lists (of course), and parse them into manageable bits of information.
  2. Make initial, arbitrary matchups - engagements.
  3. Grab a man and woman who aren't engaged to each other. Check their preferences - if they'd rather be with each other than with with their fiance(e)s, then split and switch the engagements.
  4. Loop through step 3 until all combinations have been tested.
  5. Marry 'em!

Get it? Good. Here are a couple programs that use this algorithm to successfully create stable marriages:


This is one for Prolog that makes good use of assert and retract. It takes input from "test.dat" configured like:
2.
joe. ann. barb.
jack. barb. ann.
ann. joe. jack.
barb. jack. joe.

The Program:

locate(Item, [Item|_], 1).

locate(Item, [_|List], Sub):-
locate(Item, List, Number),
Sub is Number+1.

marry:-
engaged(Male, Female),
retract(engaged(Male, Female)),
assert(married(Male, Female)),
write(Male),write(' '),write(Female), nl,
marry.

marry:-
not(engaged(_,_)).

findpref(Name1, Name2, Pref):-
likes(Name1, Preflist),
locate(Name2, Preflist, Pref).

matchsingle:-
single(Male),
single(Female),
male(Male),
female(Female),
assert(engaged(Male,Female)),
retract(single(Male)),
retract(single(Female)),
matchsingle.

matchsingle:-
matchengaged.

matchengaged:-
engaged(Male1, Female1),
engaged(Male2, Female2),
findpref(Male1, Female2, Hispref),
findpref(Male1, Female1, Hisprefnow),
findpref(Female2, Male1, Herpref),
findpref(Female2, Male2, Herprefnow),
Hispref < Hisprefnow,
Herpref < Herprefnow,
retract(engaged(Male1, Female1)),
retract(engaged(Male2, Female2)),
assert(engaged(Male1, Female2)),
assert(engaged(Male2, Female1)),
matchengaged.

matchengaged:-
not(single(_)).

getlist(0,[]).

getlist(Number, [H|List]):-
read(H),
Number2 is Number-1,
getlist(Number2,List).

getinfo(_, 0, _).

getinfo(Number, Number2, female):-
read(Name),
getlist(Number,List),
assert(likes(Name,List)),
assert(female(Name)),
assert(single(Name)),
Number3 is Number2-1,
getinfo(Number, Number3, female).

getinfo(Number, Number2, male):-
read(Name),
getlist(Number,List),
assert(likes(Name,List)),
assert(male(Name)),
assert(single(Name)),
Number3 is Number2-1,
getinfo(Number, Number3, male).

translate:-
see('test.dat'),
read(Number),
getinfo(Number, Number, male),
getinfo(Number, Number, female),
assert(people(Number)),
close('test.dat').

s:-
translate,
matchsingle,
marry.

Here's one for ML, which takes input from "test.dat" configured like:
2
joe ann barb
jack barb ann
ann joe jack
barb jack joe

The Program:

open TextIO;

fun size([])=0
| size(x::xs)= 1+size(xs)

fun grabN(n, [])= []
| grabN(n, x::xs)=
if n=0 then []
else x::grabN(n-1, xs)

fun last([x])= x
| last(x::xs)= last(xs)

fun toInt([], n)= n
| toInt([#"\n"], number)= number
| toInt(x::xs, number) = toInt(xs, number*10 + ord(x) - 48);

fun min(x, y)=
if x<y then x else y

fun max(x, y)=
if x<y then y else x

fun removeN(n, [])= []
| removeN(n, x::xs)=
if n=0 then x::xs
else removeN(n-1,xs)

fun remove(l, [])= []
| remove(l, x::xs)=
if l = 1
then xs
else x::remove(l-1,xs)

fun loc(x, [])= 0
| loc(x, y::ys)=
if x = y
then 1
else 1+loc(x, ys)

fun invloc(x, y::ys)=
if x = 1
then y
else invloc(x-1, ys)

fun isin(x, [])= false
| isin(x, y::ys)=
if x=y
then true
else isin(x, ys)

fun matchengaged(m, f, mp, fp, e, x, y)=
let
val male = hd(invloc(x, e))
val female = last(invloc(y, e))

val fianc1 = last(invloc(x, e))
val fianc2 = hd(invloc(y, e))

val mnumber = loc(male, m)
val fnumber = loc(female, f)

val mprefs = invloc(mnumber, mp)
val fprefs = invloc(fnumber, fp)

val mpref = loc(female, mprefs)
val oldmpref = loc(fianc1, mprefs)

val fpref = loc(male, fprefs)
val oldfpref = loc(fianc2, fprefs)
in
if (mpref<oldmpref) andalso (fpref<oldfpref)
then matchengaged(m, f, mp, fp,
[male, female]::[fianc2, fianc1]::remove(min(x,y),remove(max(x,y), e)),
1, 1)
else
if y=length(e)
then
if x=length(e)
then e
else matchengaged(m, f, mp, fp, e, x+1, 1)

else matchengaged(m, f, mp, fp, e, x, y+1)
end;

fun matchsingle(m, f, e, n)=
if n=0
then e
else matchsingle(m, f, [invloc(n, m), invloc(n, f)]::e, n-1)

fun match(m, f, mp, fp)=
let
val e = matchsingle(m, f, [], length(m))
in
matchengaged(m, f, mp, fp, e, 1, 1)
end;

fun translate(l, [])= translate(l,[inputN(l,1)])
| translate(l, [x])=
let
val n = inputN(l, 1)
in
if n = ""
then [x]
else
if n = "\n" orelse n = " "
then translate(l, [x]@[""])
else translate(l,[x^n])
end

| translate(l, lx)=
let
val n = inputN(l, 1)
val x = last(lx)
val xs = remove(size(lx),lx)
in
if n = "" then xs@[x]

else if n = "\n" orelse n = " " then translate(l, xs@[x]@[""])

else translate(l,xs@[x^n])
end;


fun male(l)=
let
val n = toInt(explode(hd(l)), 0)
in
if n=0 orelse l=[makestring(n)]
then []
else
invloc(2,l)::male(makestring(n)::removeN(n+2, l))
end;

fun female(l)=
let
val n = toInt(explode(hd(l)), 0)
in
male(makestring(n)::removeN(n*(n+1)+1, l))
end;


fun mprefs(l)=
let
val n = toInt(explode(hd(l)), 0)
in
if n=0 orelse l=[makestring(n)]
then []
else
grabN(n,removeN(2,l))::mprefs(makestring(n)::removeN(n+2,l))
end;

fun fprefs(l)=
let
val n = toInt(explode(hd(l)), 0)
in
mprefs(makestring(n)::removeN(n*(n+1)+1, l))

end;

fun s()=
let
val j = openIn("test.dat")
val l = translate(j, [])
val n = toInt(explode(hd(l)), 0)
val f = female(l)
val m = grabN(n,male(l))
val mp = grabN(n, mprefs(l))
val fp = fprefs(l)
val x = match(m, f, mp, fp)
in
x
end;

s();


Note: These are intended for personal/recreational use only! By posting these, I am giving NO permission to anyone to use these as unauthorized aid in a school class.