125 lines
5.5 KiB
Text
125 lines
5.5 KiB
Text
# 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]))
|
||
println("$mmatch prefers $f and $f prefers $mmatch over their current partners.")
|
||
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)
|