Anonymous user
Stable marriage problem: Difference between revisions
→{{header|XSLT 2.0}}: Added zkl
Walterpachl (talk | contribs) (add REXX) |
(→{{header|XSLT 2.0}}: Added zkl) |
||
Line 6,868:
</m:stable-marriage-problem-result>
</t></lang>
=={{header|zkl}}==
{{trans|PicoLisp}}
<lang zkl>var
Boys=D(
"abe", "abi eve cath ivy jan dee fay bea hope gay".split(),
"bob", "cath hope abi dee eve fay bea jan ivy gay".split(),
"col", "hope eve abi dee bea fay ivy gay cath jan".split(),
"dan", "ivy fay dee gay hope eve jan bea cath abi".split(),
"ed", "jan dee bea cath fay eve abi ivy hope gay".split(),
"fred","bea abi dee gay eve ivy cath jan hope fay".split(),
"gav", "gay eve ivy bea cath abi dee hope jan fay".split(),
"hal", "abi eve hope fay ivy cath jan bea gay dee".split(),
"ian", "hope cath dee gay bea abi fay ivy jan eve".split(),
"jon", "abi fay jan gay eve bea dee cath ivy hope".split(), ),
Girls=D(
"abi", "bob fred jon gav ian abe dan ed col hal".split(),
"bea", "bob abe col fred gav dan ian ed jon hal".split(),
"cath","fred bob ed gav hal col ian abe dan jon".split(),
"dee", "fred jon col abe ian hal gav dan bob ed".split(),
"eve", "jon hal fred dan abe gav col ed ian bob".split(),
"fay", "bob abe ed ian jon dan fred gav col hal".split(),
"gay", "jon gav hal fred bob abe col ed dan ian".split(),
"hope","gav jon bob abe ian dan hal ed col fred".split(),
"ivy", "ian col hal gav fred bob abe ed jon dan".split(),
"jan", "ed hal gav abe bob jon col ian fred dan".split(), ),
Couples=List(); // ( (boy,girl),(boy,girl),...)
Boyz:=Boys.pump(D(),fcn([(b,gs)]){ return(b,gs.copy()) }); // make writable copy
while( bgs:=Boyz.filter1( 'wrap([(Boy,gs)]){ // while unattached boy
gs and (not Couples.filter1("holds",Boy))
}) )
{
Boy,Girl:=bgs; Girl=Girl.pop(0);
Pair:=Couples.filter1("holds",Girl); // is Girl part of a couple?
if(not Pair) Couples.append(List(Boy,Girl)); # no, Girl was free
else{ // yes, Girl is engaged to Pair[0]
bsf,nBoy,nB:=Girls[Girl].index, bsf(Boy),bsf(Pair[0]);
if(nBoy<nB) Pair[0]=Boy; # Girl prefers Boy, change Couples
}
}
foreach Boy,Girl in (Couples){ println(Girl," is engaged to ",Boy) }
fcn checkCouples(Couples){
Couples.filter(fcn([(Boy,Girl)]){
Girls[Girl].filter1('wrap(B){
// is B before Boy in Girls preferences?
bsf,nBoy,nB:=Girls[Girl].index, bsf(Boy),bsf(B);
// Does B prefer Girl (over his partner)?
_,G:=Couples.filter1("holds",B); // (B,G)
gsf,nGirl,nG:=Boys[B].index, gsf(Girl),gsf(G);
( nB<nBoy and nGirl<nG and
println(Girl," likes ",B," better than ",Boy," and ",
B," likes ",Girl," better than ",G) )
})
}) or println("All marriages are stable");
}
checkCouples(Couples);
println();
println("Engage fred with abi and jon with bea");
Couples.filter1("holds","fred")[1]="abi";
Couples.filter1("holds","jon") [1]="bea";
checkCouples(Couples);</lang>
{{out}}
<pre>
gay is engaged to gav
ivy is engaged to abe
abi is engaged to jon
cath is engaged to bob
hope is engaged to ian
bea is engaged to fred
eve is engaged to hal
fay is engaged to dan
jan is engaged to ed
dee is engaged to col
All marriages are stable
Engage fred with abi and jon with 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
eve likes jon better than hal and jon likes eve better than bea
fay likes jon better than dan and jon likes fay better than bea
</pre>
| |||