87 lines
3.8 KiB
Text
87 lines
3.8 KiB
Text
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()
|