Stable marriage problem: Difference between revisions
Content added Content deleted
(→{{header|Scala}}: update) |
|||
Line 4,161: | Line 4,161: | ||
gay prefers jon to gav and jon prefers gay to bea |
gay prefers jon to gav and jon prefers gay to bea |
||
bea prefers fred to jon and fred prefers bea to abi</pre> |
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}}== |
=={{header|PicoLisp}}== |