(* Find a solution to the stable marriage problem. n men and
n women state their preferences of partners. Find n pairs
such that no man would prefer to be married to another woman
who would also prefer him to her partner. A set of pairs is
called stable, if no such cases exist.
[see also Comm. ACM 14, 7, 486-92 (July 71)]. *)
MODULE marriage;
FROM InOut IMPORT WriteString, Write, WriteLn, WriteCard, ReadCard;
CONST n = 8;
TYPE man = [1..n];
woman = [1..n];
rank = [1..n];
VAR m: man;
w: woman;
r: rank;
wmr: ARRAY man,rank OF woman;
mwr: ARRAY woman,rank OF man;
rmw: ARRAY man,woman OF rank;
rwm: ARRAY woman,man OF rank;
x: ARRAY man OF woman;
y: ARRAY woman OF man;
single: ARRAY woman OF BOOLEAN;
PROCEDURE print;
VAR m: man;
rm,rw: CARDINAL;
BEGIN
rm := 0; rw := 0;
FOR m := 1 TO n DO
WriteCard(x[m],4);
rm := rm + rmw[m,x[m]];
rw := rw + rwm[x[m],m]
END;
WriteCard(rm,8); WriteCard(rw,4);
WriteLn
END print;
BEGIN
s := TRUE; i := 1;
WHILE (i < r) AND s DO
pw := wmr[m,i];
INC(i);
IF NOT single[pw] THEN s := rwm[pw,m] > rwm[pw,y[pw]] END;
END;
i := 1;
lim := rwm[w,m];
WHILE (i < lim) AND s DO
pm := mwr[w,i]; INC(i);
IF pm < m THEN s := rmw[pm,w] > rmw[pm,x[pm]] END;
END;
RETURN s
END stable;
BEGIN
FOR r := 1 TO n DO
w := wmr[m,r];
IF single[w] THEN
IF stable() THEN
x[m] := w;
y[w] := m;
single[w] := FALSE;
IF m < n THEN try(m+1) ELSE print END;
single[w] := TRUE
END
END
END
END try;
BEGIN
Write('1'); WriteLn;
FOR m := 1 TO n DO
FOR r := 1 TO n DO
WriteString('Enter> ');
ReadCard(wmr[m,r]);
rmw[m,wmr[m,r]] := r;
WriteLn;
END
END;
FOR w := 1 TO n DO
FOR r := 1 TO n DO
WriteString('Enter2> ');
ReadCard(mwr[w,r]);
rwm[w,mwr[w,r]] := r;
WriteLn;
END
END;
FOR w := 1 TO n DO single[w] := TRUE END;
try(1)
END marriage.
