Stable marriage problem: Difference between revisions
(→{{header|Lua}}: Marked incomplete as perturbing the engagements and then checking for stability is not attempted) |
m (→{{header|J}}) |
||
Line 760: | Line 760: | ||
)</lang> |
)</lang> |
||
For most of this, males and females are both represented by indices. Rows of <code>Mprefs</code> are indexed by a male index and list female indices in priority order. Rows of <code>Fprefs</code> are indexed by a female index and list male indices in priority order. |
For most of this, males and females are both represented by indices. Rows of <code>Mprefs</code> are indexed by a male index and each contains a list female indices, in priority order. Rows of <code>Fprefs</code> are indexed by a female index and each contains a list male indices in priority order. These indices select the corresponding names from <code>GuyNames</code> and <code>GalNames</code>. |
||
In <code>matchMake</code> (and <code>propose</code>), <code>engaged</code> identifies the gal each guy is engaged to (or <code>_</code> if that guy is not engaged). And, <code>fallback</code> identifies the column which has the next gal, in <code>Mprefs</code>, for that guy to propose to. |
In <code>matchMake</code> (and <code>propose</code>), <code>engaged</code> identifies the gal each guy is engaged to (or <code>_</code> if that guy is not engaged). And, <code>fallback</code> identifies the column which has the next gal, in <code>Mprefs</code>, for that guy to propose to. |
Revision as of 14:37, 14 April 2011
You are encouraged to solve this task according to the task description, using any language you may know.
Solve the Stable marriage problem using the Gale/Shapley algorithm.
Problem description
Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each women ranks all the men in order of her preference.
A stable set of engagements for marriage is one where no man prefers a women over the one he is engaged to, where that other woman also prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change.
Gale and Shipley proved that there is a stable set of engagements for any set of preferences and the first link above gives their algorithm for finding a set of stable engagements.
Task Specifics
Given ten males:
abe, bob, col, dan, ed, fred, gav, hal, ian, jon
And ten females:
abi, bea, cath, dee, eve, fay, gay, hope, ivy, jan
And a complete list of ranked preferences, where the most liked is to the left:
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 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
- Use the Gale Shapley algorithm to find a stable set of engagements
- Perturb this set of engagements to form an unstable set of engagements then check this new set for stability.
References
- The Stable Marriage Problem. (Eloquent description and background information).
- Gale-Shapley Algorithm Demonstration.
C++
<lang cpp>#include <algorithm>
- include <iostream>
- include <map>
- include <queue>
- include <string>
- include <vector>
using namespace std;
const char *men_data[][11] = {
{ "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 char *women_data[][11] = {
{ "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" }
};
typedef vector<string> PrefList; typedef map<string, PrefList> PrefMap; typedef map<string, string> Couples;
// Does 'first' appear before 'second' in preference list? bool prefers(const PrefList &prefer, const string &first, const string &second) {
for (PrefList::const_iterator it = prefer.begin(); it != prefer.end(); ++it) { if (*it == first) return true; if (*it == second) return false; } return false; // no preference
}
void check_stability(const Couples &engaged, const PrefMap &men_pref, const PrefMap &women_pref) {
cout << "Stablility:\n"; bool stable = true; for (Couples::const_iterator it = engaged.begin(); it != engaged.end(); ++it) { const string &bride = it->first; const string &groom = it->second; const PrefList &preflist = men_pref.at(groom);
for (PrefList::const_iterator it = preflist.begin(); it != preflist.end(); ++it) { if (*it == bride) // he prefers his bride break; if (prefers(preflist, *it, bride) && // he prefers another woman prefers(women_pref.at(*it), groom, engaged.at(*it))) // other woman prefers him { cout << "\t" << *it << " prefers " << groom << " over " << engaged.at(*it) << " and " << groom << " prefers " << *it << " over " << bride << "\n"; stable = false; } } } if (stable) cout << "\t(all marriages stable)\n";
}
int main() {
PrefMap men_pref, women_pref; queue<string> bachelors;
// init data structures for (int i = 0; i < 10; ++i) // person { for (int j = 1; j < 11; ++j) // preference { men_pref[ men_data[i][0]].push_back( men_data[i][j]); women_pref[women_data[i][0]].push_back(women_data[i][j]); } bachelors.push(men_data[i][0]); }
Couples engaged; // <woman,man>
cout << "Matchmaking:\n"; while (!bachelors.empty()) { const string &suitor = bachelors.front(); const PrefList &preflist = men_pref[suitor];
for (PrefList::const_iterator it = preflist.begin(); it != preflist.end(); ++it) { const string &bride = *it;
if (engaged.find(bride) == engaged.end()) // she's available { cout << "\t" << bride << " and " << suitor << "\n"; engaged[bride] = suitor; // hook up break; }
const string &groom = engaged[bride];
if (prefers(women_pref[bride], suitor, groom)) { cout << "\t" << bride << " dumped " << groom << " for " << suitor << "\n"; bachelors.push(groom); // dump that zero engaged[bride] = suitor; // get a hero break; } } bachelors.pop(); // pop at the end to not invalidate suitor reference }
cout << "Engagements:\n"; for (Couples::const_iterator it = engaged.begin(); it != engaged.end(); ++it) { cout << "\t" << it->first << " and " << it->second << "\n"; }
check_stability(engaged, men_pref, women_pref);
cout << "Perturb:\n"; std::swap(engaged["abi"], engaged["bea"]); cout << "\tengage abi with " << engaged["abi"] << " and bea with " << engaged["bea"] << "\n";
check_stability(engaged, men_pref, women_pref);
}</lang> Output:
Matchmaking: abi and abe cath and bob hope and col ivy and dan jan and ed bea and fred gay and gav eve and hal hope dumped col for ian abi dumped abe for jon dee and col ivy dumped dan for abe fay and dan Engagements: abi and jon bea and fred cath and bob dee and col eve and hal fay and dan gay and gav hope and ian ivy and abe jan and ed Stablility: (all marriages stable) Perturb: engage abi with fred and bea with jon Stablility: bea prefers fred over jon and fred prefers bea over abi fay prefers jon over dan and jon prefers fay over bea gay prefers jon over gav and jon prefers gay over bea eve prefers jon over hal and jon prefers eve over bea
D
D v.2, adapted from the Python and Java versions. <lang d>import std.stdio, std.array, std.algorithm, std.string;
string[string] matchmaker(string[][string] guyPrefers,
string[][string] girlPrefers) { string[string] engagedTo; string[] freeGuys = guyPrefers.keys;
while (freeGuys.length) { const string thisGuy = freeGuys[0]; freeGuys.popFront(); const auto thisGuyPrefers = guyPrefers[thisGuy]; foreach (girl; thisGuyPrefers) { if (girl !in engagedTo) { // girl is free engagedTo[girl] = thisGuy; break; } else { string otherGuy = engagedTo[girl]; string[] thisGirlPrefers = girlPrefers[girl]; if (thisGirlPrefers.countUntil(thisGuy) < thisGirlPrefers.countUntil(otherGuy)) { // this girl prefers this guy to // the guy she's engagedTo to. engagedTo[girl] = thisGuy; freeGuys ~= otherGuy; break; } // else no change, keep looking for this guy } } }
return engagedTo;
}
bool check(bool doPrint=false)(string[string] engagedTo,
string[][string] guyPrefers, string[][string] galPrefers) { enum MSG = "%s likes %s better than %s and %s " ~ "likes %s better than their current partner"; string[string] inverseEngaged; foreach (k, v; engagedTo) inverseEngaged[v] = k;
foreach (she, he; engagedTo) { auto sheLikes = galPrefers[she]; auto sheLikesBetter = sheLikes[0 .. sheLikes.countUntil(he)]; auto heLikes = guyPrefers[he]; auto heLikesBetter = heLikes[0 .. heLikes.countUntil(she)]; foreach (guy; sheLikesBetter) { auto guysGirl = inverseEngaged[guy]; auto guyLikes = guyPrefers[guy];
if (guyLikes.countUntil(guysGirl) > guyLikes.countUntil(she)) { static if (doPrint) writefln(MSG, she, guy, he, guy, she); return false; } }
foreach (gal; heLikesBetter) { auto girlsGuy = engagedTo[gal]; auto galLikes = galPrefers[gal];
if (galLikes.countUntil(girlsGuy) > galLikes.countUntil(he)) { static if (doPrint) writefln(MSG, he, gal, she, gal, he); return false; } } }
return true;
}
void main() {
auto guyData = "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";
auto galData = "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";
string[][string] guyPrefers, galPrefers; foreach (line; guyData.splitlines()) guyPrefers[split(line)[0]] = split(line)[1..$]; foreach (line; galData.splitlines()) galPrefers[split(line)[0]] = split(line)[1..$];
writeln("Engagements:"); auto engagedTo = matchmaker(guyPrefers, galPrefers);
writeln("\nCouples:"); string[] parts; foreach (k; engagedTo.keys.sort) writefln("%s is engagedTo to %s", k, engagedTo[k]); writeln();
bool c = check!(true)(engagedTo, guyPrefers, galPrefers); writeln("Marriages are ", c ? "stable" : "unstable");
writeln("\n\nSwapping two fiances to introduce an error"); auto gals = galPrefers.keys.sort; swap(engagedTo[gals[0]], engagedTo[gals[1]]); foreach (gal; gals[0 .. 2]) writefln(" %s is now engagedTo to %s", gal, engagedTo[gal]); writeln();
c = check!(true)(engagedTo, guyPrefers, galPrefers); writeln("Marriages are ", c ? "stable" : "unstable");
}</lang> Output:
Engagements: Couples: abi is engagedTo to jon bea is engagedTo to fred cath is engagedTo to bob dee is engagedTo to col eve is engagedTo to hal fay is engagedTo to dan gay is engagedTo to gav hope is engagedTo to ian ivy is engagedTo to abe jan is engagedTo to ed Marriages are stable Swapping two fiances to introduce an error abi is now engagedTo to fred bea is now engagedTo to jon fred likes bea better than abi and bea likes fred better than their current partner Marriages are unstable
F#
<lang fsharp>let menPrefs =
Map.ofList ["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"]; ]
let womenPrefs =
Map.ofList ["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"]; ]
let men = menPrefs |> Map.toList |> List.map fst |> List.sort let women = womenPrefs |> Map.toList |> List.map fst |> List.sort
type Configuration =
{ proposed: Map<string,string list>; // man -> list of women wifeOf: Map<string, string>; // man -> woman husbandOf: Map<string, string>; // woman -> man }
// query functions
let isFreeMan config man = config.wifeOf.TryFind man = None
let isFreeWoman config woman = config.husbandOf.TryFind woman = None
let hasProposedTo config man woman =
defaultArg (config.proposed.TryFind(man)) [] |> List.exists ((=) woman)
// helper let negate f = fun x -> not (f x)
// returns those 'women' who 'man' has not proposed to before let notProposedBy config man women = List.filter (negate (hasProposedTo config man)) women
let prefers (prefs:Map<string,string list>) w m1 m2 =
let order = prefs.[w] let m1i = List.findIndex ((=) m1) order let m2i = List.findIndex ((=) m2) order m1i < m2i
let womanPrefers = prefers womenPrefs let manPrefers = prefers menPrefs
// returns the women that m likes better than his current fiancée let preferredWomen config m =
let w = config.wifeOf.[m] women |> List.filter (fun w' -> manPrefers m w' w) // '
// whether there is a woman who m likes better than his current fiancée // and who also likes him better than her current fiancé let prefersAWomanWhoAlsoPrefersHim config m =
preferredWomen config m |> List.exists (fun w -> womanPrefers w m config.husbandOf.[w])
let isStable config =
not (List.exists (prefersAWomanWhoAlsoPrefersHim config) men)
// modifiers (return new configurations)
let engage config man woman =
{ config with wifeOf = config.wifeOf.Add(man, woman); husbandOf = config.husbandOf.Add(woman, man) }
let breakOff config man =
let woman = config.wifeOf.[man] { config with wifeOf = config.wifeOf.Remove(man); husbandOf = config.husbandOf.Remove(woman) }
let propose config m w =
// remember the proposition let proposedByM = defaultArg (config.proposed.TryFind m) [] let proposed' = config.proposed.Add(m, w::proposedByM) // ' let config = { config with proposed = proposed'} // ' // actually try to engage if isFreeWoman config w then engage config m w else let m' = config.husbandOf.[w] // ' if womanPrefers w m m' then // ' let config = breakOff config m' // ' engage config m w else config
// do one step of the algorithm; returns None if no more steps are possible let step config : Configuration option =
let freeMen = men |> List.filter (isFreeMan config) let menWhoCanPropose = freeMen |> List.filter (fun man -> (notProposedBy config man women) <> [] ) match menWhoCanPropose with | [] -> None | m::_ -> let unproposedByM = menPrefs.[m] |> notProposedBy config m // w is automatically the highest ranked because menPrefs.[m] is the source let w = List.head unproposedByM Some( propose config m w )
let rec loop config =
match step config with | None -> config | Some config' -> loop config' // '
// find solution and print it
let solution = loop { proposed = Map.empty<string, string list>;
wifeOf = Map.empty<string, string>; husbandOf = Map.empty<string, string> }
for woman, man in Map.toList solution.husbandOf do
printfn "%s is engaged to %s" woman man
printfn "Solution is stable: %A" (isStable solution)
// create unstable configuration by perturbing the solution
let perturbed =
let gal0 = women.[0] let gal1 = women.[1] let guy0 = solution.husbandOf.[gal0] let guy1 = solution.husbandOf.[gal1] { solution with wifeOf = solution.wifeOf.Add( guy0, gal1 ).Add( guy1, gal0 ); husbandOf = solution.husbandOf.Add( gal0, guy1 ).Add( gal1, guy0 ) }
printfn "Perturbed is stable: %A" (isStable perturbed)</lang>
Output:
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 Solution is stable: true Perturbed is stable: false
Haskell
<lang haskell>import Data.List import Control.Monad import Control.Arrow import Data.Maybe
mp = map ((head &&& tail). splitNames)
["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"]
fp = map ((head &&& tail). splitNames)
["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"]
splitNames = map (takeWhile(`notElem`",:")). words
pref x y xs = fromJust (elemIndex x xs) < fromJust (elemIndex y xs)
task ms fs = do
let jos = fst $ unzip ms runGS es js ms = do let (m:js') = js
(v:vm') = case lookup m ms of Just xs -> xs _ -> [] vv = fromJust $ lookup v fs m2 = case lookup v es of Just e -> e _ -> "" ms1 = insert (m,vm') $ delete (m,v:vm') ms
if null js then do
putStrLn "" putStrLn "=== Couples ===" return es
else if null m2 then
do putStrLn $ v ++ " with " ++ m runGS ( insert (v,m) es ) js' ms1
else if pref m m2 vv then
do putStrLn $ v ++ " dumped " ++ m2 ++ " for " ++ m runGS ( insert (v,m) $ delete (v,m2) es ) (if not $ null vm' then js'++[m2] else js') ms1
else runGS es (if not $ null js' then js'++[m] else js') ms1
cs <- runGS [] jos ms mapM_ (\(f,m) -> putStrLn $ f ++ " with " ++ m ) cs putStrLn "" checkStab cs putStrLn "" putStrLn "Introducing error: " let [r1@(a,b), r2@(p,q)] = take 2 cs r3 = (a,q) r4 = (p,b) errcs = insert r4. insert r3. delete r2 $ delete r1 cs putStrLn $ "\tSwapping partners of " ++ a ++ " and " ++ p putStrLn $ (\((a,b),(p,q)) -> "\t" ++ a ++ " is now with " ++ b ++ " and " ++ p ++ " with " ++ q) (r3,r4) putStrLn "" checkStab errcs
checkStab es = do
let fmt (a,b,c,d) = a ++ " and " ++ b ++ " like each other better than their current partners " ++ c ++ " and " ++ d ies = uncurry(flip zip) $ unzip es -- es = [(fem,m)] & ies = [(m,fem)] slb = map (\(f,m)-> (f,m, map (id &&& fromJust. flip lookup ies). fst.break(==m). fromJust $ lookup f fp) ) es hlb = map (\(f,m)-> (m,f, map (id &&& fromJust. flip lookup es ). fst.break(==f). fromJust $ lookup m mp) ) es tslb = concatMap (filter snd. (\(f,m,ls) ->
map (\(m2,f2) -> ((f,m2,f2,m), pref f f2 $ fromJust $ lookup m2 mp)) ls)) slb
thlb = concatMap (filter snd. (\(m,f,ls) ->
map (\(f2,m2) -> ((m,f2,m2,f), pref m m2 $ fromJust $ lookup f2 fp)) ls)) hlb
res = tslb ++ thlb if not $ null res then do putStrLn "Marriages are unstable, e.g.:" putStrLn.fmt.fst $ head res
else putStrLn "Marriages are stable"</lang>
Task:
*Main> task mp fp abi with abe cath with bob hope with col ivy with dan jan with ed bea with fred gay with gav hope dumped col for ian abi dumped abe for jon eve with hal dee with col ivy dumped dan for abe fay with dan === Couples === abi with jon bea with fred cath with bob dee with col eve with hal fay with dan gay with gav hope with ian ivy with abe jan with ed Marriages are stable Introducing error: Swapping partners of abi and bea abi is now with fred and bea with jon Marriages are unstable, e.g.: bea and fred like each other better than their current partners abi and jon
J
<lang j>Mraw=: ;: ;._2 noun define -. ':,'
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
)
Fraw=: ;: ;._2 noun define -. ':,'
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
)
GuyNames=: {."1 Mraw GalNames=: {."1 Fraw
Mprefs=: GalNames i. }."1 Mraw Fprefs=: GuyNames i. }."1 Fraw
propose=: dyad define
engaged=. x 'guy gal'=. y if. gal e. engaged do. fiance=. engaged i. gal if. guy <&((gal{Fprefs)&i.) fiance do. engaged=. gal guy} _ fiance} engaged end. else. engaged=. gal guy} engaged end. engaged
)
matchMake=: monad define
engaged=. _"0 GuyNames NB. initially no one is engaged fallback=. 0"0 engaged NB. and each guy will first propose to his favorite whilst. _ e. engaged do. for_guy. I. _ = engaged do. next=. guy{fallback gal=. (<guy,next){Mprefs engaged=. engaged propose guy,gal fallback=. (next+1) guy} fallback end. end. GuyNames,:engaged{GalNames
)
checkStable=: monad define
'guys gals'=. (GuyNames,:GalNames) i."1 y satisfied=. ] >: (<0 1) |: ] guyshappy=. satisfied (guys{Mprefs) i."1 0/ gals galshappy=. satisfied (gals{Fprefs) i."1 0/ guys unstable=. 4$.$.-. guyshappy +. |:galshappy if. bad=. 0 < #unstable do. smoutput 'Engagements preferred by both members to their current ones:' smoutput y {~"1 0"2 1 unstable end. assert-.bad
)</lang>
For most of this, males and females are both represented by indices. Rows of Mprefs
are indexed by a male index and each contains a list female indices, in priority order. Rows of Fprefs
are indexed by a female index and each contains a list male indices in priority order. These indices select the corresponding names from GuyNames
and GalNames
.
In matchMake
(and propose
), engaged
identifies the gal each guy is engaged to (or _
if that guy is not engaged). And, fallback
identifies the column which has the next gal, in Mprefs
, for that guy to propose to.
Example use:
<lang> matchMake ┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐ │abe│bob │col│dan│ed │fred│gav│hal│ian │jon│ ├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤ │ivy│cath│dee│fay│jan│bea │gay│eve│hope│abi│ └───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘</lang>
Stability check:
<lang j> 0 105 A."_1 matchMake NB. swap abi and bea ┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐ │abe│bob │col│dan│ed │fred│gav│hal│ian │jon│ ├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤ │ivy│cath│dee│fay│jan│abi │gay│eve│hope│bea│ └───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘
checkStable 0 105 A."_1 matchMake
Engagements preferred by both members to their current ones: ┌────┬───┐ │fred│bea│ ├────┼───┤ │jon │fay│ ├────┼───┤ │jon │gay│ ├────┼───┤ │jon │eve│ └────┴───┘ |assertion failure: assert | assert-.bad</lang>
As an aside, note that the guys fared much better than the gals here, with over half of the guys getting their first preference and only one gal getting her first preference. The worst match for any guy was fourth preference where the worst for any gal was seventh preference.
Java
This is not a direct translation of Python, but it's fairly close (especially the stability check). <lang java5>import java.util.*;
public class Stable {
static List<String> guys = Arrays.asList( new String[]{ "abe", "bob", "col", "dan", "ed", "fred", "gav", "hal", "ian", "jon"}); static List<String> girls = Arrays.asList( new String[]{ "abi", "bea", "cath", "dee", "eve", "fay", "gay", "hope", "ivy", "jan"}); static Map<String, List<String>> guyPrefers = new HashMap<String, List<String>>(){{ put("abe", Arrays.asList("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay")); put("bob", Arrays.asList("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay")); put("col", Arrays.asList("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan")); put("dan", Arrays.asList("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi")); put("ed", Arrays.asList("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay")); put("fred", Arrays.asList("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay")); put("gav", Arrays.asList("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay")); put("hal", Arrays.asList("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee")); put("ian", Arrays.asList("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve")); put("jon", Arrays.asList("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope")); }}; static Map<String, List<String>> girlPrefers = new HashMap<String, List<String>>(){{ put("abi", Arrays.asList("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal")); put("bea", Arrays.asList("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal")); put("cath", Arrays.asList("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon")); put("dee", Arrays.asList("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed")); put("eve", Arrays.asList("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob")); put("fay", Arrays.asList("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal")); put("gay", Arrays.asList("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian")); put("hope", Arrays.asList("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred")); put("ivy", Arrays.asList("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan")); put("jan", Arrays.asList("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan")); }}; public static void main(String[] args){ Map<String, String> matches = match(guys, guyPrefers, girlPrefers); for(Map.Entry<String, String> couple:matches.entrySet()){ System.out.println( couple.getKey() + " is engaged to " + couple.getValue()); } if(checkMatches(guys, girls, matches, guyPrefers, girlPrefers)){ System.out.println("Marriages are stable"); }else{ System.out.println("Marriages are unstable"); } String tmp = matches.get(girls.get(0)); matches.put(girls.get(0), matches.get(girls.get(1))); matches.put(girls.get(1), tmp); System.out.println( girls.get(0) +" and " + girls.get(1) + " have switched partners"); if(checkMatches(guys, girls, matches, guyPrefers, girlPrefers)){ System.out.println("Marriages are stable"); }else{ System.out.println("Marriages are unstable"); } }
private static Map<String, String> match(List<String> guys, Map<String, List<String>> guyPrefers, Map<String, List<String>> girlPrefers){ Map<String, String> engagedTo = new TreeMap<String, String>(); List<String> freeGuys = new LinkedList<String>(); freeGuys.addAll(guys); while(!freeGuys.isEmpty()){ String thisGuy = freeGuys.remove(0); //get a load of THIS guy List<String> thisGuyPrefers = guyPrefers.get(thisGuy); for(String girl:thisGuyPrefers){ if(engagedTo.get(girl) == null){//girl is free engagedTo.put(girl, thisGuy); //awww break; }else{ String otherGuy = engagedTo.get(girl); List<String> thisGirlPrefers = girlPrefers.get(girl); if(thisGirlPrefers.indexOf(thisGuy) < thisGirlPrefers.indexOf(otherGuy)){ //this girl prefers this guy to the guy she's engaged to engagedTo.put(girl, thisGuy); freeGuys.add(otherGuy); break; }//else no change...keep looking for this guy } } } return engagedTo; }
private static boolean checkMatches(List<String> guys, List<String> girls, Map<String, String> matches, Map<String, List<String>> guyPrefers, Map<String, List<String>> girlPrefers) { if(!matches.keySet().containsAll(girls)){ return false; }
if(!matches.values().containsAll(guys)){ return false; }
Map<String, String> invertedMatches = new TreeMap<String, String>(); for(Map.Entry<String, String> couple:matches.entrySet()){ invertedMatches.put(couple.getValue(), couple.getKey()); }
for(Map.Entry<String, String> couple:matches.entrySet()){ List<String> shePrefers = girlPrefers.get(couple.getKey()); List<String> sheLikesBetter = new LinkedList<String>(); sheLikesBetter.addAll(shePrefers.subList(0, shePrefers.indexOf(couple.getValue()))); List<String> hePrefers = guyPrefers.get(couple.getValue()); List<String> heLikesBetter = new LinkedList<String>(); heLikesBetter.addAll(hePrefers.subList(0, hePrefers.indexOf(couple.getKey())));
for(String guy : sheLikesBetter){ String guysFinace = invertedMatches.get(guy); List<String> thisGuyPrefers = guyPrefers.get(guy); if(thisGuyPrefers.indexOf(guysFinace) > thisGuyPrefers.indexOf(couple.getKey())){ System.out.printf("%s likes %s better than %s and %s" + " likes %s better than their current partner\n", couple.getKey(), guy, couple.getValue(), guy, couple.getKey()); return false; } }
for(String girl : heLikesBetter){ String girlsFinace = matches.get(girl); List<String> thisGirlPrefers = girlPrefers.get(girl); if(thisGirlPrefers.indexOf(girlsFinace) > thisGirlPrefers.indexOf(couple.getValue())){ System.out.printf("%s likes %s better than %s and %s" + " likes %s better than their current partner\n", couple.getValue(), girl, couple.getKey(), girl, couple.getValue()); return false; } } } return true; }
}</lang> Output:
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 Marriages are stable abi and bea have switched partners fred likes bea better than abi and bea likes fred better than their current partner Marriages are unstable
Lua
<lang lua> local men = { 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'} }
local women = { 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'} }
local engagements = {}
local singlemen = 0
local function single(name)
local partner = engagements[name]
if partner then engagements[name] = nil engagements[partner] = nil end
if men[name] then singlemen = singlemen + 1 end
end
for guys,_ in pairs(men) do single(guys) end for ladies,_ in pairs(women) do single(ladies) end --that is, ahem, ALL the single ladies.
local function engage(man,woman)
engagements[man] = woman engagements[woman] = man singlemen = singlemen - 1
end
local attemptedEngagementsByMan = {}
for name,list in pairs(men) do
attemptedEngagementsByMan[name] = {}
end
while singlemen > 0 do
local man local woman
--get a single man for singleman,prefs in pairs(men) do if not engagements[singleman] then man = singleman; break end end
--get his most preferred untried lady local myAttempts = attemptedEngagementsByMan[man] for i,lady in ipairs(men[man]) do if not myAttempts[lady] then woman = lady; break end end
--propose myAttempts[woman] = true local totalJerk = engagements[woman] if not totalJerk then engage(man,woman) else for i,herPreference in ipairs(women[woman]) do if herPreference == man then single(totalJerk) single(woman) engage(man,woman) break --leaves the jerk at the altar! elseif herPreference == totalJerk then break --shot down end end end
end
for name,_ in pairs(men) do
print(name, " liked it so he put a ring on ", engagements[name])
end </lang>
output:
jon liked it so he put a ring on abi abe liked it so he put a ring on ivy ed liked it so he put a ring on jan ian liked it so he put a ring on hope dan liked it so he put a ring on fay col liked it so he put a ring on dee gav liked it so he put a ring on gay hal liked it so he put a ring on eve fred liked it so he put a ring on bea bob liked it so he put a ring on cath
OCaml
<lang ocaml>let men = [
"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"];
]
let women = [
"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"];
]
type woman_name = string type man_name = string
type man =
{ m_name: man_name; free: bool; women_rank: woman_name list; has_proposed: woman_name list }
type woman =
{ w_name: woman_name; men_rank: man_name list; engaged: man_name option }
let free_men men =
List.filter (fun m -> m.free) men
let replace m ms =
let rec aux acc = function | _m::ms -> if _m.m_name = m.m_name then List.rev_append acc (m::ms) else aux (_m::acc) ms | [] -> invalid_arg "replace" in aux [] ms
let becomes_free m_name ms =
let m = List.find (fun m -> m.m_name = m_name) ms in let m = { m with free = true } in replace m ms
let rank_of w m =
let rec aux i = function | _m::ms -> if _m = m then i else aux (succ i) ms | [] -> invalid_arg "rank_of" in aux 0 w.men_rank
let get_highest_ranked m =
(* highest ranked woman who the man has not proposed to yet *) let rec aux = function | w::ws -> if List.mem w m.has_proposed then aux ws else (w) | [] -> invalid_arg "get_highest_ranked" in aux m.women_rank
let more_ranked_than name rank =
let rec aux acc = function | x::xs -> if x = name then (List.rev acc) else aux (x::acc) xs | [] -> (List.rev acc) in aux [] rank
let build_structs ~men ~women =
List.map (fun (name, rank) -> { m_name = name; women_rank = rank; free = true; has_proposed = [] } ) men, List.map (fun (name, rank) -> { w_name = name; men_rank = rank; engaged = None } ) women
let _stable_matching ms ws =
let rec aux ms ws = match free_men ms with (*TODO free men who still has some w to propose to *) | [] -> (ms, ws) | m::_ -> let w = get_highest_ranked m in let m = { m with has_proposed = w :: m.has_proposed } in let w, ws = List.partition (fun _w -> _w.w_name = w) ws in let w = List.hd w in match w.engaged with | None -> (* w is free *) (* (m, w) become engaged *) let w = { w with engaged = Some m.m_name } and m = { m with free = false } in aux (replace m ms) (w::ws) | Some m' -> (* some pair (m', w) already exists *) if (rank_of w m.m_name) > (rank_of w m') then aux (replace m ms) (w::ws) (* (m', w) remain engaged *) else begin (* w prefers m to m' *) let w = { w with engaged = Some m.m_name } and m = { m with free = false } in aux (replace m (becomes_free m' ms)) (w::ws) end in aux ms ws
let stable_matching ~men ~women =
let ms, ws = build_structs ~men ~women in let _, ws = _stable_matching ms ws in let some = function Some v -> v | None -> "" in let engagements = List.map (fun w -> w.w_name, some w.engaged) ws in (engagements)
let is_stable ~men ~women eng =
let ms, ws = build_structs ~men ~women in try List.iter (fun (wn, mn) -> let m = List.find (fun m -> m.m_name = mn) ms in let prefered_women = more_ranked_than wn m.women_rank in List.iter (fun pref_w -> let w = List.find (fun w -> w.w_name = pref_w) ws in let eng_m = List.assoc pref_w eng in let prefered_men = more_ranked_than eng_m w.men_rank in if List.mem m.m_name prefered_men then raise Exit (* one unstable engagement found *) ) prefered_women ) eng; (true) with Exit -> (false)
let perturb_engagements eng =
Random.self_init(); let eng = Array.of_list eng in let len = Array.length eng in for n = 1 to 3 do let i = Random.int len and j = Random.int len in let w1, m1 = eng.(i) and w2, m2 = eng.(j) in eng.(i) <- (w1, m2); eng.(j) <- (w2, m1); done; Array.to_list eng
let print engs =
List.iter (fun (w,m) -> Printf.printf " %4s is engaged with %s\n" w m) engs; Printf.printf "# Engagements %s stable\n" (if is_stable ~men ~women engs then "are" else "are not")
let () =
let engagements = stable_matching ~men ~women in print engagements; print_endline "========================"; let engagements = perturb_engagements engagements in print engagements;
- </lang>
Output:
fay is engaged with dan ivy is engaged with abe cath is engaged with bob eve is engaged with hal abi is engaged with jon dee is engaged with col hope is engaged with ian gay is engaged with gav bea is engaged with fred jan is engaged with ed # Engagements are stable ======================== fay is engaged with abe ivy is engaged with dan cath is engaged with hal eve is engaged with bob abi is engaged with jon dee is engaged with col hope is engaged with ed gay is engaged with gav bea is engaged with fred jan is engaged with ian # Engagements are not stable
PicoLisp
<lang PicoLisp>(setq
*Boys (list (de abe abi eve cath ivy jan dee fay bea hope gay) (de bob cath hope abi dee eve fay bea jan ivy gay) (de col hope eve abi dee bea fay ivy gay cath jan) (de dan ivy fay dee gay hope eve jan bea cath abi) (de ed jan dee bea cath fay eve abi ivy hope gay) (de fred bea abi dee gay eve ivy cath jan hope fay) (de gav gay eve ivy bea cath abi dee hope jan fay) (de hal abi eve hope fay ivy cath jan bea gay dee) (de ian hope cath dee gay bea abi fay ivy jan eve) (de jon abi fay jan gay eve bea dee cath ivy hope) ) *Girls (list (de bi bob fred jon gav ian abe dan ed col hal) (de bea bob abe col fred gav dan ian ed jon hal) (de cath fred bob ed gav hal col ian abe dan jon) (de dee fred jon col abe ian hal gav dan bob ed) (de eve jon hal fred dan abe gav col ed ian bob) (de fay bob abe ed ian jon dan fred gav col hal) (de gay jon gav hal fred bob abe col ed dan ian) (de hope gav jon bob abe ian dan hal ed col fred) (de ivy ian col hal gav fred bob abe ed jon dan) (de jan ed hal gav abe bob jon col ian fred dan) ) *Couples NIL )
(bind *Boys
(while (find '((Boy) (and (val Boy) (not (asoq Boy *Couples)))) *Boys ) (let (Boy @ Girl (pop Boy) Pair (find '((P) (== Girl (cdr P))) *Couples)) (nond (Pair (push '*Couples (cons Boy Girl))) # Girl is free ((memq Boy (memq (car Pair) (val Girl))) # Girl prefers Boy (set Pair Boy) ) ) ) ) )
(for Pair *Couples
(prinl (cdr Pair) " is engaged to " (car Pair)) )
(de checkCouples ()
(unless (filter '((Pair) (let (Boy (car Pair) Girl (cdr Pair)) (find '((B) (and (memq Boy (cdr (memq B (val Girl)))) # Girl prefers B (memq (cdr (asoq B *Couples)) # and B prefers Girl (cdr (memq Girl (val B))) ) (prinl Girl " likes " B " better than " Boy " and " B " likes " Girl " better than " (cdr (asoq B *Couples)) ) ) ) (val Girl) ) ) ) *Couples ) (prinl "All marriages are stable") ) )
(checkCouples) (prinl) (prinl "Engage fred with abi and jon with bea") (con (asoq 'fred *Couples) 'abi) (con (asoq 'jon *Couples) 'bea) (checkCouples)</lang> Output:
dee is engaged to col fay is engaged to dan eve is engaged to hal gay is engaged to gav bea is engaged to fred jan is engaged to ed ivy is engaged to abe hope is engaged to ian cath is engaged to bob abi is engaged to jon All marriages are stable Engage fred with abi and jon with bea fay likes jon better than dan and jon likes fay better than bea eve likes jon better than hal and jon likes eve better than bea gay likes jon better than gav and jon likes gay better than bea bea likes fred better than jon and fred likes bea better than abi
Prolog
Works with SWI-Prolog and XPCE.
XPCE is used for his integrated messaging system.
<lang Prolog>%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% facts
prefere(abe,[ abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay]).
prefere( bob,[ cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay]).
prefere( col,[ hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan]).
prefere( dan,[ ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi]).
prefere( ed,[ jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay]).
prefere( fred,[ bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay]).
prefere( gav,[ gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay]).
prefere( hal,[ abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee]).
prefere( ian,[ hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve]).
prefere( jon,[ abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope]).
prefere( abi,[ bob, fred, jon, gav, ian, abe, dan, ed, col, hal]). prefere( bea,[ bob, abe, col, fred, gav, dan, ian, ed, jon, hal]). prefere( cath,[ fred, bob, ed, gav, hal, col, ian, abe, dan, jon]). prefere( dee,[ fred, jon, col, abe, ian, hal, gav, dan, bob, ed]). prefere( eve,[ jon, hal, fred, dan, abe, gav, col, ed, ian, bob]). prefere( fay,[ bob, abe, ed, ian, jon, dan, fred, gav, col, hal]). prefere( gay,[ jon, gav, hal, fred, bob, abe, col, ed, dan, ian]). prefere( hope,[ gav, jon, bob, abe, ian, dan, hal, ed, col, fred]). prefere( ivy,[ ian, col, hal, gav, fred, bob, abe, ed, jon, dan]). prefere( jan,[ ed, hal, gav, abe, bob, jon, col, ian, fred, dan]).
man(abe).
man(bob).
man(col).
man(dan).
man(ed).
man(fred).
man(gav).
man(hal).
man(ian).
man(jon).
woman(abi). woman(bea). woman(cath). woman(dee). woman(eve). woman(fay). woman(gay). woman(hope). woman(ivy). woman(jan).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % rules
stable_mariage :- new(LstMan, chain), forall(man(X), ( prefere(X, Lst), new(P, man(X, Lst)), send(LstMan, append, P))),
new(LstWoman, chain), forall(woman(X), ( prefere(X, Lst), new(P, woman(X, Lst)), send(LstWoman, append, P))), send(LstMan, for_all, message(@arg1, init_liste, LstWoman)), send(LstWoman, for_all, message(@arg1, init_liste, LstMan)),
round(LstMan, LstWoman), new(LstCouple, chain), % creation of the couple. send(LstWoman, for_all, and(message(@prolog, create_couple, @arg1, LstCouple), message(@pce, write_ln, @arg1?name, with, @arg1?elu?name))),
nl,
% test of the stability of couples stability(LstCouple), nl,
% Perturbation of couples get(LstCouple, size, Len), get_two_random_couples(Len, V1, V2),
get(LstCouple, nth0, V1, C1), get(LstCouple, nth0, V2, C2), new(NC1, tuple(C1?first, C2?second)), new(NC2, tuple(C2?first, C1?second)), send(LstCouple, nth0, V1, NC1), send(LstCouple, nth0, V2, NC2),
send(@pce, write_ln, 'perturbation of couples'), send(@pce, write_ln, NC1?second, with, NC1?first), send(@pce, write_ln, NC2?second, with, NC2?first), nl,
stability(LstCouple).
get_two_random_couples(Len, C1, C2) :- C1 is random(Len), repeat, C2 is random(Len), C1 \= C2.
create_couple(Woman, LstCouple ) :- send(LstCouple, append, new(_, tuple(Woman?elu?name, Woman?name))).
% iterations of the algorithm round(LstMan, LstWoman) :- send(LstMan, for_some, message(@arg1, propose)), send(LstWoman, for_some, message(@arg1, dispose)), ( \+send(LstWoman, for_all, @arg1?status == maybe) -> round(LstMan, LstWoman) ; true ).
- -pce_begin_class(person, object, "description of a person").
variable(name, object, both, "name of the person"). variable(preference, chain, both, "list of priority"). variable(status, object, both, "statut of engagement : maybe / free").
initialise(P, Name, Pref) :-> send(P, send_super, initialise), send(P, slot, name, Name), send(P, slot, preference, Pref), send(P, slot, status, free).
% reception of the list of partners init_liste(P, Lst) :-> % we replace the list of name of partners % with the list of persons partners. new(NLP, chain), get(P, slot, preference, LP), send(LP, for_all, message(@prolog, find_person,@arg1, Lst, NLP)), send(P, slot, preference, NLP).
- - pce_end_class(person).
find_person(Name, LstPerson, LstPref) :- get(LstPerson, find, @arg1?name == Name, Elem), send(LstPref, append, Elem).
- -pce_begin_class(man, person, "description of a man").
initialise(P, Name, Pref) :-> send(P, send_super, initialise, Name, Pref).
% a man propose "la botte" to a woman propose(P) :-> get(P, slot, status, free), get(P, slot, preference, XPref), get(XPref, delete_head, Pref), send(P, slot, preference, XPref), send(Pref, proposition, P).
refuse(P) :-> send(P, slot, status, free).
accept(P) :-> send(P, slot, status, maybe).
- - pce_end_class(man).
- -pce_begin_class(woman, person, "description of a woman").
variable(elu, object, both, "name of the elu"). variable(contact, chain, both, "men that have contact this woman").
initialise(P, Name, Pref) :-> send(P, send_super, initialise, Name, Pref), send(P, slot, contact, new(_, chain)), send(P, slot, elu, @nil).
% a woman decide Maybe/No dispose(P) :-> get(P, slot, contact, Contact), get(P, slot, elu, Elu),
( Elu \= @nil -> send(Contact, append, Elu) ; true),
new(R, chain), send(Contact, for_all, message(P, fetch, @arg1, R)), send(R, sort, ?(@arg1?first, compare, @arg2?first)), get(R, delete_head, Tete), send(Tete?second, accept), send(P, slot, status, maybe), send(P, slot, elu, Tete?second), send(R, for_some, message(@arg1?second, refuse)), send(P, slot, contact, new(_, chain)) .
% looking for the person of the given name Contact
% Adding it in the chain Chain
fetch(P, Contact, Chain) :->
get(P, slot, preference, Lst),
get(Lst, find, @arg1?name == Contact?name, Elem),
get(Lst, index, Elem, Ind),
send(Chain, append, new(_, tuple(Ind, Contact))).
% a woman receive a proposition from a man proposition(P, Name) :-> get(P, slot, contact, C), send(C, append, Name), send(P, slot, contact, C).
- - pce_end_class(woman).
% computation of the stability od couple stability(LstCouple) :- chain_list(LstCouple, LstPceCouple), maplist(transform, LstPceCouple, PrologLstCouple), study_couples(PrologLstCouple, [], UnstableCouple), ( UnstableCouple = [] -> writeln('Couples are stable') ; sort(UnstableCouple, SortUnstableCouple), writeln('Unstable couples are'), maplist(print_unstable_couple, SortUnstableCouple), nl ).
print_unstable_couple((C1, C2)) :-
format('~w and ~w~n', [C1, C2]).
transform(PceCouple, couple(First, Second)):- get(PceCouple?first, value, First), get(PceCouple?second, value, Second).
study_couples([], UnstableCouple, UnstableCouple).
study_couples([H | T], CurrentUnstableCouple, UnstableCouple):- include(unstable_couple(H), T, Lst), ( Lst \= [] -> maplist(build_one_couple(H), Lst, Lst1), append(CurrentUnstableCouple, Lst1,CurrentUnstableCouple1) ; CurrentUnstableCouple1 = CurrentUnstableCouple ), study_couples(T, CurrentUnstableCouple1, UnstableCouple).
build_one_couple(C1, C2, (C1, C2)).
unstable_couple(couple(X1, Y1), couple(X2, Y2)) :- prefere(X1, PX1), prefere(X2, PX2), prefere(Y1, PY1), prefere(Y2, PY2),
% index of women for X1 nth0(IY12, PX1, Y2), nth0(IY11, PX1, Y1), % index of men for Y2 nth0(IX21, PY2, X1), nth0(IX22, PY2, X2),
% index of women for X2 nth0(IY21, PX2, Y1), nth0(IY22, PX2, Y2), % index of men for Y1 nth0(IX11, PY1, X1), nth0(IX12, PY1, X2),
% A couple is unstable ( (IY12 < IY11 , IX21 < IX22); (IY21 < IY22 , IX12 < IX11)). </lang> The output :
?- stable_mariage. abi with jon bea with fred cath with bob dee with col eve with hal fay with dan gay with gav hope with ian ivy with abe jan with ed Couples are stable perturbation of couples gay with jon abi with gav Unstable couples are couple(gav,abi) and couple(abe,ivy) couple(jon,gay) and couple(dan,fay) couple(jon,gay) and couple(gav,abi) true
A more Prolog-ish version (working with SWI-Prolog) could be :
<lang Prolog>:- dynamic person/4, prop/2.
% person(Name, Preference, Status, Candidate)
% prop(Name, List_of_Candidates) (for a woman)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % facts prefere(abe,[ abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay]). prefere( bob,[ cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay]). prefere( col,[ hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan]). prefere( dan,[ ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi]). prefere( ed,[ jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay]). prefere( fred,[ bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay]). prefere( gav,[ gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay]). prefere( hal,[ abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee]). prefere( ian,[ hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve]). prefere( jon,[ abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope]).
prefere( abi,[ bob, fred, jon, gav, ian, abe, dan, ed, col, hal]). prefere( bea,[ bob, abe, col, fred, gav, dan, ian, ed, jon, hal]). prefere( cath,[ fred, bob, ed, gav, hal, col, ian, abe, dan, jon]). prefere( dee,[ fred, jon, col, abe, ian, hal, gav, dan, bob, ed]). prefere( eve,[ jon, hal, fred, dan, abe, gav, col, ed, ian, bob]). prefere( fay,[ bob, abe, ed, ian, jon, dan, fred, gav, col, hal]). prefere( gay,[ jon, gav, hal, fred, bob, abe, col, ed, dan, ian]). prefere( hope,[ gav, jon, bob, abe, ian, dan, hal, ed, col, fred]). prefere( ivy,[ ian, col, hal, gav, fred, bob, abe, ed, jon, dan]). prefere( jan,[ ed, hal, gav, abe, bob, jon, col, ian, fred, dan]).
man(abe).
man(bob).
man(col).
man(dan).
man(ed).
man(fred).
man(gav).
man(hal).
man(ian).
man(jon).
woman(abi). woman(bea). woman(cath). woman(dee). woman(eve). woman(fay). woman(gay). woman(hope). woman(ivy). woman(jan).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % rules stable_mariage :- %initialization retractall(person(_,_,_,_)), retractall(prop(_,_)), forall(prefere(P, Pref), assert(person(P, Pref, free, none))), bagof(X, man(X), LstMen), bagof(Y, woman(Y), LstWomen), forall(member(Z, LstWomen), assert(prop(Z, []))),
% compute the mariages iteration(LstMen, LstWomen, LstCouple), maplist(print_couple,LstCouple), nl,
% test of the stability of couples stability(LstCouple), nl,
% Perturbation of couples length(LstCouple, Len), get_two_random_couples(Len, V1, V2),
nth0(V1, LstCouple, C1), select(C1, LstCouple, Lst1), ( V2 > 0 -> V22 is V2 - 1; V22 = V2), nth0(V22, Lst1, C2), select(C2, Lst1, Lst2), C1 = couple(M1, W1), C2 = couple(M2, W2),
writeln('perturbation of couples'), format('~w with ~w~n', [W1, M2]), format('~w with ~w~n', [W2, M1]), nl, stability([couple(M1, W2), couple(M2, W1)| Lst2]).
% the algorithm
iteration(Men, Women, LstCouples) :-
% Men propose
bagof(M, X^Y^(member(M, Men),person(M, X, free, Y)), LM),
forall(member(X, LM),
( retract(person(X, [W|Pref], free, Elu)),
assert(person(X, Pref, free, Elu)),
retract(prop(W, Prop)),
assert(prop(W, [X| Prop])))),
% women dispose bagof(W, L^(prop(W, L), L \= []), LW), forall(member(W, LW), ( retract(prop(W, Prop)), retract(person(W, Pref, _, Elu)), ( Elu = none -> Prop1 = Prop; Prop1 = [Elu|Prop]), order_prop(Pref, Prop1, [M | Prop2]), retract(person(M, PrefM, _, _)), assert(person(M, PrefM, maybe, W)), forall(member(Y, Prop2), ( retract(person(Y, Pref1, _, _TE)), assert(person(Y, Pref1, free, none)))), assert(prop(W, [])), assert(person(W, Pref, maybe, M)) )),
% finished ? ( bagof(X, T^Z^(member(X, Women), person(X, T, free, Z)), _LW1) -> iteration(Men, Women, LstCouples) ; make_couple(Women, LstCouples) ).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % compute order preference of candidates. order_prop(Pref, Prop, Res) :- maplist(index(Pref), Prop, Rtemp), sort(Rtemp, Rtemp1), maplist(simplifie,Rtemp1, Res).
index(Lst, Value, [Ind, Value]) :- nth0(Ind, Lst, Value).
simplifie([_, V], V).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% print_couple(couple(M, W)) :- format('~w with ~w~n', [W, M]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % creation of couples make_couple([], []).
make_couple([W | LW], [couple(M, W) | LC]) :- make_couple(LW, LC), person(W, _, _, M).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % miscellaneous get_two_random_couples(Len, C1, C2) :- C1 is random(Len), repeat, C2 is random(Len), C1 \= C2.
print_unstable_couple((C1, C2)) :- format('~w and ~w~n', [C1, C2]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% test the stability of couples
stability(LstCouple) :-
study_couples(LstCouple, [], CoupleInstable),
( CoupleInstable = []
->
writeln('Couples are stable')
;
sort(CoupleInstable, SortCoupleInstable),
writeln('Unstable couples are'),
maplist(print_unstable_couple, SortCoupleInstable),
nl
).
% compute the stability od couple
study_couples([], UnstableCouple, UnstableCouple).
study_couples([H | T], CurrentUnstableCouple, UnstableCouple):- include(unstable_couple(H), T, Lst), ( Lst \= [] -> maplist(build_one_couple(H), Lst, Lst1), append(CurrentUnstableCouple, Lst1,CurrentUnstableCouple1) ; CurrentUnstableCouple1 = CurrentUnstableCouple ), study_couples(T, CurrentUnstableCouple1, UnstableCouple).
build_one_couple(C1, C2, (C1, C2)).
unstable_couple(couple(X1, Y1), couple(X2, Y2)) :- prefere(X1, PX1), prefere(X2, PX2), prefere(Y1, PY1), prefere(Y2, PY2),
% index of women for X1 nth0(IY12, PX1, Y2), nth0(IY11, PX1, Y1), % index of men for Y2 nth0(IX21, PY2, X1), nth0(IX22, PY2, X2),
% index of women for X2 nth0(IY21, PX2, Y1), nth0(IY22, PX2, Y2), % index of men for Y1 nth0(IX11, PY1, X1), nth0(IX12, PY1, X2),
% A couple is unstable ( (IY12 < IY11 , IX21 < IX22); (IY21 < IY22 , IX12 < IX11)). </lang>
PureBasic
This approach uses a messaging system to pass messages between prospective partners. <lang PureBasic>#coupleCount = 10
DataSection
;guys Data.s "abe: abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay" Data.s "bob: cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay" Data.s "col: hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan" Data.s "dan: ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi" Data.s "ed: jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay" Data.s "fred: bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay" Data.s "gav: gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay" Data.s "hal: abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee" Data.s "ian: hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve" Data.s "jon: abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope" ;gals Data.s "abi: bob, fred, jon, gav, ian, abe, dan, ed, col, hal" Data.s "bea: bob, abe, col, fred, gav, dan, ian, ed, jon, hal" Data.s "cath: fred, bob, ed, gav, hal, col, ian, abe, dan, jon" Data.s "dee: fred, jon, col, abe, ian, hal, gav, dan, bob, ed" Data.s "eve: jon, hal, fred, dan, abe, gav, col, ed, ian, bob" Data.s "fay: bob, abe, ed, ian, jon, dan, fred, gav, col, hal" Data.s "gay: jon, gav, hal, fred, bob, abe, col, ed, dan, ian" Data.s "hope: gav, jon, bob, abe, ian, dan, hal, ed, col, fred" Data.s "ivy: ian, col, hal, gav, fred, bob, abe, ed, jon, dan" Data.s "jan: ed, hal, gav, abe, bob, jon, col, ian, fred, dan"
EndDataSection
Structure message
source.s ;person that message is from dest.s ;person that message is for action.s ;{'P', 'A', 'D', 'B'} for proposal, accept, decline, break-up
EndStructure
Structure person
name.s isEngagedTo.s List prefs.s()
EndStructure
Global NewList messages.message()
Procedure setupPersons(List persons.person(), count)
Protected i, j, start, pref$ For i = 1 To count Read.s pref$ pref$ = LCase(pref$) start = FindString(pref$, ":", 1) AddElement(persons()) persons()\name = Left(pref$, start - 1) pref$ = Trim(Right(pref$, Len(pref$) - start)) For j = 1 To count AddElement(persons()\prefs()) persons()\prefs() = Trim(StringField(pref$, j, ",")) Next Next
EndProcedure
Procedure sendMessage(source.s, dest.s, action.s)
LastElement(messages()) AddElement(messages()) With messages() \source = source \dest = dest \action = action EndWith ResetList(messages())
EndProcedure
Procedure selectPerson(name.s, List persons.person())
ForEach persons() If persons()\name = name Break EndIf Next
EndProcedure
Procedure rankPerson(name.s, List prefs.s())
ForEach prefs() If prefs() = name ProcedureReturn #coupleCount - ListIndex(prefs()) ;higher is better EndIf Next ProcedureReturn -1 ;no rank, shouldn't occur
EndProcedure
Procedure stabilityCheck(List guys.person(), List gals.person())
Protected isStable = #True ForEach guys() rankPerson(guys()\isEngagedTo, guys()\prefs()) While PreviousElement(guys()\prefs()) selectPerson(guys()\prefs(), gals()) If rankPerson(guys()\name, gals()\prefs()) > rankPerson(gals()\isEngagedTo, gals()\prefs()) Print(" " + gals()\name + " loves " + guys()\name + " more than " + gals()\isEngagedTo + ",") PrintN(" And " + guys()\name + " loves " + gals()\name + " more than " + guys()\isEngagedTo + ".") isStable = #False EndIf Wend Next If isStable PrintN(#CRLF$ + "Marriage stability check PASSED.") Else PrintN(#CRLF$ + "Marriage stability check FAILED.") EndIf
EndProcedure
NewList guys.person() NewList gals.person() setupPersons(guys(), #coupleCount) setupPersons(gals(), #coupleCount)
- make initial round of proposals
ForEach guys()
FirstElement(guys()\prefs()) sendMessage(guys()\name, guys()\prefs(), "P")
Next
- dispatch messages
Define source.s, dest.s, action.s ForEach messages()
source = messages()\source dest = messages()\dest action = messages()\action DeleteElement(messages()) Select action Case "P" ;propose ;only message received by gals selectPerson(dest, gals()) selectPerson(source, guys()) If rankPerson(guys()\name, gals()\prefs()) < rankPerson(gals()\isEngagedTo, gals()\prefs()) sendMessage(dest, source, "D") ;decline proposal ElseIf rankPerson(guys()\name, gals()\prefs()) > rankPerson(gals()\isEngagedTo, gals()\prefs()) If gals()\isEngagedTo sendMessage(dest, gals()\isEngagedTo, "B") ;break-up engagement EndIf gals()\isEngagedTo = source sendMessage(dest, source, "A") ;accept proposal EndIf Case "A", "D", "B" ;messages received by guys selectPerson(dest, guys()) If action = "A" ;proposal accepted guys()\isEngagedTo = source Else If action = "B" ;broke-up guys()\isEngagedTo = "" EndIf NextElement(guys()\prefs()) sendMessage(dest, guys()\prefs(),"P") ;propose to next pref EndIf EndSelect
Next
If OpenConsole()
PrintN("Marriages:") ForEach guys() PrintN(" " + guys()\name + " And " + guys()\isEngagedTo + ".") Next stabilityCheck(guys(), gals())
Define *person_1.person, *person_2.person PrintN(#CRLF$ + "Introducing an error by swapping partners of abi and bea.") selectPerson("abi", gals()): *person_1 = @gals() selectPerson("bea", gals()): *person_2 = @gals() Swap *person_1\isEngagedTo, *person_2\isEngagedTo selectPerson(*person_1\isEngagedTo, guys()): *person_1 = @guys() selectPerson(*person_1\isEngagedTo, guys()): *person_2 = @guys() Swap *person_1\isEngagedTo, *person_2\isEngagedTo PrintN(" " + *person_1\name + " is now with " + *person_1\isEngagedTo + ".") PrintN(" " + *person_2\name + " is now with " + *person_2\isEngagedTo + ".") PrintN("") stabilityCheck(guys(), gals()) Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() CloseConsole()
EndIf</lang> Sample output:
Marriages: abe And ivy. bob And cath. col And dee. dan And fay. ed And jan. fred And bea. gav And gay. hal And eve. ian And hope. jon And abi. Marriage stability check PASSED. Introducing an error by swapping partners of abi and bea. fred is now with abi. jon is now with bea. bea loves fred more than jon, And fred loves bea more than abi. eve loves jon more than hal, And jon loves eve more than bea. gay loves jon more than gav, And jon loves gay more than bea. fay loves jon more than dan, And jon loves fay more than bea. Marriage stability check FAILED.
Python
<lang python>import copy
guyprefers = {
'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']}
galprefers = {
'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']}
guys = sorted(guyprefers.keys()) gals = sorted(galprefers.keys())
def check(engaged):
inverseengaged = dict((v,k) for k,v in engaged.items()) for she, he in engaged.items(): shelikes = galprefers[she] shelikesbetter = shelikes[:shelikes.index(he)] helikes = guyprefers[he] helikesbetter = helikes[:helikes.index(she)] for guy in shelikesbetter: guysgirl = inverseengaged[guy] guylikes = guyprefers[guy] if guylikes.index(guysgirl) > guylikes.index(she): print("%s and %s like each other better than " "their present partners: %s and %s, respectively" % (she, guy, he, guysgirl)) return False for gal in helikesbetter: girlsguy = engaged[gal] gallikes = galprefers[gal] if gallikes.index(girlsguy) > gallikes.index(he): print("%s and %s like each other better than " "their present partners: %s and %s, respectively" % (he, gal, she, girlsguy)) return False return True
def matchmaker():
guysfree = guys[:] engaged = {} guyprefers2 = copy.deepcopy(guyprefers) galprefers2 = copy.deepcopy(galprefers) while guysfree: guy = guysfree.pop(0) guyslist = guyprefers2[guy] gal = guyslist.pop(0) fiance = engaged.get(gal) if not fiance: # She's free engaged[gal] = guy print(" %s and %s" % (guy, gal)) else: # The bounder proposes to an engaged lass! galslist = galprefers2[gal] if galslist.index(fiance) > galslist.index(guy): # She prefers new guy engaged[gal] = guy print(" %s dumped %s for %s" % (gal, fiance, guy)) if guyprefers2[fiance]: # Ex has more girls to try guysfree.append(fiance) else: # She is faithful to old fiance if guyslist: # Look again guysfree.append(guy) return engaged
print('\nEngagements:')
engaged = matchmaker()
print('\nCouples:') print(' ' + ',\n '.join('%s is engaged to %s' % couple
for couple in sorted(engaged.items())))
print() print('Engagement stability check PASSED'
if check(engaged) else 'Engagement stability check FAILED')
print('\n\nSwapping two fiances to introduce an error') engaged[gals[0]], engaged[gals[1]] = engaged[gals[1]], engaged[gals[0]] for gal in gals[:2]:
print(' %s is now engaged to %s' % (gal, engaged[gal]))
print() print('Engagement stability check PASSED'
if check(engaged) else 'Engagement stability check FAILED')</lang>
Sample Output
Engagements: abe and abi bob and cath col and hope dan and ivy ed and jan fred and bea gav and gay hope dumped col for ian abi dumped abe for jon hal and eve col and dee ivy dumped dan for abe dan and fay 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 Engagement stability check PASSED Swapping two fiances to introduce an error abi is now engaged to fred bea is now engaged to jon fay and jon like each other better than their present partners: dan and bea, respectively Engagement stability check FAILED
SPARK / Ada
This solution works for Ada, too, since SPARK code is correct Ada code.
The data set package: <lang ada>package Preferences is
type Guy_X is (no_guy, abe, bob, col, dan, ed, fred, gav, hal, ian, jon); subtype Guy is Guy_X range Guy_X'Succ(Guy_X'First) .. Guy_X'Last;
type Girl_X is (no_girl, abi, bea, cath, dee, eve, fay, gay, hope, ivy, jan); subtype Girl is Girl_X range Girl_X'Succ(Girl_X'First) .. Girl_X'Last;
type Extended_Rank is range 0 .. 10; subtype Rank is Extended_Rank range 1 .. Extended_Rank'Last;
type His_Rank is array (Rank) of Girl; type He_Prefers is array (Guy) of His_Rank;
Guys_Like : constant He_Prefers := He_Prefers'( abe => His_Rank'(abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay), bob => His_Rank'(cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay), col => His_Rank'(hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan), dan => His_Rank'(ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi), ed => His_Rank'(jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay), fred => His_Rank'(bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay), gav => His_Rank'(gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay), hal => His_Rank'(abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee), ian => His_Rank'(hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve), jon => His_Rank'(abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope));
type Her_Rank is array(Rank) of Guy; type She_Prefers is array (Girl) of Her_Rank;
Girls_Like : constant She_Prefers := She_Prefers'( abi => Her_Rank'(bob, fred, jon, gav, ian, abe, dan, ed, col, hal), bea => Her_Rank'(bob, abe, col, fred, gav, dan, ian, ed, jon, hal), cath => Her_Rank'(fred, bob, ed, gav, hal, col, ian, abe, dan, jon), dee => Her_Rank'(fred, jon, col, abe, ian, hal, gav, dan, bob, ed), eve => Her_Rank'(jon, hal, fred, dan, abe, gav, col, ed, ian, bob), fay => Her_Rank'(bob, abe, ed, ian, jon, dan, fred, gav, col, hal), gay => Her_Rank'(jon, gav, hal, fred, bob, abe, col, ed, dan, ian), hope => Her_Rank'(gav, jon, bob, abe, ian, dan, hal, ed, col, fred), ivy => Her_Rank'(ian, col, hal, gav, fred, bob, abe, ed, jon, dan), jan => Her_Rank'(ed, hal, gav, abe, bob, jon, col, ian, fred, dan));
end Preferences; </lang> The package for creating the engagements and checking stability. This package can be analysed by the SPARK tools and proved to be free of any run-time error. <lang ada>with Preferences; --# inherit Preferences; package Propose is
type Engagements is array (Preferences.Girl) of Preferences.Guy_X;
procedure Engage (Pairs : out Engagements); --# derives Pairs from ;
procedure Check_Stable (Pairs : in Engagements; OK : out Boolean; Other_Girl : out Preferences.Girl_X; Other_Guy : out Preferences.Guy_X); --# derives OK, --# Other_Girl, --# Other_Guy from Pairs;
end Propose; </lang> <lang ada>with Preferences; use type Preferences.Extended_Rank; use type Preferences.Girl; use type Preferences.Guy; package body Propose is
-- renaming subtypes: subtype Guy is Preferences.Guy; subtype Girl is Preferences.Girl;
function Her_Rank_Of_Him (Her : Girl; Him : Guy) return Preferences.Rank is R : Preferences.Rank; begin R := Preferences.Rank'First; while Preferences.Girls_Like(Her)(R) /= Him and R /= Preferences.Rank'Last loop R := Preferences.Rank'Succ(R); end loop; return R; end Her_Rank_Of_Him;
function His_Rank_Of_Her (Him : Guy; Her : Girl) return Preferences.Rank is R : Preferences.Rank; begin R := Preferences.Rank'First; while Preferences.Guys_Like(Him)(R) /= Her and R /= Preferences.Rank'Last loop R := Preferences.Rank'Succ(R); end loop; return R; end His_Rank_Of_Her;
procedure Engage (Pairs : out Engagements) is type Free_Guy is array (Guy) of Boolean; type Free_Girl is array (Girl) of Boolean; type Last_Proposals is array (Guy) of Preferences.Extended_Rank;
-- Initialize all M in M_Free and W in W_Free to free. M_Free : Free_Guy := Free_Guy'(others => True); W_Free : Free_Girl := Free_Girl'(others => True); Last_Proposal : Last_Proposals := Last_Proposals'(others => Preferences.Extended_Rank'First);
All_Paired : Boolean := False; W : Girl; M1 : Preferences.Guy_X;
begin -- Initially set all engagements to null. Pairs := Engagements'(others => Preferences.No_Guy); -- while there is a free man M who still has a woman W to propose to while not All_Paired loop All_Paired := True; for M in Guy loop if M_Free(M) and Last_Proposal(M) < Preferences.Rank'Last then All_Paired := False; -- W = M's highest ranked such woman who he has not -- proposed to yet Last_Proposal(M) := Preferences.Rank'Succ(Last_Proposal(M)); W := Preferences.Guys_Like(M)(Last_Proposal(M)); -- if W is free if W_Free(W) then -- (M, W) become engaged M_Free(M) := False; W_Free(W) := False; Pairs(W) := M; else -- else some pair (M1, W) already exists M1 := Pairs(W); if M1 > Preferences.no_guy and then -- if W prefers M to M1 Her_Rank_Of_Him (Her => W, Him => M) < Her_Rank_Of_Him (Her => W, Him => M1) then -- (M, W) become engaged M_Free(M) := False; Pairs(W) := M; -- M1 becomes free M_Free(M1) := True; else -- (M1, W) remain engaged null; end if; end if; end if; end loop; end loop; end Engage;
procedure Check_Stable (Pairs : in Engagements; OK : out Boolean; Other_Girl : out Preferences.Girl_X; Other_Guy : out Preferences.Guy_X) is M : Preferences.Guy_X; W_Rank : Preferences.Rank; begin OK := True; Other_Girl := Preferences.No_Girl; Other_Guy := Preferences.No_Guy; -- Loop over all girls. for W in Girl loop if Pairs(W) > Preferences.no_guy then W_Rank := Her_Rank_Of_Him (W, Pairs(W)); -- Loop over all guys she prefers to her current guy. for WR in Preferences.Rank range 1 .. W_Rank - 1 loop M := Preferences.Girls_Like(W)(WR); if M > Preferences.no_guy then -- Loop over all girls for this guy in preference order. for MR in Preferences.Rank --# assert M > Preferences.no_guy; loop -- Exit if his current girl found before this girl. exit when M = Pairs(Preferences.Guys_Like(M)(MR)); -- Unstable if this girl found before his current girl. if Preferences.Guys_Like(M)(MR) = W then OK := False; Other_Girl := W; Other_Guy := M; end if; end loop; end if; exit when not OK; end loop; end if; exit when not OK; end loop; end Check_Stable;
end Propose; </lang> The test program tests all pairwise exchanges. This is Ada, it is not SPARK.
(Text IO is quite tedious in SPARK - it's not what the language was designed for.) <lang ada>------------------------------------ -- Test program. -- -- This is Ada, it is not SPARK.
with Ada.Text_IO; with Preferences; with Propose; procedure Matchmaker is
-- renaming subtypes: subtype Guy is Preferences.Guy; subtype Girl is Preferences.Girl;
Marriages : Propose.Engagements; Stable : Boolean; Him : Preferences.Guy_X; Her : Preferences.Girl_X; Stable_Marriages : Propose.Engagements;
procedure Report_Stable is begin if Stable then Ada.Text_IO.Put_Line ("Pairs are Stable"); else Ada.Text_IO.Put ("Pairs are Unstable: "); Ada.Text_IO.Put_Line (Guy'Image(Him) & " and " & Girl'Image(Her) & " prefer each other."); end if; end Report_Stable;
begin
Propose.Engage(Pairs => Marriages); for W in Girl loop Ada.Text_IO.Put_Line (Girl'Image(W) & " marries " & Guy'Image(Marriages(W))); end loop; Propose.Check_Stable (Pairs => Marriages, OK => Stable, Other_Girl => Her, Other_Guy => Him); Report_Stable; Stable_Marriages := Marriages;
for W1 in Girl range Girl'First .. Girl'Pred(Girl'Last) loop for W2 in Girl range Girl'Succ(W1) .. Girl'Last loop Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Exchange " & Guy'Image(Marriages(W1)) & " with " & Guy'Image(Marriages(W2))); Him := Marriages(W1); Marriages(W1) := Marriages(W2); Marriages(W2) := Him; Propose.Check_Stable (Pairs => Marriages, OK => Stable, Other_Girl => Her, Other_Guy => Him); Report_Stable; Marriages := Stable_Marriages; end loop; end loop;
end MatchMaker; </lang> The begining of the output from the test. All pairwise exchanges create unstable pairings.
ABI marries JON BEA marries FRED CATH marries BOB DEE marries COL EVE marries HAL FAY marries DAN GAY marries GAV HOPE marries IAN IVY marries ABE JAN marries ED Pairs are Stable Exchange JON with FRED Pairs are Unstable: FRED and BEA prefer each other. Exchange JON with BOB Pairs are Unstable: BOB and CATH prefer each other. Exchange JON with COL Pairs are Unstable: JON and ABI prefer each other.
Tcl
<lang tcl>package require Tcl 8.5
- Functions as aliases to standard commands
interp alias {} tcl::mathfunc::pos {} ::lsearch -exact interp alias {} tcl::mathfunc::nonempty {} ::llength
- The stability check
proc check engaged {
global preferences set inverse [lreverse $engaged] set errmsg "%s and %s like each other better than their present partners,\
%s and %s respectively"
dict for {she he} $engaged {
set shelikes [dict get $preferences $she] set shelikesbetter [lrange $shelikes 0 [expr {pos($shelikes,$he)}]] set helikes [dict get $preferences $he] set helikesbetter [lrange $helikes 0 [expr {pos($helikes,$she)}]] foreach guy $shelikesbetter { set guysgirl [dict get $inverse $guy] set guylikes [dict get $preferences $guy] if {pos($guylikes,$guysgirl) > pos($guylikes,$she)} { puts [format $errmsg $she $guy $he $guysgirl] return 0 } } foreach gal $helikesbetter { set galsguy [dict get $engaged $gal] set gallikes [dict get $preferences $gal] if {pos($gallikes,$galsguy) > pos($gallikes,$he)} { puts [format $errmsg $he $gal $she $galsguy] return 0 } }
} return 1
}
- The match-making algorithm
proc matchmaker {} {
global guys gals preferences set guysfree $guys set engaged {} array set p $preferences while {nonempty($guysfree)} {
set guysfree [lassign $guysfree guy] set p($guy) [set guyslist [lassign $p($guy) gal]] if {![dict exists $engaged $gal]} { # She's free dict set engaged $gal $guy puts " $guy and $gal" continue } # The bounder proposes to an engaged lass! set fiance [dict get $engaged $gal] if {pos($p($gal), $fiance) > pos($p($gal), $guy)} { # She prefers the new guy dict set engaged $gal $guy puts " $gal dumped $fiance for $guy" set guy $fiance } if {nonempty($p($guy))} { lappend guysfree $guy }
} return $engaged
}
- Problem dataset; preferences unified since all names distinct
set guys {abe bob col dan ed fred gav hal ian jon} set gals {abi bea cath dee eve fay gay hope ivy jan} set preferences {
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}
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}
}
- The demonstration code
puts "Engagements:" set engaged [matchmaker]
puts "\nCouples:" set pfx "" foreach gal $gals {
puts -nonewline "$pfx $gal is engaged to [dict get $engaged $gal]" set pfx ",\n"
} puts "\n" puts "Engagement stability check [lindex {FAILED PASSED} [check $engaged]]"
puts "\n\nSwapping two fiances to introduce an error" set tmp [dict get $engaged [lindex $gals 0]] dict set engaged [lindex $gals 0] [dict get $engaged [lindex $gals 1]] dict set engaged [lindex $gals 1] $tmp foreach gal [lrange $gals 0 1] {
puts " $gal is now engaged to [dict get $engaged $gal]"
} puts "" puts "Engagement stability check [lindex {FAILED PASSED} [check $engaged]]"</lang> Sample output:
Engagements: abe and abi bob and cath col and hope dan and ivy ed and jan fred and bea gav and gay hope dumped col for ian abi dumped abe for jon hal and eve col and dee ivy dumped dan for abe dan and fay 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 Engagement stability check PASSED Swapping two fiances to introduce an error abi is now engaged to fred bea is now engaged to jon fred and bea like each other better than their present partners, abi and jon respectively Engagement stability check FAILED
Ursala
<lang Ursala>men =
{
'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'>}
women =
{
'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'>}
match = # finds a stable list of engagements from data as given above
-+
^=rrmhPnXS ^/~&l ^/~&rl ^|DlrHSs/~& ^TlK2hlPrSLPAS\~&r -+ ~&lK2hlPrSXS, *=rnmihBPK12D ~&mmhPnXNCB^rnPrmPllSPcA\~&r ~&lrrPwZK17@rnPlX+-, ^|rrPlrlPXX/~& ^/~&nNAS ^/~&l+ ^|H\~&+ -:+ * ^|/~& -<+ \/-=+ ~&DSL@tK33+-
preferred = # finds non-couples that would prefer each other to their betrothed
~&lSLPrSLrlXS2c^|DlrHS\~& ~~irlXX+ ^D/~&l+ ^|H\~&+ -:+ *T ^|/~& //~=;+ -~l;+ \/~&H
- cast %sWLm
main = # stable, perturbed, and preferred alternatives to the perturbed
<
'stable': match/men women, 'perturbed': ~&lSrSxPp match/men women, 'preferred': preferred/(men,women) ~&lSrSxPp match/men women></lang>
The matches are perturbed by reversing the order of the women. Here is the output.
< 'stable': < ('jon','abi'), ('fred','bea'), ('bob','cath'), ('col','dee'), ('hal','eve'), ('dan','fay'), ('gav','gay'), ('ian','hope'), ('abe','ivy'), ('ed','jan')>, 'perturbed': < ('jon','jan'), ('fred','ivy'), ('bob','hope'), ('col','gay'), ('hal','fay'), ('dan','eve'), ('gav','dee'), ('ian','cath'), ('abe','bea'), ('ed','abi')>, 'preferred': < ('jon','abi'), ('jon','fay'), ('fred','abi'), ('fred','dee'), ('fred','gay'), ('fred','eve'), ('bob','cath'), ('col','dee'), ('col','fay'), ('col','ivy'), ('hal','eve'), ('dan','fay'), ('gav','gay'), ('gav','ivy'), ('gav','cath'), ('gav','abi'), ('abe','abi'), ('abe','jan'), ('abe','dee'), ('abe','fay'), ('ed','jan'), ('ed','cath'), ('ed','fay')>>