Stable marriage problem: Difference between revisions
Content added Content deleted
mNo edit summary |
|||
Line 3,279: | Line 3,279: | ||
Jon & Fred swap partners |
Jon & Fred swap partners |
||
Stable = No</pre> |
Stable = No</pre> |
||
=={{header|Julia}}== |
|||
<lang Julia> |
|||
# This is not optimized, but tries to follow the pseudocode given the Wikipedia entry below. |
|||
# Reference: https://en.wikipedia.org/wiki/Stable_marriage_problem#Algorithm |
|||
const males = ["abe", "bob", "col", "dan", "ed", "fred", "gav", "hal", "ian", "jon"] |
|||
const females = ["abi", "bea", "cath", "dee", "eve", "fay", "gay", "hope", "ivy", "jan"] |
|||
const malepreferences = Dict( |
|||
"abe" => ["abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"], |
|||
"bob" => ["cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"], |
|||
"col" => ["hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"], |
|||
"dan" => ["ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"], |
|||
"ed" => ["jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"], |
|||
"fred" => ["bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"], |
|||
"gav" => ["gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"], |
|||
"hal" => ["abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"], |
|||
"ian" => ["hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"], |
|||
"jon" => ["abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope"] |
|||
) |
|||
const femalepreferences = Dict( |
|||
"abi"=> ["bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"], |
|||
"bea"=> ["bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"], |
|||
"cath"=> ["fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"], |
|||
"dee"=> ["fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"], |
|||
"eve"=> ["jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"], |
|||
"fay"=> ["bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"], |
|||
"gay"=> ["jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"], |
|||
"hope"=> ["gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"], |
|||
"ivy"=> ["ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"], |
|||
"jan"=> ["ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan"] |
|||
) |
|||
function pshuf(d) |
|||
ret = Dict() |
|||
for (k,v) in d |
|||
ret[k] = shuffle(v) |
|||
end |
|||
ret |
|||
end |
|||
# helper functions for the verb: p1 "prefers" p2 over p3 |
|||
pindexin(a, p) = ([i for i in 1:length(a) if a[i] == p])[1] |
|||
prefers(d, p1, p2, p3) = (pindexin(d[p1], p2) < pindexin(d[p1], p3)) |
|||
function isstable(mmatchup, fmatchup, mpref, fpref) |
|||
for (mmatch, fmatch) in mmatchup |
|||
for f in mpref[mmatch] |
|||
if(f != fmatch && prefers(mpref, mmatch, f, fmatch) |
|||
&& prefers(fpref, f, mmatch, fmatchup[f])) |
|||
return false |
|||
end |
|||
end |
|||
end |
|||
true |
|||
end |
|||
function galeshapley(men, women, malepref, femalepref) |
|||
# Initialize all m ∈ M and w ∈ W to free |
|||
mfree = Dict([(p, true) for p in men]) |
|||
wfree = Dict([(p, true) for p in women]) |
|||
mpairs = Dict() |
|||
wpairs = Dict() |
|||
while true # while ∃ free man m who still has a woman w to propose to |
|||
bachelors = [p for p in keys(mfree) if mfree[p]] |
|||
if(length(bachelors) == 0) |
|||
return mpairs, wpairs |
|||
end |
|||
for m in bachelors |
|||
for w in malepref[m] # w = first woman on m’s list to whom m has not yet proposed |
|||
if(wfree[w]) # if w is free (else some pair (m', w) already exists) |
|||
#println("Free match: $m, $w") |
|||
mpairs[m] = w # (m, w) become engaged |
|||
wpairs[w] = m # double entry bookeeping |
|||
mfree[m] = false |
|||
wfree[w] = false |
|||
break |
|||
elseif(prefers(femalepref, w, m, wpairs[w])) # if w prefers m to m' |
|||
#println("Unmatch $(wpairs[w]), match: $m, $w") |
|||
mfree[wpairs[w]] = true # m' becomes free |
|||
mpairs[m] = w # (m, w) become engaged |
|||
wpairs[w] = m |
|||
mfree[m] = false |
|||
break |
|||
end # else (m', w) remain engaged, so continue |
|||
end |
|||
end |
|||
end |
|||
end |
|||
function tableprint(txt, ans, stab) |
|||
println(txt) |
|||
println(" Man Woman") |
|||
println(" ----- -----") |
|||
show(STDOUT, "text/plain", ans) |
|||
if(stab) |
|||
println("\n ----STABLE----\n\n") |
|||
else |
|||
println("\n ---UNSTABLE---\n\n") |
|||
end |
|||
end |
|||
println("Use the Gale Shapley algorithm to find a stable set of engagements.") |
|||
answer = galeshapley(males, females, malepreferences, femalepreferences) |
|||
stabl = isstable(answer[1], answer[2], malepreferences, femalepreferences) |
|||
tableprint("Original Data Table", answer[1], stabl) |
|||
println("To check this is not a one-off solution, run the function on a randomized sample.") |
|||
newmpref = pshuf(malepreferences) |
|||
newfpref = pshuf(femalepreferences) |
|||
answer = galeshapley(males, females, newmpref, newfpref) |
|||
stabl = isstable(answer[1], answer[2], newmpref, newfpref) |
|||
tableprint("Shuffled Preferences", answer[1], stabl) |
|||
# trade abe with bob |
|||
println("Perturb this set of engagements to form an unstable set of engagements then check this new set for stability.") |
|||
answer = galeshapley(males, females, malepreferences, femalepreferences) |
|||
fia1 = (answer[1])["abe"] |
|||
fia2 = (answer[1])["bob"] |
|||
answer[1]["abe"] = fia2 |
|||
answer[1]["bob"] = fia1 |
|||
answer[2][fia1] = "bob" |
|||
answer[2][fia2] = "abe" |
|||
stabl = isstable(answer[1], answer[2], malepreferences, femalepreferences) |
|||
tableprint("Original Data With Bob and Abe Switched", answer[1], stabl) |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
Use the Gale Shapley algorithm to find a stable set of engagements. |
|||
Original Data Table |
|||
Man Woman |
|||
----- ----- |
|||
Dict{Any,Any} with 10 entries: |
|||
"bob" => "cath" |
|||
"dan" => "fay" |
|||
"fred" => "bea" |
|||
"jon" => "abi" |
|||
"ian" => "hope" |
|||
"gav" => "gay" |
|||
"ed" => "jan" |
|||
"col" => "dee" |
|||
"hal" => "eve" |
|||
"abe" => "ivy" |
|||
----STABLE---- |
|||
To check this is not a one-off solution, run the function on a randomized sample. |
|||
Shuffled Preferences |
|||
Man Woman |
|||
----- ----- |
|||
Dict{Any,Any} with 10 entries: |
|||
"bob" => "abi" |
|||
"dan" => "bea" |
|||
"fred" => "jan" |
|||
"jon" => "dee" |
|||
"ian" => "fay" |
|||
"gav" => "ivy" |
|||
"ed" => "gay" |
|||
"col" => "cath" |
|||
"hal" => "hope" |
|||
"abe" => "eve" |
|||
----STABLE---- |
|||
Perturb this set of engagements to form an unstable set of engagements then check this new set for stability. |
|||
Original Data With Bob and Abe Switched |
|||
Man Woman |
|||
----- ----- |
|||
Dict{Any,Any} with 10 entries: |
|||
"bob" => "ivy" |
|||
"dan" => "fay" |
|||
"fred" => "bea" |
|||
"jon" => "abi" |
|||
"ian" => "hope" |
|||
"gav" => "gay" |
|||
"ed" => "jan" |
|||
"col" => "dee" |
|||
"hal" => "eve" |
|||
"abe" => "cath" |
|||
---UNSTABLE--- |
|||
</pre> |
|||
=={{header|Kotlin}}== |
=={{header|Kotlin}}== |