Jump to content

Stable marriage problem: Difference between revisions

Line 4,161:
gay prefers jon to gav and jon prefers gay to bea
bea prefers fred to jon and fred prefers bea to abi</pre>
 
=={{header|Phix}}==
{{trans|AutoHotkey}}
<lang Phix>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()</lang>
{{Out}}
<pre>
Engagements:
abi accepted abe
cath accepted bob
hope accepted col
ivy accepted dan
jan accepted ed
bea accepted fred
gay accepted gav
eve accepted hal
hope dumped col and accepted ian
abi dumped abe and accepted jon
dee accepted col
ivy dumped dan and accepted abe
fay accepted dan
 
Couples:
abi is engaged to jon
bea is engaged to fred
cath is engaged to bob
dee is engaged to col
eve is engaged to hal
fay is engaged to dan
gay is engaged to gav
hope is engaged to ian
ivy is engaged to abe
jan is engaged to ed
 
These couples are stable.
 
What if cath and ivy swap?
 
These couples are not stable.
bob is engaged to ivy but would prefer abi and abi is engaged to jon but would prefer bob
bob is engaged to ivy but would prefer bea and bea is engaged to fred but would prefer bob
bob is engaged to ivy but would prefer cath and cath is engaged to abe but would prefer bob
bob is engaged to ivy but would prefer fay and fay is engaged to dan but would prefer bob
bob is engaged to ivy but would prefer hope and hope is engaged to ian but would prefer bob
</pre>
 
=={{header|PicoLisp}}==
7,794

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.