
    <<StructurallyCompare.Mesa>>
        <<Bertrand Serlet June 4, 1986 4:16:39 pm PDT>>
        <<Last tweaked by Mike Spreitzer on November 8, 1988 11:39:25 am PST>>

    DIRECTORY Basics, CardHashTableThreaded, CommandTool, CoreStructuralComparison, FSExtras, Histograms, HistogramsViewing, IO, 
    Random, Real, RealFns, Rope, RopeHash, StructuralComparisonDataStructure, StructuralComparisonOps, SymTab, ViewerClasses;

    StructurallyCompare: CEDAR PROGRAM
        IMPORTS Basics, CardHashTableThreaded, CommandTool, CoreStructuralComparison, FSExtras, Histograms, HistogramsViewing, IO, Random, 
        Real, RealFns, StructuralComparisonDataStructure, StructuralComparisonOps, SymTab
        EXPORTS StructuralComparisonOps =

        BEGIN OPEN CSC:CoreStructuralComparison, StructuralComparisonDataStructure, StructuralComparisonOps;

        TwoCount: TYPE = ARRAY RealGraphID OF CARDINAL;

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

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

        debug: BOOL _ TRUE;
        Break: SIGNAL = CODE;

        installDir: ROPE ~ FSExtras.GetWDir[];
        passesH: Histograms.Histogram ~ Histograms.Create1D[];
        sizeH: Histograms.Histogram ~ Histograms.Create1D[factor: RealFns.Power[2, 0.25], offset: 1, logarithmic: TRUE];
        relExamsPerCompH: Histograms.Histogram ~ Histograms.Create1D[factor: 0.025];
        relExamsPerPassH: Histograms.Histogram ~ Histograms.Create1D[factor: 0.01];
        absExamsPerCompH: Histograms.Histogram ~ Histograms.Create1D[factor: RealFns.Power[2, 0.25], offset: 1, logarithmic: TRUE];
        absExamsPerPass: Histograms.Histogram ~ Histograms.Create1D[factor: RealFns.Power[2, 0.25], offset: 1, logarithmic: TRUE];
        v1, v2, v3, v4, v5, v6: ViewerClasses.Viewer _ NIL;

        DisplayStats: PUBLIC PROC ~ {
            ok: BOOL _ FALSE;
            Installit: PROC ~ {ok _ NOT CommandTool.Install["HistogramsViewing", NIL].failed};
            FSExtras.DoInWDir[installDir, Installit];
            IF NOT ok THEN RETURN;
            IF v1=NIL OR v1.destroyed THEN v1 _ HistogramsViewing.Show[h: passesH, viewerInit: [name: "Comparisons doing x passes"], 
            updatePeriod: 10];
            IF v2=NIL OR v2.destroyed THEN v2 _ HistogramsViewing.Show[h: sizeH, viewerInit: [name: "Subtrees of size x"], format: "%g", 
            updatePeriod: 10];
            IF v3=NIL OR v3.destroyed THEN v3 _ HistogramsViewing.Show[h: relExamsPerCompH, viewerInit: [name: "Comparisons doing x 
            work/size"], format: "%g", updatePeriod: 10];
            IF v4=NIL OR v4.destroyed THEN v4 _ HistogramsViewing.Show[h: relExamsPerPassH, viewerInit: [name: "Passes doing x work/size"], 
            format: "%g", updatePeriod: 10];
            IF v5=NIL OR v5.destroyed THEN v5 _ HistogramsViewing.Show[h: absExamsPerCompH, viewerInit: [name: "Comparisons doing x work"], 
            format: "%g", updatePeriod: 10];
            IF v6=NIL OR v6.destroyed THEN v6 _ HistogramsViewing.Show[h: absExamsPerPass, viewerInit: [name: "Passes doing x work"], format: 
            "%g", updatePeriod: 10];
            RETURN};

        MidSquare: PROC [x: CARD] RETURNS [y: CARD] ~ {y _ MidSquareI[x]};

        MidSquareI: PROC [x: CARD] RETURNS [CARD] ~ INLINE {
            lowProd: Basics.LongNumber = [lc[Basics.LongMult[Basics.LowHalf[x], Basics.LowHalf[x]]]];
            midProd: Basics.LongNumber = [lc[Basics.LongMult[Basics.LowHalf[x], Basics.HighHalf[x]]]];
            highProd: Basics.LongNumber = [lc[Basics.LongMult[Basics.HighHalf[x], Basics.HighHalf[x]]]];
            m: Basics.LongNumber = [lc[AddC[lowProd.hi, midProd.lo, midProd.lo]]];
            lo: Basics.LongNumber = [pair[lo: lowProd.lo, hi: m.lo]];
            hi: CARD = highProd.lc + AddC[m.hi, midProd.hi, midProd.hi];
            RETURN [hi + lo.lc]};

        CompareGraphs: PUBLIC PROC [descriptions: RealGraphDescriptions, a, b: CellType, trace: SymTab.Ref _ NIL, GenerateHints: PROC 
        [Consume: PROC [vA, vB: Vertex]], pick, mirrors, mayQuitEarly: BOOL, abort: REF BOOL] RETURNS [equiv, didQuitEarly: BOOL, 
        partition: ColorTable] =
            BEGIN
            rs: Random.RandomStream = Random.Create[seed: 0];
            passColor: Color _ noColor;
            breakVs: SymTab.Ref _ NIL;
            totalSize: REAL _ 0.0;
            totalExams, examsThisPass: CARD _ 0;
            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);
                    IF trace#NIL AND trace.Fetch[VerboseVName[v]].found THEN Log[IF GetSuspect[nv] THEN "(%g)%g +| %08x * %08x (%g)\n" ELSE "(%g)%g += 
                    %08x * %08x (%g)\n", [rope[descriptions[GetGraph[v]]]], [rope[VerboseVName[v]]], [cardinal[edgeColor]], 
                    [cardinal[OldColor[nv]]], [rope[VerboseVName[nv]]] ];
                    };
                color _ OldColor[v] + passColor;
                EnumerateEdges[v, AddEdge, mirrors];
                color _ FilterColor[MidSquareI[color]];
                IF debug AND breakVs#NIL AND breakVs.Fetch[VName[v]].found THEN Break;
                examsThisPass _ examsThisPass+1;
                };
            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] = {
                    IF VDead[v] THEN ERROR;
                    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[rs.NextInt[]];
                    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];
                    examsThisPass _ examsThisPass+1;
                    };
                ms: NAT = IF mirrors THEN 1 ELSE 0;
                hts: CARDINAL _ MAX[Real.Round[sizeFactor * RealFns.SqRt[a.size + INT[b.size] + ms + ms]], MinHashSize];
                curGraph: RealGraphID;
                QFirst _ endOfQ; QCount _ 0;
                partition _ CardHashTableThreaded.Create[hts, colorClass];
                curColorData _ CardHashTableThreaded.Create[hts, colorClass];
                EnumerateParts[a, ClearVertex, mirrors];
                IF abort^ THEN RETURN;
                EnumerateParts[b, ClearVertex, mirrors];
                IF abort^ THEN RETURN;
                GenerateHints[NoteAssoc];
                IF abort^ THEN RETURN;
                totalSize _ a.size + REAL[b.size] + ms + ms;
                IF totalSize=0.0 THEN totalSize _ 1.0E-10;
                curGraph _ A; EnumerateParts[a, InitVertex, mirrors];
                IF abort^ THEN RETURN;
                curGraph _ B; EnumerateParts[b, InitVertex, mirrors];
                IF abort^ THEN RETURN;
                nonUniqueCount[A] _ a.size + ms;
                nonUniqueCount[B] _ b.size + ms;
                someSuspect _ FALSE;
                [] _ 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: CARD, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --CardHashTableThreaded.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: CARD, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --CardHashTableThreaded.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;
                    };
                someSuspect _ (ccd.suspect _ ccd.count[A] # ccd.count[B]) OR someSuspect;
                FOR v: Vertex _ ccd.firstVertex, GetColorNext[v] WHILE v # NIL DO
                    SetOldColor[v, CurColor[v]];
                    SetSuspect[v, ccd.suspect];
                    ENDLOOP;
                };
            QueueFrontier: PROC [key: CARD, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --CardHashTableThreaded.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 _ NIL;
            QCount: CARDINAL _ 0;
            isAll: BOOL _ TRUE;
            someMC, someSuspect: BOOL _ FALSE;
            IF abort^ THEN RETURN [FALSE, FALSE, NIL];
            Initialize[];
            IF abort^ THEN RETURN [FALSE, FALSE, NIL];
            totalExams _ examsThisPass;
            sizeH.IncrementTransformed[xmin: 1, xmax: 4.0E9, x: totalSize];
            absExamsPerPass.IncrementTransformed[xmin: 1, xmax: 4.0E9, x: examsThisPass];
            relExamsPerPassH.IncrementTransformed[xmin: 0, xmax: 1000, x: examsThisPass/totalSize];
            IF debug THEN {
                CSC.PushTimer[$log4Compare];
                WriteAll["CompareCDs Initialized", descriptions, a, b, oldColorData, curColorData !UNWIND => CSC.PopTimer[$log4Compare]];
                CSC.PopTimer[$log4Compare]};
            didQuitEarly _ mayQuitEarly AND someSuspect;
            WHILE nonUniqueCount[A]#0 AND nonUniqueCount[B]#0 AND NOT didQuitEarly DO
                mcCount: CARDINAL _ 0;
                keepOld: BOOL _ isAll;
                IF abort^ THEN RETURN [FALSE, FALSE, NIL];
                pass _ pass + 1;
                examsThisPass _ 0;
                passColor _ LOOPHOLE[rs.NextInt[], Color];
                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 CardHashTableThreaded.Create[curColorData.GetSize[], colorClass];
                curColorData _ CardHashTableThreaded.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 abort^ THEN RETURN [FALSE, FALSE, NIL];
                    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;
                totalExams _ totalExams + examsThisPass;
                absExamsPerPass.IncrementTransformed[xmin: 1, xmax: 4.0E9, x: examsThisPass];
                relExamsPerPassH.IncrementTransformed[xmin: 0, xmax: 1000, x: examsThisPass/totalSize];
                QCount _ 0;
                someSuspect _ FALSE;
                [] _ curColorData.Pairs[ComputeUnique];
                [] _ curColorData.Pairs[QueueFrontier];
                IF debug THEN {
                    CSC.PushTimer[$log4Compare];
                    {ENABLE UNWIND => CSC.PopTimer[$log4Compare];
                    Log["\nAt end of pass %g:\n", [cardinal[pass]]];
                    WriteColorTable[curColorData, descriptions];
                    Log["QCount=%g, nonUniqueCount=[%g, %g]", IO.card[QCount], IO.card[nonUniqueCount[A]], IO.card[nonUniqueCount[B]]];
                    Log[", someMC=%g, isAll=%g, someSuspect=%g\n", IO.bool[someMC], IO.bool[isAll], IO.bool[someSuspect]];
                    WriteQ[QFirst, descriptions]};
                    CSC.PopTimer[$log4Compare]};
                ENDLOOP;
            passesH.IncrementTransformed[xmin: 0, xmax: 4.0E9, x: pass];
            relExamsPerCompH.IncrementTransformed[xmin: 1, xmax: 4.0E9, x: totalExams/totalSize];
            absExamsPerCompH.IncrementTransformed[xmin: 1, xmax: 4.0E9, x: totalExams];
            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, descriptions: RealGraphDescriptions] =
            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", [rope[descriptions[GetGraph[QFirst]]]], IO.rope[VerboseVName[QFirst]]];
                ENDLOOP;
            Log["}\n"];
            END;

        GetColorDataKey: PROC [value: REF ANY] RETURNS [key: CARD] = {
            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;
            };

        AddC: PROC [c1, c2, c3: CARDINAL] RETURNS [CARD] = INLINE {
            RETURN [c1.LONG + c2.LONG + c3.LONG];
            };

        END.