June 2018 Update

Task/Stable-marriage-problem/Julia/stable-marriage-problem.julia

@@ -0,0 +1,125 @@
+# 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)