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 _ TRUE;

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.
����‚��StructurallyCompare.Mesa
Last Edited by: Spreitzer, May 7, 1986 4:17:47 pm PDT
Bertrand Serlet June 4, 1986 4:16:39 pm PDT
�Ê
ý��–
"cedar" style˜�code™J™5K™+—K˜�KšÏk	œœ\˜~K˜�šÐbxœœ˜"KšœœK˜kKšœ˜!K˜�Kšœœ<˜FK˜�Kš	œ
œœ
œœ˜/K˜�Kšœ
œ˜Kšœœ˜K˜�Kšœ_˜_K˜�Kšœœœ˜K˜�šÏn
œœœŸ
œœŸœœ#œœ	œ˜¥Kš˜šŸœœ
œ˜9šŸœœ#˜0Kšœœœ2˜LK˜—Kšœ˜Kšœ$˜$Kšœ˜—KšŸœœ8˜IšŸœœ˜Kš
œœ
œ
œœ˜,Kšœœœœ9˜n—KšŸœœ9˜JšŸ
œœ˜šŸœœ˜!Kšœ˜Kšœœ˜Kšœ1˜1Kšœ
œ˜Kšœœ˜K˜—šŸ	œœ˜$Kšœœ˜)Kšœ/˜/Kšœ/˜/K˜—šŸ
œœ˜ Kšœ˜šœœ˜Kšœ˜Kšœ-˜-Kšœ˜—Kšœ7˜7K˜—Kš	œœœ	œœ˜#KšœœœQ˜dK˜K˜Kšœ9˜9K˜<Kšœ(˜(Kšœ(˜(Kšœ˜Kšœ5˜5Kšœ5˜5Kšœ ˜ Kšœ ˜ K˜'Kšœ˜Kšœ2œœ˜?Kšœ˜—šŸœœ˜šŸœœ˜!Kšœ4˜4K˜—Kšœ(˜(Kšœ(˜(K˜—šŸœœ˜Kš
Ÿ	œœœœœ
˜KKšœ&˜&Kšœ&˜&Kš
œœœœœ˜?Kšœ˜—š
Ÿœœœœ
œ˜PšŸ
œœœ	œœœœœÏc'œ˜wKšœœ˜Kš	œœ
œœœ˜0Kšœœœ˜)šœ.œœ˜AKšœœœ˜#šœœœ˜"Kšœ˜Kšœ"œœœ˜3—Kšœ˜—š
œ
œœ
œœ˜'Kšœ+œœ˜8šœœœ˜!Kšœ˜Kšœ˜Kšœ˜—Kšœ˜—K˜—Kšœ˜K˜'Kšœ˜—šŸ
œœœ	œœœœœ 'œ˜wKšœœ˜Kšœ	œ
œœœœ˜FKš	œœœœ	œ˜)šœœ˜Kšœ˜Kšœ˜Kšœœœœ˜$Kšœœœ˜(Kšœœœœ˜+Kšœ
œ˜Kšœ
œ˜Kšœ˜Kšœœœ˜*Kšœœœ˜*K˜—Kšœ*˜*šœ.œœ˜AKšœ˜Kšœ˜Kšœ˜—K˜—šŸ
œœœ	œœœœœ 'œ˜wKšœœ˜Kšœ	œ
œœœœ˜FKš	œœœœ	œ˜)šœœ˜Kšœ˜Kšœ˜Kšœœœœ˜%Kšœœœ˜*Kš
œœœœœ˜4Kšœ!˜!K˜—K˜—Kšœœœœ˜/Kšœ)œ˜-Kšœœ˜K˜Kšœœ˜Kšœœœ˜Kšœœœ˜K˜
KšœœF˜Sš	œœœœ˜4Kšœ	œ˜Kšœ	œ	˜Kšœ˜Kšœœ˜Kšœœœœœ	œ˜=šœ
œ˜Kšœœœœ˜2šœœ˜Kšœœœœ˜,Kšœœœ˜%Kšœœœ˜——Kšœœœ˜9Kšœœ	œœA˜qKšœO˜OKšœ	œ˜šœ˜K˜Kšœ˜Kšœ"˜"Kšœ6˜6Kšœœœ˜K˜Kšœ˜Kšœ˜šœœœœ˜Kšœ?˜?Kšœœ˜6Kšœœœ˜#Kšœœœ˜)Kšœœ˜&K˜—K˜Kšœ˜—K˜K˜'K˜'šœœ˜K˜0K˜šœ@˜@Kšœœ˜,Kšœœœ˜=—K˜K˜—Kšœ˜—Kšœœœœ˜4K˜Kšœ˜—K˜�š
Ÿœœ6œœœ˜qKšœœ ˜+Kš
œœœœœ˜(Kšœœ%˜-Kšœœœœ˜/K˜—K˜�šŸ
œœœ˜6Kšœ ˜ Kšœ˜Kšœ2˜2K˜—K˜�šŸœœ˜Kš˜Kšœœœ˜K˜
šœ#œ˜>Kšœœœ˜Kšœœ	œœ˜+Kšœ
œ(œ˜VKšœ˜—K˜Kšœ˜—K˜�šŸœœ	œœœœ˜=Kšœœ˜K˜K˜—K˜�šŸœœœœ˜.Kšœœ˜!Kšœœ˜K˜K˜—K˜�šŸœœœœœœœ˜@Kšœœ˜!K˜K˜—K˜�Kšœ˜——�…—���� ú��,y��