Data commit

Task/Stable-marriage-problem/Zkl/stable-marriage-problem.zkl

@@ -0,0 +1,62 @@
+var
+   Boys=Dictionary(
+      "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=Dictionary(
+      "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(Dictionary(),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);