diff --git a/doc/oper.xml b/doc/oper.xml index 0930e8f3c..e12d82493 100644 --- a/doc/oper.xml +++ b/doc/oper.xml @@ -2619,3 +2619,36 @@ true]]> gap> DIGRAPHS_FREE_CLIQUES_DATA(); ]]> <#/GAPDoc> + +<#GAPDoc Label="DigraphColourRefinement"> + + + A list of lists of integers. + + Colour Refinement is a method of colouring a digraph such that for a colour, every + node with that colouring has an identical configuration of coloured neighbours. That is, + all nodes of colour q have the same number of neighbours of colour x, and colour y, etc. + DigraphColourRefinement considers the out neighbours and in neighbours of a node separately. +

+ This involves recolouring the digraph each iteration until it is 'refined'. It returns the colouring as a + list where the value at the ith position is the colour of node i. For two digraphs with different colourings, + we can be sure that they are not isomorphic. However, identical colourings for two digraphs does not necessarily + mean they are isomorphic. +

+ See also + . +

+ + D := Digraph([[3], [], [1, 9], [], [10], [7, 8, 9], [6, 8], [6, 7], [3, 6, 10], [5, 9]]);; +gap> DigraphColourRefinement(D); +[ 2, 1, 4, 1, 2, 6, 3, 3, 5, 4 ] +gap> DigraphColourRefinement(Digraph([[], [1], [1], [1]])); +[ 1, 2, 2, 2 ] +]]> + + +<#/GAPDoc> diff --git a/gap/oper.gd b/gap/oper.gd index f6a37e0f8..4766b3496 100644 --- a/gap/oper.gd +++ b/gap/oper.gd @@ -156,6 +156,8 @@ DeclareOperation("Dominators", [IsDigraph, IsPosInt]); DeclareOperation("DominatorTree", [IsDigraph, IsPosInt]); DeclareOperation("DigraphCycleBasis", [IsDigraph]); +DeclareOperation("DigraphColourRefinement", [IsDigraph]); + # 10. Operations for vertices . . . DeclareOperation("PartialOrderDigraphJoinOfVertices", [IsDigraph, IsPosInt, IsPosInt]); diff --git a/gap/oper.gi b/gap/oper.gi index 3876db50e..9be9917ef 100644 --- a/gap/oper.gi +++ b/gap/oper.gi @@ -2732,3 +2732,135 @@ function(D, n) od; return kings; end); + +InstallMethod(DigraphColourRefinement, "for a digraph", [IsDigraph], +function(D) + + local listResult, i, round, c_min, c_max, set, Q, q, C, CD, + j, P, v, Out, In, Sets, pair, current, currentPair, newSet, colour; + + # Or just remove loops? + if not DigraphNrLoops(D) = 0 then + ErrorNoReturn("the digraph cannot contain loops"); + fi; + + c_min := 1; + c_max := 1; + + # Queue of colours + Q := [1]; + + # Initial colouring + # vertices -> colour + C := []; + for v in DigraphVertices(D) do + C[v] := 1; + od; + + # Colour classes + # All vertices initialised to 1 + # colour -> vertices labelled as such + P := rec(1 := DigraphVertices(D)); + + while not IsEmpty(Q) do + + # Pop colour off Q + q := Q[1]; + Remove(Q, 1); + + # For each v in V (all vertices in D) + # Get the neighbours of v that are in the colour class q + Out := rec(); + In := rec(); + for v in DigraphVertices(D) do + Out.(v) := Intersection(OutNeighbours(D)[v], P.(q)); + In.(v) := Intersection(InNeighbours(D)[v], P.(q)); + od; + + # CD: [colour of v, number of q coloured out-neighbours of v, + # number of q coloured in-neighbours of v, v] + CD := []; + for v in DigraphVertices(D) do + Add(CD, [C[v], Length(Out.(v)), Length(In.(v)), v]); + od; + + Sort(CD); + + # Put into sets + Sets := []; + currentPair := []; + newSet := []; + + j := 0; + + for pair in CD do + current := [pair[1], pair[2], pair[3]]; + + # If first pair OR has the same values as the prev pair: + if currentPair = [] or current = currentPair then + Add(newSet, pair[4]); + else + # Doesn't have the same values as the prev pair + Add(Sets, newSet); + newSet := [pair[4]]; + + # If they had the same colour but diff no. neighbours + if pair[1] = currentPair[1] then + + # Push a new number to Q + j := j + 1; + fi; + fi; + currentPair := current; + od; + Add(Sets, newSet); + + # If there is reason for recolouring + if j > 0 then + + # Clearing P + # TODO: Can P be a list from the start? + # Would simplify this a lot vv + colour := c_min; + while colour <= c_max do + P.(colour) := []; + colour := colour + 1; + od; + + Q := []; + + # Pushing the last value to Q + # TODO: look into largest set number for optimisation + for i in [1 .. Length(Sets)] do + + # TODO: make this conditional on not being the largest set? + Add(Q, c_max + i); + od; + + # Updating colours for the next round + c_min := c_max + 1; + c_max := c_max + Length(Sets); + + # Updating C and P + colour := c_min; + + for set in Sets do + P.(colour) := set; + + for v in set do + C[v] := colour; + od; + colour := colour + 1; + od; + fi; + + od; + + # Normalising C to 1 + for i in [1 .. Length(C)] do + C[i] := C[i] - (c_min - 1); + od; + + return C; + +end); diff --git a/tst/standard/oper.tst b/tst/standard/oper.tst index 1c813fe21..45163c26d 100644 --- a/tst/standard/oper.tst +++ b/tst/standard/oper.tst @@ -3324,6 +3324,32 @@ gap> DigraphEdges(D); gap> DigraphVertexLabels(D); [ 1, 2, 3, 6, [ 4, 5 ] ] +# DigraphColourRefinement +gap> D := Digraph([[3], [], [1, 9], [], [10], [7, 8, 9], [6, 8], [6, 7], [3, 6, 10], [5, 9]]);; +gap> DigraphColourRefinement(D); +[ 2, 1, 4, 1, 2, 6, 3, 3, 5, 4 ] +gap> D := Digraph([[], [1], [1], [1]]);; +gap> DigraphColourRefinement(D); +[ 1, 2, 2, 2 ] +gap> D := Digraph([[1], [1], [1], [1]]);; +gap> DigraphColourRefinement(D); +Error, the digraph cannot contain loops +gap> D := Digraph([[], [], [], []]);; +gap> DigraphColourRefinement(D); +[ 1, 1, 1, 1 ] +gap> D := Digraph([[2], [3], [2, 4], [2, 5], [4, 6], [5]]);; +gap> DigraphColourRefinement(D); +[ 1, 3, 4, 5, 6, 2 ] +gap> D := Digraph([[2], [3], [1]]);; +gap> DigraphColourRefinement(D); +[ 1, 1, 1 ] +gap> D := Digraph([[2, 4], [5], [2, 4], [5], [1, 3]]);; +gap> DigraphColourRefinement(D); +[ 2, 1, 2, 1, 3 ] +gap> D := Digraph([[4], [1, 3], [4], [5], [1, 3]]);; +gap> DigraphColourRefinement(D); +[ 2, 3, 2, 1, 4 ] + # gap> DIGRAPHS_StopTest(); gap> STOP_TEST("Digraphs package: standard/oper.tst", 0);