colorClass: IntHashTableThreaded.Class = [GetColorDataKey, SetColorDataLink, GetColorDataLink];
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;
};