113 lines
4.8 KiB
Text
113 lines
4.8 KiB
Text
link printf
|
|
|
|
procedure main()
|
|
smd := IsStable(ShowEngaged(StableMatching(setup())))
|
|
IsStable(ShowEngaged(Swap(\smd,smd.women[1],smd.women[2])))
|
|
end
|
|
|
|
procedure index(L,x) #: return index of value or fail
|
|
return ( L[i := 1 to *L] === x, i)
|
|
end
|
|
|
|
procedure ShowEngaged(smd) #: Show who's hooked up
|
|
printf("\nEngagements:\n")
|
|
every w := !smd.women do
|
|
printf("%s is engaged to %s\n",w,smd.engaged[w])
|
|
return smd
|
|
end
|
|
|
|
procedure Swap(smd,x0,x1) #: swap two couples by m or w
|
|
printf("\nSwapping %s and %s\n",x0,x1)
|
|
e := smd.engaged
|
|
e[x0] :=: e[x1] # swap partners
|
|
e[e[x0]] := e[e[x1]]
|
|
return smd
|
|
end
|
|
|
|
procedure IsStable(smd) #: validate stability
|
|
stable := 1 # assumption
|
|
printf("\n")
|
|
every mp := smd.prefs[m := !smd.men] & # man & pref
|
|
w := mp[index(mp,smd.engaged[m])-1 to 1 by -1] do { # better choices
|
|
wp := smd.prefs[w] # her choices
|
|
if index(wp,smd.engaged[w]) > index(wp,m) then {
|
|
printf("Engagement of %s to %s is unstable.\n",w,m)
|
|
stable := &null # broken
|
|
}
|
|
}
|
|
if \stable then {
|
|
printf("Engagments are all stable.\n")
|
|
return smd
|
|
}
|
|
end
|
|
|
|
procedure StableMatching(smd) #: match making
|
|
freemen := copy(smd.men) # Initialize all m memberof M
|
|
freewomen := set(smd.women) # ... and w memberof W to free
|
|
every (prefmen := table())[m := !freemen] := copy(smd.prefs[m])
|
|
smd.engaged := engaged := table()
|
|
printf("\nMatching:\n")
|
|
while m := get(freemen) do { # next freeman
|
|
while w := get(prefmen[m]) do { # . with prpoposals left
|
|
if member(freewomen,w) then { # . . is she free?
|
|
engaged[m] := w # . . . (m, w)
|
|
engaged[w] := m
|
|
delete(freewomen,w)
|
|
printf("%s accepted %s's proposal\n",w,m)
|
|
break
|
|
}
|
|
else { # . . no, she's engaged
|
|
m0 := engaged[w] # to m0
|
|
if index(smd.prefs[w],m) < index(smd.prefs[w],m0) then {
|
|
engaged[m] := w # (m, w) become engaged
|
|
engaged[w] := m
|
|
delete(freewomen,w)
|
|
engaged[m0] := &null # m' becomes free
|
|
put(freemen,m0)
|
|
printf("%s chose %s over %s\n",w,m,m0)
|
|
break
|
|
}
|
|
else next # she's happier as is
|
|
}
|
|
}
|
|
}
|
|
return smd
|
|
end
|
|
|
|
record sm_data(men,women,prefs,engaged) #: everyones data
|
|
|
|
procedure setup() #: setup everyones data
|
|
X := sm_data()
|
|
X.men := ["abe","bob","col","dan","ed","fred","gav","hal","ian","jon"]
|
|
X.women := ["abi","bea","cath","dee","eve","fay","gay","hope","ivy","jan"]
|
|
|
|
if *X.men ~= *(M := set(X.men)) then runerr(500,X.men) # duplicate?
|
|
if *X.women ~= *(W := set(X.women)) then runerr(500,X.women) # duplicate?
|
|
if *(B := M**W) ~= 0 then runerr(500,B) # intersect?
|
|
|
|
X.prefs := p := table()
|
|
|
|
p["abe"] := ["abi","eve","cath","ivy","jan","dee","fay","bea","hope","gay"]
|
|
p["bob"] := ["cath","hope","abi","dee","eve","fay","bea","jan","ivy","gay"]
|
|
p["col"] := ["hope","eve","abi","dee","bea","fay","ivy","gay","cath","jan"]
|
|
p["dan"] := ["ivy","fay","dee","gay","hope","eve","jan","bea","cath","abi"]
|
|
p["ed"] := ["jan","dee","bea","cath","fay","eve","abi","ivy","hope","gay"]
|
|
p["fred"] := ["bea","abi","dee","gay","eve","ivy","cath","jan","hope","fay"]
|
|
p["gav"] := ["gay","eve","ivy","bea","cath","abi","dee","hope","jan","fay"]
|
|
p["hal"] := ["abi","eve","hope","fay","ivy","cath","jan","bea","gay","dee"]
|
|
p["ian"] := ["hope","cath","dee","gay","bea","abi","fay","ivy","jan","eve"]
|
|
p["jon"] := ["abi","fay","jan","gay","eve","bea","dee","cath","ivy","hope"]
|
|
|
|
p["abi"] := ["bob","fred","jon","gav","ian","abe","dan","ed","col","hal"]
|
|
p["bea"] := ["bob","abe","col","fred","gav","dan","ian","ed","jon","hal"]
|
|
p["cath"] := ["fred","bob","ed","gav","hal","col","ian","abe","dan","jon"]
|
|
p["dee"] := ["fred","jon","col","abe","ian","hal","gav","dan","bob","ed"]
|
|
p["eve"] := ["jon","hal","fred","dan","abe","gav","col","ed","ian","bob"]
|
|
p["fay"] := ["bob","abe","ed","ian","jon","dan","fred","gav","col","hal"]
|
|
p["gay"] := ["jon","gav","hal","fred","bob","abe","col","ed","dan","ian"]
|
|
p["hope"] := ["gav","jon","bob","abe","ian","dan","hal","ed","col","fred"]
|
|
p["ivy"] := ["ian","col","hal","gav","fred","bob","abe","ed","jon","dan"]
|
|
p["jan"] := ["ed","hal","gav","abe","bob","jon","col","ian","fred","dan"]
|
|
|
|
return X
|
|
end
|