Implementing Colour Refinement

doc/oper.xml

@@ -2619,3 +2619,36 @@ true]]>
   gap> DIGRAPHS_FREE_CLIQUES_DATA();
   ]]></Example>
 <#/GAPDoc>
+
+<#GAPDoc Label="DigraphColourRefinement">
+<ManSection>
+  <Oper Name="DigraphColourRefinement"
+        Arg="digraph"
+        Label="for a digraph"/>
+  <Returns>A list of lists of integers.</Returns>
+  <Description>
+    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 <A>q</A> have the same number of neighbours of colour <A>x</A>, and colour y</A>, etc.
+    <C>DigraphColourRefinement</C> considers the out neighbours and in neighbours of a node separately.
+    <P/>
+    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.
+    <P/>
+    See also
+    <Ref Oper="DigraphColouring"
+         Label="for a digraph and a number of colours"/>.
+    <P/>
+
+    <Example><![CDATA[
+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> DigraphColourRefinement(Digraph([[], [1], [1], [1]]));
+[ 1, 2, 2, 2 ]
+]]></Example>
+  </Description>
+</ManSection>
+<#/GAPDoc>

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]);

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);

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);