
    <<CompareImpl.Mesa>>
<<Last Edited by: Spreitzer, July 1, 1984 6:27:22 pm PDT>>

    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
        ];
        <<newColor, multicolored, and suspect are indexed by old colors; the rest by new.>>

    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.