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,98 @@ 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 := [];
+    # TODO: Implement this
+    # Option `loops`:
+    # Create OrbitalGraphs with base pair is a loop (i.e. a repeated vertex).
+    # People do not normally want these kinds of orbital graphs, since they
+    # only tell you about the orbit of that point.
+    #allowLoopyGraphs := ValueOption("loops") = true;
+
+    # 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 this orbital graph...
+            # (These conditions are split to allow for future Info statements
+            # explaining what is happening, and also to make sure we have
+            # good code coverage, and therefore that we have good tests.)
+            if Size(orb) * Size(iorb) > cutoff then
+                # orbital graph is too big
+                continue;
+            elif search and Size(iorb) = orbsizes[iorb[1]] then
+                # orbit size unchanged
+                continue;
+            elif search and orbpos[orb[1]] = orbpos[iorb[1]] and Size(iorb) + 1 = orbsizes[iorb[1]] then
+                # orbit size only removed one point
+                continue;
+            elif Length(iorb) = 1 and orb[1] = iorb[1] then
+                # don't want to take the fixed point orbit
+                continue;
+            elif shouldSkipOneLargeOrbit and Size(orb) * Size(iorb) = biggestOrbit then
+                # largest possible; skip
+                shouldSkipOneLargeOrbit := false;
+                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)));
@@ -107,5 +107,19 @@ gap> OrbitalGraphs(G) =
 >        x -> OrbitalGraph(G, BasePair(x), LargestMovedPoint(G)));
 true
 
+# OrbitalGraphs: `skipone` option
+gap> IsEmpty(OrbitalGraphs(SymmetricGroup(5) : skipone));
+true
+gap> Length(OrbitalGraphs(Group((1,2,3,4))));
+3
+gap> Length(OrbitalGraphs(Group((1,2,3,4)) : skipone));
+2
+
+# OrbitalGraphs: `cutoff` option
+gap> Length(OrbitalGraphs(DihedralGroup(IsPermGroup, 8)));
+2
+gap> Length(OrbitalGraphs(DihedralGroup(IsPermGroup, 8) : cutoff := 4));
+1
+
 #
 gap> STOP_TEST("OrbitalGraphs package: orbitalgraphs.tst", 0);