Help:=proc()
print(`stable(A::list)`):
end:

#this is the stable matching for the case where every man prefers to marry over staying
# single
stable_com:=proc(A,B) local n,i,m,w,M,W,UM,UW,C,E:

print(`In complete stable matching routine`):

# M is a list of women the men are matched to, n+2 being the value if they are not yet matched
# W is a list of men the women are matched to. this is made for convinience
# UM a set of unmatched men is made, again for convinience, some thing to do-loop over.
# UW - a set of unmarried woman, for much too much convinience.

C:=A:

#Initializations
n:=nops(A):
print(n):
UM:={seq(i,i=1..n)}:
UW:={seq(i,i=1..n)}:
M:=[seq(n+1,i=1..n)]:
W:=[seq(n+1,i=1..n)]:

while UM<>{} do
	# print(`Unmarried men are:`,UM):
	# print(`Marriages are:`,M):
	# note : always UM[1] is paired up, and UM is a set, so the smallest numbers get paired up first
	# in any set of unpaired men
	m:=UM[1]:
	
	#syntax help: member(element,set,'position')	
	#flag, to see if the man found a woman willing to marry him
	while(member(m,UM)) do
		# choice woman C[m][1] : lists contract every time a woman is struck off the list
		w:=C[m][1]:
		C[m]:=[op(2..nops(C[m]),C[m])]:
		if member(w,UW) then 
			M[m]:=w:
			W[w]:=m:
			UM:=UM minus {m}:
			UW:=UW minus {w}:
		else
			member(m,B[w],'p1'):
			member(W[w],B[w],'p2'):
			if p1<p2 then
				UM:=UM union {W[w]} minus {m}:
				# print(W[w]):
				M[W[w]]:=n+1:
				W[w]:=m:
				M[m]:=w:
				# print(m,w):
				
			fi:	 
			# note that if p1>p2, then the next iteration of while will
			# take care of things (the inner while that is)			
		fi:
	od:
	# print(`Marriages are:`,M):
od:

M:

end:

#this is a helper function, to complete the preference list with dummy values
completion:=proc(A) local n,i,temp,S,B::list:

n:=nops(A):
B:=[op(A),[seq(i,i=1..n+1)]]:
S:={seq(i,i=1..n)}:
for i from 1 to n do
	temp:=S minus {op(A[i])}:
	B[i]:=[op(A[i]),n+1,op(temp)]:
od:

print(`I hope the completion of`,A,` looks okay:`,B):

B:

end:


#this is the stable matching when some men may prefer staying single over marrying some women.
stable_incom:=proc(A,B) local n,res:

print(`In incomplete stable matching routine`):

n:=nops(A):

res:=stable_com(completion(A),completion(B)):
if res[n+1]<>n+1 then RETURN(FAIL):
fi:

print(res):

[op(1..n,res)]:

end:



#stable(A::list,B::list) - here A is a list of lists, each sublist being the preference list of a
#man. nops(A) determining the number of men and women.
stable:=proc(A,B) local x,n,i,res:

n:=nops(A):
x:=0:
for i from 1 to n do
	if nops(A[i])<>n or nops(B[i])<>n then x:=1:
	fi:
od:
if x=1 then res:=stable_incom(A,B):
else res:=stable_com(A,B):
fi:

res:

end:
------=_20050212200539_32657
Content-Type: text/plain; name="heapsort.txt"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="heapsort.txt"



Help:=proc()
print(`HS(A::list)`):
end:

#Heapify(B..list,i) here A..list is a binary tree and Heapify should return a heapification of the node i, which is assumed to not satisfy the heap property - BUT NOTE - all its children are at this moment assumed to satisfy the heap property, thats why construction of a heap goes bottom up.
Heapify:=proc(B,i) local A,n,m,tem:

A:=B;
n:=nops(A):

if (2*i)<n then
	if A[i]<A[2*i+1] and A[2*i]<=A[2*i+1] then
		tem:=A[i]:
		A[i]:=A[2*i+1]:
		A[2*i+1]:=tem:
		m:=2*i+1:
		A:=Heapify(A,m):
	elif A[i]<A[2*i] and A[2*i+1]<A[2*i] then 
		tem:=A[i]:
			A[i]:=A[2*i]:
		A[2*i]:=tem:
		m:=2*i:
		A:=Heapify(A,m):
	fi:
elif (2*i)=n and A[i]<A[2*i] then
	tem:=A[i]:
	A[i]:=A[2*i]:
	A[2*i]:=tem:
fi:

A:
end:

#Buildheap(A..list) takes a list and builds a heap.
Buildheap:=proc(A) local n,i,B:

B:=A;
n:=nops(B):

for i from ceil(n/2) to 1 by -1 do
	B:=Heapify(B,i):
od:
B:
end:


#HS(A) finally the heapsort algorithm
HS:=proc(A) local n,tem,i,B:

n:=nops(A);
if n=0 or n=1 then RETURN(A);
fi:

B:=Buildheap(A):

for i from n to 2 by -1 do
	tem:=B[1]:
	B[1]:=B[i]:
	B[i]:=tem:
	B:=[op(Heapify(B[1..i-1],1)),op(i..n,B)]:
od:
B:
end:


#tester(n) just a procedure to check heapsort on all permutations of first n natural numbers
tester:=proc(n) local i,A,m:

with(combinat,'permute'):

A:=permute(n):
m:=n!:

for i from 1 to m do
	HS(A[i]);
od:
end: