CompareImpl: CEDAR PROGRAM = BEGIN Vertex: TYPE = REF VertexRep; VertexRep: TYPE = RECORD [ neighbors: VertexS _ NIL, QNext: Vertex _ notInQ, colorNext, equiv: Vertex _ NIL, color: ARRAY Pass OF Color _ [noColor, noColor], graph: GraphID, fudge: [0 .. 1] _ 0, unique: BOOL _ FALSE ]; Pass: TYPE = [0 .. 1]; Color: TYPE = HashTableIndex; noColor: Color = LAST[Color]; HashTableIndex: TYPE = CARDINAL; NullIndex: HashTableIndex = LAST[HashTableIndex]; VertexS: TYPE = REF VertexSeq; VertexSeq: TYPE = RECORD [vertices: SEQUENCE length: CARDINAL OF Vertex]; HashTable: TYPE = REF HashTableRep; HashTableRep: TYPE = RECORD [ firstNonEmpty: HashTableIndex _ NullIndex, entries: SEQUENCE length: HashTableIndex OF HashTableEntry]; GraphID: TYPE = {A, B}; HashTableEntry: TYPE = RECORD [ v: Vertex _ NIL, nextNonEmpty: HashTableIndex _ NullIndex, count: ARRAY GraphID OF CARDINAL _ [0, 0], newColor: Color _ noColor, suspect, multicolored: BOOL _ FALSE ]; TwoCount: TYPE = ARRAY GraphID OF CARDINAL; notInQ: Vertex _ NEW [VertexRep]; endOfQ: Vertex = NIL; Compare: PROC [hashTable: HashTable, nonUniqueCount: TwoCount] = BEGIN ComputeColor: PROC [v: Vertex] RETURNS [color: Color] = { color _ (v.color[oldPass] + v.fudge) MOD hashTable.length; v.fudge _ 0; FOR i: CARDINAL IN [0 .. v.neighbors.length) DO n: Vertex _ v.neighbors[i]; nc: Color _ n.color[oldPass]; IF NOT hashTable[nc].suspect THEN color _ (color + (i+1) * (nc+1)) MOD hashTable.length; ENDLOOP}; AddFrontier: PROC [v: Vertex] = { FOR n: CARDINAL IN [0 .. v.neighbors.length) DO w: Vertex _ v.neighbors[n]; IF (NOT w.unique) AND (w.QNext = notInQ) THEN {w.QNext _ QFirst; QFirst _ w; QCount _ QCount + 1}; ENDLOOP}; InitialColor: PROC = { QFirst _ endOfQ; QCount _ 0; SetQToAllNonUniques[]}; SetQToAllNonUniques: PROC = { wasAll _ TRUE; FOR hti: HashTableIndex _ hashTable.firstNonEmpty, hashTable[hti].nextNonEmpty WHILE hti # NullIndex DO FOR v: Vertex _ hashTable[hti].v, v.colorNext WHILE v # NIL DO IF v.QNext # notInQ THEN ERROR; IF NOT v.unique THEN {v.QNext _ QFirst; QFirst _ v; QCount _ QCount + 1} ENDLOOP; ENDLOOP; IF QCount # (nonUniqueCount[A] + nonUniqueCount[B]) THEN ERROR}; ChoosePairs: PROC = { wasAll _ TRUE; FOR hti: HashTableIndex _ hashTable.firstNonEmpty, hashTable[hti].nextNonEmpty WHILE hti # NullIndex DO first: ARRAY GraphID OF Vertex _ [NIL, NIL]; FOR v: Vertex _ hashTable[hti].v, v.colorNext WHILE v # NIL DO IF v.QNext # notInQ THEN ERROR; IF first[v.graph] = NIL THEN first[v.graph] _ v; IF NOT v.unique THEN {v.QNext _ QFirst; QFirst _ v; QCount _ QCount + 1} ENDLOOP; IF first[A]#NIL AND first[B]#NIL THEN first[A].fudge _ first[B].fudge _ 1; ENDLOOP; IF QCount # (nonUniqueCount[A] + nonUniqueCount[B]) THEN ERROR}; QFirst: Vertex; QCount: CARDINAL; wasAll: BOOL _ TRUE; pass, oldPass: Pass _ 0; InitialColor[]; WHILE nonUniqueCount[A]#0 AND nonUniqueCount[B]#0 DO mcCount: CARDINAL _ 0; oldPass _ pass; pass _ (pass+1) MOD 2; WHILE QFirst # endOfQ DO v: Vertex _ QFirst; oldColor: Color _ v.color[oldPass]; newColor: Color _ v.color[pass] _ ComputeColor[v]; IF QFirst = notInQ THEN ERROR; QFirst _ v.QNext; v.QNext _ notInQ; IF wasAll THEN { IF hashTable[oldColor].newColor = noColor THEN hashTable[oldColor].newColor _ newColor ELSE IF hashTable[oldColor].multicolored THEN mcCount _ mcCount + 1 ELSE IF hashTable[oldColor].newColor = newColor THEN NULL ELSE { otherNewColor: Color _ hashTable[oldColor].newColor; hashTable[oldColor].multicolored _ TRUE; mcCount _ mcCount + hashTable[otherNewColor].count[A] + hashTable[otherNewColor].count[B] + 1}; }; IF hashTable[newColor].count[A] = 0 AND hashTable[newColor].count[B] = 0 THEN { hashTable[newColor].v _ NIL; hashTable[newColor].nextNonEmpty _ hashTable.firstNonEmpty; hashTable.firstNonEmpty _ newColor}; v.colorNext _ hashTable[newColor].v; hashTable[newColor].v _ v; hashTable[newColor].count[v.graph] _ hashTable[newColor].count[v.graph] + 1; ENDLOOP; QCount _ 0; FOR hti: HashTableIndex _ hashTable.firstNonEmpty, hashTable[hti].nextNonEmpty WHILE hti # NullIndex DO uniques: ARRAY GraphID OF BOOL = [hashTable[hti].count[A]=1, hashTable[hti].count[B]=1]; unique: BOOL _ uniques[A] AND uniques[B]; IF unique THEN { a: Vertex _ hashTable[hti].v; b: Vertex _ a.colorNext; IF b.colorNext # NIL THEN ERROR; IF a.graph = b.graph THEN ERROR; a.unique _ b.unique _ TRUE; a.equiv _ b; b.equiv _ a; nonUniqueCount[A] _ nonUniqueCount[A] - 1; nonUniqueCount[A] _ nonUniqueCount[B] - 1; }; IF uniques[A] OR uniques[B] THEN { FOR w: Vertex _ hashTable[hti].v, w.colorNext WHILE w # NIL DO IF uniques[w.graph] THEN AddFrontier[w]; ENDLOOP}; hashTable[hti].suspect_ hashTable[hti].count[A] # hashTable[hti].count[B]; hashTable[hti].count[A] _ 0; hashTable[hti].count[B] _ 0; hashTable[hti].newColor _ noColor; hashTable[hti].multicolored _ FALSE; ENDLOOP; IF QCount > 0 THEN wasAll _ (nonUniqueCount[A] + nonUniqueCount[B]) = QCount ELSE IF (mcCount > 0) OR (NOT wasAll) THEN SetQToAllNonUniques[] ELSE ChoosePairs[]; ENDLOOP; END; END. žCompareImpl.Mesa Last Edited by: Spreitzer, July 1, 1984 6:27:22 pm PDT newColor, multicolored, and suspect are indexed by old colors; the rest by new. Κ– "cedar" style˜Icode™J™6K˜KšΠbx œΟkœžœ˜K˜Kšž˜K˜Kšœžœžœ ˜šœ žœžœ˜Kšœžœ˜Kšœ˜Kšœžœ˜Kšœžœžœ˜0K˜K˜Kšœžœž˜K˜—K˜Kšœžœ ˜Kšœžœ˜Kšœžœ˜Kšœžœžœ˜ Kšœžœ˜1K˜Kšœ žœžœ ˜Kš œ žœžœ žœ žœžœ ˜IK˜Kšœ žœžœ˜#šœžœžœ˜Kšœ*˜*Kšœ žœžœ˜<—K˜Kšœ žœžœžœ˜K˜šœžœžœ˜Kšœ žœ˜Kšœ)˜)Kšœžœ žœžœ ˜*K˜Kšœžœž˜#K˜KšœO™O—K˜Kš œ žœžœ žœžœ˜+Kšœžœ ˜!Kšœžœ˜K˜šΟnœžœ3˜@Kšž˜šŸ œžœ žœ˜9Kšœ%žœ˜:K˜ šžœžœžœž˜/K˜Kšœ˜Kšžœžœžœ"žœ˜XKšžœ˜ ——šŸ œžœ˜!šžœžœžœž˜/K˜šžœžœ žœž˜-Kšœ4˜4—Kšžœ˜ ——šŸ œžœ˜K˜Kšœ˜—šŸœžœ˜Kšœ žœ˜šžœLžœž˜gšžœ+žœžœž˜>Kšžœžœžœ˜šžœžœ ž˜Kšœ3˜3—Kšžœ˜—Kšž˜—Kš žœžœžœžœžœ˜@—šŸ œžœ˜Kšœ žœ˜šžœLžœž˜gKš œžœ žœ žœžœ˜,šžœ+žœžœž˜>Kšžœžœžœ˜Kšžœžœžœ˜0šžœžœ ž˜Kšœ3˜3—Kšžœ˜—Kšžœžœžœžœžœžœžœžœžœ ˜JKšž˜—Kš žœžœžœžœžœ˜@—K˜Kšœžœ˜Kšœžœžœ˜K˜K˜š žœžœžœžœž˜4Kšœ žœ˜K˜Kšœžœ˜šžœž˜K˜K˜#Kšœ2˜2Kšžœžœžœ˜K˜Kšœ˜šžœžœ˜Kšžœ(žœ(˜VKšžœžœ"žœ˜CKšžœžœ)žœž˜9šžœ˜Kšœ4˜4Kšœ#žœ˜(Kšœ3žœ#žœ˜_—K˜—š žœžœžœžœžœ˜OKšœžœ˜Kšœ;˜;Kšœ$˜$—Kšœ$˜$Kšœ˜KšœL˜LKšžœ˜—K˜ šžœLžœž˜gKš œ žœ žœžœžœžœ˜XKš œžœ žœžœ žœ˜)šžœžœ˜Kšœ˜K˜Kšžœžœžœžœ˜ Kšžœžœžœ˜ Kšœžœ˜K˜Kšœžœžœ˜*Kšœžœžœ˜*K˜—š žœ žœžœ žœžœ˜"šžœ+žœžœž˜>Kšžœžœ˜(Kšžœ˜ ——Kšœ-žœžœ˜JKšœžœ˜Kšœžœ˜Kšœ"˜"Kšœžœ˜$Kšžœ˜—Kšžœ žœžœžœ ˜LKš žœžœžœžœ žœ˜@Kšžœ˜Kšžœ˜—Kšžœ˜—K˜Kšžœ˜—…—€&