Unify OrbitalGraphs with _BTKit.getOrbitalList

This way, _BTKit.getOrbitalList can be removed from
the BacktrackKit package, and BacktrackKit can rely
on the OrbitalGraphs package instead.

This reduces code duplication and gives further
motivation to improve the OrbitalGraphs package.

Author: wilfwilson

gap/OrbitalGraphs.gd

@@ -67,9 +67,9 @@ DeclareOperation("OrbitalGraphs", [IsPermGroup, IsHomogeneousList]);
 #! gap> D8 := Group([ (1,2,3,4), (2,4) ]);; StructureDescription(D8);
 #! "D8"
 #! gap> OrbitalGraphs(D8);
-#! [ <self-paired orbital graph of D8 on 4 vertices with base-pair (1,3), 4 arcs>
+#! [ <self-paired orbital graph of D8 on 4 vertices with base-pair (1,2), 8 arcs>
 #!     , <self-paired orbital graph of D8 on 4 vertices 
-#!     with base-pair (1,2), 8 arcs> ]
+#!     with base-pair (1,3), 4 arcs> ]
 #! @EndExampleSession
 DeclareOperation("OrbitalGraphs", [IsPermGroup, IsInt]);
 

gap/OrbitalGraphs.gi

@@ -30,7 +30,8 @@ end);
 InstallMethod(OrbitalGraphs, "for a permutation group and a homogeneous list",
 [IsPermGroup, IsHomogeneousList],
 function(G, points)
-    local orb, orbitsG, iorb, graph, graphlist, val, p, i, orbsizes, D,
+    local orb, orbitsG, iorb, graph, graphlist, val, p, i, orbsizes, D, cutoff,
+          biggestOrbit, shouldSkipOneLargeOrbit, allowLoopyGraphs, search,
           orbpos, innerorblist, orbitsizes, orbreps, fillRepElts, maxval, moved;
 
     if IsEmpty(points) then
@@ -48,6 +49,15 @@ function(G, points)
     fi;
     moved := Intersection(points, MovedPoints(G));
 
+    # Optimisation from BacktrackKit
+    # Warning: in the future, if we wish to allow supporting orbital graphs
+    # with loops, and choosing base points that are allowed to be fixed, then
+    # this would mean that a trivial group could have some orbital graphs to
+    # return, and so this optimisation would be invalid.
+    if IsTrivial(G) then
+        return [];
+    fi;
+
     fillRepElts := function(G, orb)
         local val, g, reps, buildorb, gens;
         reps := [];
@@ -65,49 +75,83 @@ function(G, points)
         return reps;
     end;
 
-    orbitsG := Orbits(G, moved);
+    # Option `cutoff`:
+    # Have a limit for the number of edges that an orbital graph that this
+    # function will create. The default is infinity.
+    if IsPosInt(ValueOption("cutoff")) then
+        cutoff := ValueOption("cutoff");
+    else
+        cutoff := infinity;
+    fi;
 
-    # FIXME: Currently unused
-    orbsizes := [];
-    # FIXME: Currently unused
-    orbpos := [];
+
+    # Option `search`:
+    # If `true`, then OrbitalGraphs will not create some orbital graphs
+    # that are useless from the point of view of a backtrack search algorithm.
+    search := ValueOption("search") = true;
+
+    # Option `skipone`
+    # If `true`, then OrbitalGraphs will not create one of the orbital graphs
+    # that has the largest possible number of edges. In a backtrack search,
+    # one such orbital graph can be ignored without losing anything.
+    shouldSkipOneLargeOrbit := search or ValueOption("skipone") = true;
+
+    # Make sure that the orbits of G are stably sorted, so that the resulting
+    # list of orbital graphs for a group always comes in the same order,
+    # with the same base pairs.
+    orbitsG := Set(Orbits(G, moved), Set);
 
     # Efficently store size of orbits of values
+    orbsizes := [];
+    orbpos := [];
     for orb in [1 .. Length(orbitsG)] do
         for i in orbitsG[orb] do
             orbsizes[i] := Length(orbitsG[orb]);
             orbpos[i] := orb;
         od;
     od;
 
-    innerorblist := List(orbitsG, o -> Orbits(Stabilizer(G, o[1]), moved));
-    # FIXME: Currently unused
+    # FIXME: In the following line, BacktrackKit uses [1..LargestMovedPoint(G)]
+    # instead of moved (which omits non-moved points). Is this a problem?
+    innerorblist := List(orbitsG, o -> Set(Orbits(Stabilizer(G, o[1]), moved), Set));
     orbitsizes := List([1 .. Length(orbitsG)],
                        x -> List(innerorblist[x], y -> Length(orbitsG[x]) * Length(y)));
+    biggestOrbit := Maximum(List(orbitsizes, Maximum));
 
     graphlist := [];
     for i in [1 .. Length(orbitsG)] do
         orb := orbitsG[i];
         orbreps := [];
-
         for iorb in innerorblist[i] do
-            if not (Size(iorb) = 1 and orb[1] = iorb[1]) # No loopy orbitals
-            then
-                graph := List([1..maxval], x -> []);
-                if IsEmpty(orbreps) then
-                    orbreps := fillRepElts(G, orb);
-                fi;
-                for val in orb do
-                    p := orbreps[val];
-                    graph[val] := List(iorb, x -> x^p);
-                od;
-                D := Digraph(graph);
-                SetUnderlyingGroup(D, G);
-                AddSet(graphlist, D);
+            # Find reasons to not construct the orbital graph with base-pair... TODO
+            if shouldSkipOneLargeOrbit and Size(orb) * Size(iorb) = biggestOrbit then
+                shouldSkipOneLargeOrbit := false;
+                continue;
+            elif
+                Size(orb) * Size(iorb) > cutoff # orbital graph is too big
+                or (search and Size(iorb) = orbsizes[iorb[1]]) # orbit size unchanged
+                or (search and orbpos[orb[1]] = orbpos[iorb[1]] and Size(iorb) + 1 = orbsizes[iorb[1]]) # orbit size only removed one point
+                or (Length(iorb) = 1 and orb[1] = iorb[1]) # don't want to take the fixed point orbit
+              then
+                continue;
+            fi;
+
+            # Construct the orbital graph as a Digraphs package object
+            if IsEmpty(orbreps) then
+                orbreps := fillRepElts(G, orb);
             fi;
+            graph := List([1 .. maxval], x -> []);
+            for val in orb do
+                p := orbreps[val];
+                graph[val] := List(iorb, x -> x ^ p);
+            od;
+            D := Digraph(graph);
+            SetFilterObj(D, IsOrbitalGraphOfGroup);
+            SetUnderlyingGroup(D, G);
+            Add(graphlist, D);
         od;
     od;
-    Perform(graphlist, function(x) SetFilterObj(x, IsOrbitalGraphOfGroup); end);
+    # Note: `graphlist` should already be stably ordered because of the uses of `Set`
     return graphlist;
 end);
 

