Stable marriage problem: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
|||
Line 3,595: | Line 3,595: | ||
Jon & Fred swap partners |
Jon & Fred swap partners |
||
Stable = No</pre> |
Stable = No</pre> |
||
=={{header|jq}}== |
|||
'''Adapted from [[#Wren|Wren]]''' |
|||
{{works with|jq}} |
|||
'''Also works with gojq, the Go implementation of jq''' |
|||
'''Also works with fq, a Go implementation of a large subset of jq''' |
|||
This adaptation from [[#Wren]] illustrates |
|||
how jq's `debug` facility can be used to |
|||
show details about the progress of a computation. |
|||
These progress messages could be suppressed, |
|||
for example, |
|||
by redefining debug/1 as: `def debug(msg): .;` |
|||
<syntaxhighlight lang=jq> |
|||
# Generic utilities: |
|||
def debug(msg): (msg|debug) as $_ | .; |
|||
# Remove the key named $key from an object specified by the given path |
|||
def rmkey($key; path): |
|||
path |= with_entries(select(.key != $key)); |
|||
def printPairs: |
|||
to_entries[] |
|||
| "\(.key) \(.value)"; |
|||
def debugPairs: |
|||
. as $in |
|||
| reduce to_entries[] as $x (null; |
|||
$x | debug("\(.key) \(.value)") ) |
|||
| $in; |
|||
# The individual preferences |
|||
def mPref : { |
|||
"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"] |
|||
}; |
|||
def wPref : { |
|||
"abi": { |
|||
"bob": 1, "fred": 2, "jon": 3, "gav": 4, "ian": 5, |
|||
"abe": 6, "dan": 7, "ed": 8, "col": 9, "hal": 10}, |
|||
"bea": { |
|||
"bob": 1, "abe": 2, "col": 3, "fred": 4, "gav": 5, |
|||
"dan": 6, "ian": 7, "ed": 8, "jon": 9, "hal": 10}, |
|||
"cath": { |
|||
"fred": 1, "bob": 2, "ed": 3, "gav": 4, "hal": 5, |
|||
"col": 6, "ian": 7, "abe": 8, "dan": 9, "jon": 10}, |
|||
"dee": { |
|||
"fred": 1, "jon": 2, "col": 3, "abe": 4, "ian": 5, |
|||
"hal": 6, "gav": 7, "dan": 8, "bob": 9, "ed": 10}, |
|||
"eve": { |
|||
"jon": 1, "hal": 2, "fred": 3, "dan": 4, "abe": 5, |
|||
"gav": 6, "col": 7, "ed": 8, "ian": 9, "bob": 10}, |
|||
"fay": { |
|||
"bob": 1, "abe": 2, "ed": 3, "ian": 4, "jon": 5, |
|||
"dan": 6, "fred": 7, "gav": 8, "col": 9, "hal": 10}, |
|||
"gay": { |
|||
"jon": 1, "gav": 2, "hal": 3, "fred": 4, "bob": 5, |
|||
"abe": 6, "col": 7, "ed": 8, "dan": 9, "ian": 10}, |
|||
"hope": { |
|||
"gav": 1, "jon": 2, "bob": 3, "abe": 4, "ian": 5, |
|||
"dan": 6, "hal": 7, "ed": 8, "col": 9, "fred": 10}, |
|||
"ivy": { |
|||
"ian": 1, "col": 2, "hal": 3, "gav": 4, "fred": 5, |
|||
"bob": 6, "abe": 7, "ed": 8, "jon": 9, "dan": 10}, |
|||
"jan": { |
|||
"ed": 1, "hal": 2, "gav": 3, "abe": 4, "bob": 5, |
|||
"jon": 6, "col": 7, "ian": 8, "fred": 9, "dan": 10} |
|||
}; |
|||
# pair/2 implements the Gale/Shapley algorithm. |
|||
# $pPref gives the proposer preferences (like mPref above) |
|||
# $rPref gives the recipient preferences (like wPref above) |
|||
# Output: a JSON object giving the matching as w:m pairs |
|||
def pair($pPref; $rPref): |
|||
def undo: |
|||
debug("engagement: \(.recipient) \(.proposer)") |
|||
| .proposals[.recipient] = {proposer, pPref: .ppref, rPref: .rpref} |
|||
| rmkey(.proposer; .pFree) |
|||
| rmkey(.recipient; .rFree); |
|||
# preferences must be saved in case engagement is broken; |
|||
# they will be saved as: {proposer, pPref, rPref} |
|||
{ pFree: $pPref, |
|||
rFree: $rPref, |
|||
proposals: {} # key is recipient (w) |
|||
} |
|||
# WP pseudocode comments prefaced with WP: m is proposer, w is recipient. |
|||
# WP: while ∃ free man m who still has a woman w to propose to |
|||
| until (.pFree|length == 0; # while there is a free proposer ... |
|||
# pick a proposer |
|||
(.pFree|to_entries[0]) as $me |
|||
| .proposer = $me.key |
|||
| .ppref = $me.value |
|||
| if .ppref|length == 0 |
|||
then . # if proposer has no possible recipients, skip |
|||
# WP: w = m's highest ranked woman to whom he has not yet proposed |
|||
else |
|||
.recipient = .ppref[0] # highest ranked is first in list |
|||
| .ppref = .ppref[1:] # pop from list |
|||
# WP: if w is free |
|||
| .rpref = .rFree[.recipient] |
|||
| if .rpref |
|||
then # WP: (m, w) become engaged |
|||
undo |
|||
else |
|||
# WP: else some pair (m', w) already exists |
|||
.s = .proposals[.recipient] # get proposal saved preferences |
|||
# WP: if w prefers m to m' |
|||
| if .s.rPref[.proposer] < .s.rPref[.s.proposer] |
|||
then debug("engagement broken: \(.recipient) \(.s.proposer)") |
|||
# WP: m' becomes free |
|||
| .pFree[.s.proposer] = .s.pPref # return proposer to the map |
|||
# WP: (m, w) become engaged |
|||
| .rpref = .s.rPref |
|||
| undo |
|||
else |
|||
# WP: else (m', w) remain engaged |
|||
.pFree[.proposer] = .ppref # update preferences in map |
|||
end |
|||
end |
|||
end |
|||
) # end until |
|||
# construct return value |
|||
| reduce (.proposals|to_entries)[] as $me ({}; |
|||
.[$me.key] = $me.value.proposer ) ; |
|||
# return {result, emit} where .emit is an explanation |
|||
def determineStability($ps; $pPref; $rPref): |
|||
$ps |
|||
| debug("Determining the stability of the following pairings:") |
|||
| debugPairs |
|||
| to_entries as $pse |
|||
| {i:0} |
|||
| until(.emit or .i == ($ps|length); # stop after detecting an instability |
|||
$pse[.i].key as $r |
|||
| $pse[.i].value as $p |
|||
| (first($pPref[$p][] as $rp |
|||
| if ($r == $rp) then false |
|||
else $rPref[$rp] as $rprefs |
|||
| if ($rprefs[$p] < $rprefs[$ps[$rp]]) |
|||
then "\ncauses instability because " + |
|||
"\($p) and \($rp) would prefer each other over their current pairings." |
|||
else empty |
|||
end |
|||
end ) // false) as $counterexample |
|||
| if $counterexample == false then . else .emit = $counterexample end |
|||
| .i += 1 ) |
|||
| if .emit then {result: false, emit} else {result: true} end ; |
|||
# Determine pairings using the Gale/Shapley algorithm and then perturb until instability arises. |
|||
def task: |
|||
pair(mPref; wPref) |
|||
| . as $ps |
|||
| "Solution:", printPairs, |
|||
# verify |
|||
((determineStability($ps; mPref; wPref)) as $return |
|||
| ($return.emit // empty ), |
|||
if $return.result == false |
|||
then debug("invalid input") |
|||
else |
|||
"The result has been validated.", |
|||
"Now perturb the result until validation fails.", |
|||
(label $done |
|||
| foreach range(0; $ps|length -1 ) as $start (.; |
|||
.ps = $ps |
|||
| (.ps|to_entries) as $kv |
|||
| .w2[0] = $kv[$start].key |
|||
| .m2[0] = $kv[$start].value |
|||
| .w2[1] = $kv[$start+1].key |
|||
| .m2[1] = $kv[$start+1].value |
|||
| .emit = "\nExchanging partners of \(.m2[0]) and \(.m2[1])" |
|||
| .ps[.w2[0]] = .m2[1] |
|||
| .ps[.w2[1]] = .m2[0] |
|||
# validate perturbed pairings |
|||
| determineStability(.ps; mPref; wPref) as $result |
|||
| .emit += $result.emit |
|||
| .result = $result.result |
|||
; |
|||
.emit, |
|||
if .result == false then break $done else empty end |
|||
)) |
|||
end ); |
|||
task |
|||
</syntaxhighlight> |
|||
{{output}} |
|||
'''Invocation:''' jq -nr -f stable-marriage-problem.jq |
|||
<pre> |
|||
["DEBUG:","engagement: abi abe"] |
|||
["DEBUG:","engagement: cath bob"] |
|||
["DEBUG:","engagement: hope col"] |
|||
["DEBUG:","engagement: ivy dan"] |
|||
["DEBUG:","engagement: jan ed"] |
|||
["DEBUG:","engagement: bea fred"] |
|||
["DEBUG:","engagement: gay gav"] |
|||
["DEBUG:","engagement: eve hal"] |
|||
["DEBUG:","engagement broken: hope col"] |
|||
["DEBUG:","engagement: hope ian"] |
|||
["DEBUG:","engagement broken: abi abe"] |
|||
["DEBUG:","engagement: abi jon"] |
|||
["DEBUG:","engagement: dee col"] |
|||
["DEBUG:","engagement broken: ivy dan"] |
|||
["DEBUG:","engagement: ivy abe"] |
|||
["DEBUG:","engagement: fay dan"] |
|||
Solution: |
|||
abi jon |
|||
cath bob |
|||
hope ian |
|||
ivy abe |
|||
jan ed |
|||
bea fred |
|||
gay gav |
|||
eve hal |
|||
dee col |
|||
fay dan |
|||
["DEBUG:","Determining the stability of the following pairings:"] |
|||
["DEBUG:","abi jon"] |
|||
["DEBUG:","cath bob"] |
|||
["DEBUG:","hope ian"] |
|||
["DEBUG:","ivy abe"] |
|||
["DEBUG:","jan ed"] |
|||
["DEBUG:","bea fred"] |
|||
["DEBUG:","gay gav"] |
|||
["DEBUG:","eve hal"] |
|||
["DEBUG:","dee col"] |
|||
["DEBUG:","fay dan"] |
|||
The result has been validated. |
|||
Now perturb the result until validation fails. |
|||
["DEBUG:","Determining the stability of the following pairings:"] |
|||
["DEBUG:","abi bob"] |
|||
["DEBUG:","cath jon"] |
|||
["DEBUG:","hope ian"] |
|||
["DEBUG:","ivy abe"] |
|||
["DEBUG:","jan ed"] |
|||
["DEBUG:","bea fred"] |
|||
["DEBUG:","gay gav"] |
|||
["DEBUG:","eve hal"] |
|||
["DEBUG:","dee col"] |
|||
["DEBUG:","fay dan"] |
|||
Exchanging partners of jon and bob |
|||
causes instability because bob and cath would prefer each other over their current pairings. |
|||
</pre> |
|||
=={{header|Julia}}== |
=={{header|Julia}}== |