#Faithmen(M,A) forms the set of faithful men #by assigning every faithful man the value 1 #and every othe man the value 0 #inputs are the lists of marriages M and affairs A #of size n and a, resp #outputs a list of 0s and 1s Faithmen:=proc(M,A,n,a) local i,j,r,FM: FM:=[]: for i from 1 to n do r:=1: for j from 1 to a while A[j][1] <> M[i][1] do r:=j+1: od: if r=a+1 then FM:=[op(FM),1]: else FM:=[op(FM),0]: fi: od: RETURN(FM): end: #Ask(j,k,L,M,A,n,a) searches for a faithful match #it seeks to match man j with a faithful woman #beginning with man k's wife #inputs are man j, man k's wife, #the current list of faithful couples L, #marriages M, and affairs A, #where n and a are the size of M and A, resp #outputs the list of fiathful couples, including #the match found for man j Ask:=proc(j,k,L,M,A,n,a) local r,i,Lover,FC: FC:=L: r:=1: for i from 1 to a while k <> A[r][2] do r:=i+1: od: if r=a+1 then FC:=[op(FC),[j,k]]: else Lover:=A[r][1]: FC:=Ask(j,M[Lover][2],FC,M,A,n,a): fi: RETURN(FC): end: #Faithful(M,A) takes an array M of n marriages #and an array A of k<=n affairs and returns a #bijective pairing of the faithful partners Faithful:=proc(M,A) local FC,FM,n,a,i,j: n:=nops(M): a:=nops(A): FC:=[]: FM:=Faithmen(M,A,n,a): for i from 1 to n do if FM[i]=1 then FC:=Ask(M[i][1],M[i][2],FC,M,A,n,a): fi: od: RETURN(FC): end: