RosettaCodeData/Task/Stable-marriage-problem/EasyLang/stable-marriage-problem.easy
2025-06-11 20:16:52 -04:00

157 lines
3.5 KiB
Text

mnam$[] = strsplit input " "
n = len mnam$[]
wnam$[] = strsplit input " "
len mlike[][] n
len wlike[][] n
func finds name$[] s$ .
for i to len name$[]
if name$[i] = s$
return i
.
.
.
proc read .
s$ = input
s$ = s$
for m to n
h$[] = strsplit input " "
len mlike[m][] n
for j = 1 to n
mlike[m][finds wnam$[] h$[j + 1]] = n - j + 1
.
.
s$ = input
for w to n
h$[] = strsplit input " "
len wlike[w][] n
for j = 1 to n
wlike[w][finds mnam$[] h$[j + 1]] = n - j + 1
.
.
.
read
#
len meng[] n
len weng[] n
len wcand[][] n
#
proc engagements .
print "Engagements:"
for m to n
w = 1
for i to n
if mlike[m][i] > mlike[m][w]
w = i
.
.
mlike[m][w] *= -1
wcand[w][] &= m
.
for w to n
if len wcand[w][] > 0
m = wcand[w][1]
for h in wcand[w][]
if wlike[w][h] > wlike[w][m]
m = h
.
.
print " " & wnam$[w] & " + " & mnam$[m]
meng[m] = w
weng[w] = m
.
.
print ""
while done = 0
done = 1
for m to n
if meng[m] = 0
done = 0
w = 1
for i to n
if mlike[m][i] > mlike[m][w]
w = i
.
.
mlike[m][w] *= -1
if weng[w] = 0
meng[m] = w
weng[w] = m
print " " & wnam$[w] & " + " & mnam$[m]
else
h = weng[w]
if wlike[w][h] < wlike[w][m]
print " " & wnam$[w] & " + " & mnam$[m] & " (dumped " & mnam$[h] & ")"
meng[h] = 0
weng[w] = m
meng[m] = w
.
.
.
.
.
print ""
.
engagements
#
proc showcouples .
print "Couples:"
for w to n
print " " & wnam$[w] & " + " & mnam$[weng[w]]
.
print ""
.
proc swapw a b .
print wnam$[a] & " and " & wnam$[b] & " swap their partners"
print ""
swap weng[a] weng[b]
swap meng[weng[a]] meng[weng[b]]
.
proc checkstable .
for m to n
w = meng[m]
for w1 to n
if abs mlike[m][w1] > abs mlike[m][w]
if wlike[w1][m] > wlike[w1][weng[w1]]
cnt += 1
print "Unstable: " & wnam$[w1] & " and " & mnam$[m]
.
.
.
.
if cnt = 0
print "The couples are stable"
.
print ""
.
showcouples
checkstable
swapw 3 9
showcouples
checkstable
#
#
input_data
abe bob col dan ed fred gav hal ian jon
abi bea cath dee eve fay gay hope ivy jan
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