
    <<StructurallyCompare.Mesa>>
        <<Mike Spreitzer July 14, 1986 8:05:58 pm PDT>>
        <<Bertrand Serlet June 4, 1986 4:16:39 pm PDT>>

    DIRECTORY IntHashTableThreaded, IO, Real, RealFns, Rope, RopeHash, StructuralComparisonDataStructure, StructuralComparisonOps;

    StructurallyCompare: CEDAR PROGRAM
        IMPORTS IntHashTableThreaded, IO, Real, RealFns, StructuralComparisonDataStructure, StructuralComparisonOps
        EXPORTS StructuralComparisonOps =

        BEGIN OPEN StructuralComparisonDataStructure, StructuralComparisonOps;

        TwoCount: TYPE = ARRAY RealGraphID OF CARDINAL;

        MinHashSize: CARDINAL _ 11;
        sizeFactor: REAL _ 0.25;

        colorClass: IntHashTableThreaded.Class = [GetColorDataKey, SetColorDataLink, GetColorDataLink];

        debug: BOOL _ FALSE;

        CompareGraphs: PUBLIC PROC [a, b: CellType, GenerateHints: PROC [Consume: PROC [vA, vB: Vertex]], pick, mirrors: BOOL] RETURNS 
        [equiv: BOOL, partition: ColorTable] =
            BEGIN
            ComputeColor: PROC [v: Vertex] RETURNS [color: Color] = {
                AddEdge: PROC [edgeColor: Color, nv: Vertex] = {
                    IF NOT GetSuspect[nv] THEN color _ color + (edgeColor+1) * (OldColor[nv]+1);
                    };
                color _ OldColor[v];
                EnumerateEdges[v, AddEdge, mirrors];
                color _ FilterColor[color]};
            EnQNeighbor: PROC [edgeColor: Color, neighbor: Vertex] = {EnQ[neighbor]};
            EnQ: PROC [v: Vertex] = {
                IF (NOT mirrors) AND IsMirror[v] THEN ERROR;
                IF (NOT GetUnique[v]) AND (GetQNext[v] = notInQ) THEN {SetQNext[v, QFirst]; QFirst _ v; QCount _ QCount + 1}};
            AddFrontier: PROC [v: Vertex] = {EnumerateEdges[v, EnQNeighbor, mirrors]};
            Initialize: PROC = {
                ClearVertex: PROC [v: Vertex] = {
                    SetQNext[v, notInQ];
                    SetEquiv[v, NIL];
                    SetOldColor[v, noColor]; SetCurColor[v, noColor];
                    SetUnique[v, FALSE];
                    SetSuspect[v, FALSE];
                    };
                NoteAssoc: PROC [vA, vB: Vertex] = {
                    color: Color = FilterColor[LOOPHOLE[vA]];
                    SetOldColor[vA, color]; SetCurColor[vA, color];
                    SetOldColor[vB, color]; SetCurColor[vB, color];
                    };
                InitVertex: PROC [v: Vertex] = {
                    SetGraph[v, curGraph];
                    IF CurColor[v] = noColor THEN {
                        color: Color = InitialColor[v];
                        SetOldColor[v, color]; SetCurColor[v, color];
                        };
                    AddToColor[GetColorData[curColorData, CurColor[v]], v];
                    };
                ms: NAT = IF mirrors THEN 1 ELSE 0;
                hts: CARDINAL _ MAX[MinHashSize, Real.RoundC[sizeFactor * RealFns.SqRt[a.size + b.size + ms + ms]]];
                curGraph: RealGraphID;
                QFirst _ endOfQ; QCount _ 0;
                partition _ IntHashTableThreaded.Create[hts, colorClass];
                curColorData _ IntHashTableThreaded.Create[hts, colorClass];
                EnumerateParts[a, ClearVertex, mirrors];
                EnumerateParts[b, ClearVertex, mirrors];
                GenerateHints[NoteAssoc];
                curGraph _ A; EnumerateParts[a, InitVertex, mirrors];
                curGraph _ B; EnumerateParts[b, InitVertex, mirrors];
                nonUniqueCount[A] _ a.size + ms;
                nonUniqueCount[B] _ b.size + ms;
                [] _ curColorData.Pairs[ComputeUnique];
                SetQToAllNonUniques[];
                IF QCount # (nonUniqueCount[A] + nonUniqueCount[B]) THEN ERROR;
                };
            Finalize: PROC = {
                FinalVertex: PROC [v: Vertex] = {
                    AddToColor[GetColorData[partition, CurColor[v]], v];
                    };
                EnumerateParts[a, FinalVertex, mirrors];
                EnumerateParts[b, FinalVertex, mirrors];
                };
            SetQToAllNonUniques: PROC = {
                AddVertex: PROC [v: Vertex] = {IF GetQNext[v] # notInQ THEN ERROR; EnQ[v]};
                EnumerateParts[a, AddVertex, mirrors];
                EnumerateParts[b, AddVertex, mirrors];
                IF QCount # (nonUniqueCount[A] + nonUniqueCount[B]) THEN ERROR;
                };
            ChoosePairs: PROC [useSuspects, onlyOne: BOOL] RETURNS [pairCount: CARDINAL] = {
                ConsiderColor: PROC [key: INT, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --IntHashTableThreaded.EachPairAction-- = {
                    ccd: ColorData = NARROW[value];
                    first: ARRAY RealGraphID OF Vertex _ [NIL, NIL];
                    IF ccd.suspect # useSuspects THEN RETURN;
                    FOR v: Vertex _ ccd.firstVertex, GetColorNext[v] WHILE v # NIL DO
                        IF GetQNext[v] # notInQ THEN ERROR;
                        IF first[GetGraph[v]] = NIL THEN {
                            first[GetGraph[v]] _ v;
                            IF first[OtherGraph[GetGraph[v]]] # NIL THEN EXIT};
                        ENDLOOP;
                    IF first[A]#NIL AND first[B]#NIL THEN {
                        IF GetUnique[first[A]] # GetUnique[first[B]] THEN ERROR;
                        IF NOT GetUnique[first[A]] THEN {
                            pairCount _ pairCount + 1;
                            EnQ[first[A]]; EnQ[first[B]];
                            quit _ onlyOne};
                        };
                    };
                pairCount _ 0;
                [] _ curColorData.Pairs[ConsiderColor];
                };
            ComputeUnique: PROC [key: INT, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --IntHashTableThreaded.EachPairAction-- = {
                ccd: ColorData = NARROW[value];
                uniques: ARRAY RealGraphID OF BOOL = [ccd.count[A]=1, ccd.count[B]=1];
                unique: BOOL _ uniques[A] AND uniques[B];
                IF unique THEN {
                    a: Vertex _ ccd.firstVertex;
                    b: Vertex _ GetColorNext[a];
                    IF GetColorNext[b] # NIL THEN ERROR;
                    IF GetGraph[a] = GetGraph[b] THEN ERROR;
                    IF GetUnique[a] OR GetUnique[b] THEN ERROR;
                    SetUnique[a, TRUE];
                    SetUnique[b, TRUE];
                    SetEquiv[a, b]; SetEquiv[b, a];
                    nonUniqueCount[A] _ nonUniqueCount[A] - 1;
                    nonUniqueCount[B] _ nonUniqueCount[B] - 1;
                    };
                ccd.suspect _ ccd.count[A] # ccd.count[B];
                FOR v: Vertex _ ccd.firstVertex, GetColorNext[v] WHILE v # NIL DO
                    SetOldColor[v, CurColor[v]];
                    SetSuspect[v, ccd.suspect];
                    ENDLOOP;
                };
            QueueFrontier: PROC [key: INT, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --IntHashTableThreaded.EachPairAction-- = {
                ccd: ColorData = NARROW[value];
                uniques: ARRAY RealGraphID OF BOOL = [ccd.count[A]=1, ccd.count[B]=1];
                unique: BOOL _ uniques[A] AND uniques[B];
                IF unique THEN {
                    v1: Vertex _ ccd.firstVertex;
                    v2: Vertex _ GetColorNext[v1];
                    IF GetColorNext[v2] # NIL THEN ERROR;
                    IF GetGraph[v1] = GetGraph[v2] THEN ERROR;
                    IF NOT (GetUnique[v1] AND GetUnique[v2]) THEN ERROR;
                    AddFrontier[v1]; AddFrontier[v2];
                    };
                };
            nonUniqueCount: TwoCount _ ALL[LAST[CARDINAL]];
            curColorData, oldColorData: ColorTable _ NIL;
            pass: CARDINAL _ 0;
            QFirst: Vertex;
            QCount: CARDINAL;
            isAll: BOOL _ TRUE;
            someMC: BOOL _ FALSE;
            Initialize[];
            IF debug THEN WriteAll["CompareCDs Initialized", a, b, oldColorData, curColorData];
            WHILE nonUniqueCount[A]#0 AND nonUniqueCount[B]#0 DO
                mcCount: CARDINAL _ 0;
                keepOld: BOOL _ isAll;
                pass _ pass + 1;
                IF QCount > 0 THEN NULL
                ELSE IF NOT (isAll AND NOT someMC) THEN SetQToAllNonUniques[]
                ELSE {pairCount: CARDINAL _ 0;
                    IF pick THEN pairCount _ ChoosePairs[FALSE, TRUE];
                    IF pairCount = 0 THEN {
                        IF QFirst # endOfQ OR QCount # 0 THEN ERROR;
                        pairCount _ ChoosePairs[TRUE, FALSE];
                        IF pairCount = 0 THEN EXIT}};
                isAll _ (nonUniqueCount[A] + nonUniqueCount[B]) = QCount;
                oldColorData _ IF keepOld THEN curColorData ELSE IntHashTableThreaded.Create[curColorData.GetSize[], colorClass];
                curColorData _ IntHashTableThreaded.Create[curColorData.GetSize[], colorClass];
                someMC _ FALSE;
                WHILE QFirst # endOfQ DO
                    v: Vertex = QFirst;
                    oldColor: Color = OldColor[v];
                    newColor: Color = ComputeColor[v];
                    ncd: ColorData = GetColorData[curColorData, newColor];
                    IF QFirst = notInQ THEN ERROR;
                    SetCurColor[v, newColor];
                    QFirst _ GetQNext[v];
                    SetQNext[v, notInQ];
                    IF isAll AND NOT someMC THEN {
                        ocd: ColorData = GetColorData[oldColorData, oldColor, keepOld];
                        IF ocd.newColor = noColor THEN ocd.newColor _ newColor
                        ELSE IF ocd.multicolored THEN ERROR
                        ELSE IF ocd.newColor = newColor THEN NULL
                        ELSE ocd.multicolored _ someMC _ TRUE;
                        };
                    AddToColor[ncd, v];
                    ENDLOOP;
                QCount _ 0;
                [] _ curColorData.Pairs[ComputeUnique];
                [] _ curColorData.Pairs[QueueFrontier];
                IF debug THEN {
                    Log["\nAt end of pass %g:\n", [cardinal[pass]]];
                    WriteColorTable[curColorData];
                    Log["QCount=%g, nonUniqueCount=[%g, %g], someMC=%g, isAll=%g\n",
                        IO.card[QCount], IO.card[nonUniqueCount[A]],
                        IO.card[nonUniqueCount[B]], IO.bool[someMC], IO.bool[isAll]];
                    WriteQ[QFirst];
                    };
                ENDLOOP;
            equiv _ nonUniqueCount[A]=0 AND nonUniqueCount[B]=0;
            Finalize[];
            END;

        GetColorData: PROC [colorTable: ColorTable, color: Color, mayNotCreate: BOOL _ FALSE] RETURNS [cd: ColorData] = {
            cd _ NARROW[colorTable.Fetch[color].value];
            IF cd # NIL OR mayNotCreate THEN RETURN;
            cd _ NEW [ColorDataPrivate _ [color: color]];
            IF NOT colorTable.Insert[color, cd] THEN ERROR;
            };

        AddToColor: PROC [cd: ColorData, v: Vertex] = INLINE {
            SetColorNext[v, cd.firstVertex];
            cd.firstVertex _ v;
            cd.count[GetGraph[v]] _ cd.count[GetGraph[v]] + 1;
            };

        WriteQ: PROC [QFirst: Vertex] =
            BEGIN
            first: BOOL _ TRUE;
            Log["Q = {"];
            FOR QFirst _ QFirst, GetQNext[QFirst] WHILE QFirst # endOfQ DO
                IF QFirst = notInQ THEN ERROR;
                IF first THEN first _ FALSE ELSE Log[", "];
                Log["%g.%g", IO.rope[graphIDToRope[GetGraph[QFirst]]], IO.rope[VerboseVName[QFirst]]];
                ENDLOOP;
            Log["}\n"];
            END;

        GetColorDataKey: PROC [value: REF ANY] RETURNS [key: INT] = {
            cd: ColorData = NARROW[value];
            key _ cd.color;
            };

        SetColorDataLink: PROC [from, to: REF ANY] = {
            fromCD: ColorData = NARROW[from];
            toCD: ColorData = NARROW[to];
            fromCD.nextColor _ toCD;
            };

        GetColorDataLink: PROC [from: REF ANY] RETURNS [to: REF ANY] = {
            fromCD: ColorData = NARROW[from];
            to _ fromCD.nextColor;
            };

        END.