tst/orbitalgraphs01.tst

@@ -14,9 +14,9 @@ gap> START_TEST("orbitalgraphs01.tst");
 gap> D8 := Group([ (1,2,3,4), (2,4) ]);; StructureDescription(D8);
 "D8"
 gap> OrbitalGraphs(D8);
-[ <self-paired orbital graph of D8 on 4 vertices with base-pair (1,3), 4 arcs>
+[ <self-paired orbital graph of D8 on 4 vertices with base-pair (1,2), 8 arcs>
     , <self-paired orbital graph of D8 on 4 vertices 
-    with base-pair (1,2), 8 arcs> ]
+    with base-pair (1,3), 4 arcs> ]
 
 # doc/_Chapter_Orbital_graphs.xml:101-114
 gap> D8 := DihedralGroup(IsPermGroup, 8);

tst/orbitals.tst

@@ -27,9 +27,9 @@ gap> Length(orbitals);
 gap> ForAll(orbitals, D -> IsDigraph(D) and DigraphNrVertices(D) = 114);
 true
 gap> List(orbitals, DigraphNrEdges);
-[ 2, 2, 2, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 8, 8, 8, 8, 8, 8, 8, 8, 
-  8, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 
-  100, 100, 200, 200, 200, 200, 2450, 2450, 2500, 2500 ]
+[ 2450, 100, 100, 2500, 100, 100, 200, 100, 2, 4, 100, 4, 4, 8, 100, 4, 2, 
+  100, 4, 4, 8, 2500, 100, 100, 2450, 100, 100, 200, 100, 4, 4, 100, 2, 4, 8, 
+  100, 4, 4, 100, 4, 2, 8, 200, 8, 8, 200, 8, 8, 8, 4 ]
 gap> Number(orbitals, IsSymmetricDigraph);
 8
 gap> Set(orbitals, x -> Minimum(DigraphEdges(x)));