#Stable Matching by Leigh Cobbs
#propose(i,...) causes man i to propose
#to his current first choice M[i,1]
propose:=proc(i,a,n,M,W,L) local c:
c:=M[i,1]:
refuse(i,c,a,n,M,W,L):
end:




#refuse(k,l,...) gives woman l's response
#to man k's proposal
#if man k is preferred to
#woman l's current husband a[1,l]
#then woman accepts man k's proposal and
#rejects current husband who must then propose
#to his next choice
#if man k is not preferred to a[1,l], then
#man k must remove woman l from his list and
#man k must propose again
refuse:=proc(k,l,a,n,M,W,L) local j,r,s,t,indexj,indexk,Ij:
if evalb(a[1,l]=0) then
	a[1,l]:=L[k]:
else j:=a[1,l]:
	for r from 1 to n do
	if evalb(W[l,r]=j) then
	indexj:=r:
	fi:
	if evalb(W[l,r]=L[k]) then
	indexk:=r:
	fi:
	od:


  if indexj < indexk then
	for t from 1 to n-1 do
	M[k,t]:=M[k,t+1]:
	od:
	M[k,n]:=0:
	refuse(k,M[k,1],a,n,M,W,L):
  else a[1,l]:=L[k]:
	for t from 1 to n do
	if evalb(L[t]=j) then
	Ij:=t:
	fi:
	od:
	for s from 1 to n-1 do
	M[Ij,s]:=M[Ij,s+1]:
	od:
	M[Ij,n]:=0:
	propose(Ij,a,n,M,W,L):

  fi:
fi:
end:



#input matrix M,W
#Matrix M is a n by n integral matrix
#The ith row of M is man i's
#ordered prefernce list
#Matrix W is a n by n matrix
#with entries of the form m(j), j=1..n
#the ith row is woman i's preference list
#Match M,W returns a 2 by n matrix
#with men in top row and
#each man's corresponding wife directly below
#in the second row
Match:=proc(M,W) local n,a,i,j,L,Wed:
n:=coldim(M):

a:=matrix(1,n):
for i from 1 to n do
a[1,i]:=0:
od:

for i from 1 to n do
L[i]:=m(i):
od:

for i from 1 to n do
	propose(i,a,n,M,W,L):
	od:
Wed:=matrix(2,n,[[seq(a[1,i],i=1..n)],[seq(j,j=1..n)]]):
print(Wed):

end: