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:

- Read in all the lists (of course), and parse them into manageable bits of information.
- Make initial, arbitrary matchups - engagements.
- 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.
- Loop through step 3 until all combinations have been tested.
- 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.