####################################################################
# This code gives the basic functions that were used to
# support the computation done in the paper by
# Bamberg-Bishnoi-Royle. In practice, some ad hoc optimisations
# were used, however, this code gives at least a proof of concept,
# particularly in the small cases (q=3,4).
####################################################################
LoadPackage("fining");;
####################################################################
# Functions
# - MakeMinionFile
# - ReadResults
# - ClassifyqRegularSubgraphsWithStarterSets
# - GiveMe8Cycle
# - PrintOutSolutions
####################################################################
MakeMinionFile := function(pts, lns, f, orbits, starter)
# This function produces a minion file
# that enumerates all q-regular subgraphs
# invariant under a group H. Only the orbits
# of H on Concatenation(pts, lns) is given.
# The variable f is the filename of the minion file.
# The variable starter is a list of numbers that
# denote elements that are assumed to be in the
# 1-good structure.
local np, neighbours, i, o, q;
q := Size(BaseField(pts[1]));
np := Length(pts);;
PrintTo(f,"MINION 3\n");;
AppendTo(f,"**VARIABLES**\n");;
AppendTo(f,"BOOL pts[",np,"]\n");
AppendTo(f,"BOOL lns[",np,"]\n");
AppendTo(f,"**CONSTRAINTS**\n");;
# We first print out the "reifyimply" constraints, which are
# explained in the paper.
neighbours := function(arr1,arr2,which,str,f)
local j;
AppendTo(f,"[");
for j in [1..Length(arr2)] do
if arr1[which] * arr2[j] then
AppendTo(f,str,"[",j-1,"],");
fi;
od;
AppendTo(f,"]");
return;
end;;
for i in [1..np] do
AppendTo(f,"reifyimply(");
AppendTo(f,"sumgeq(");
neighbours(pts,lns,i,"lns",f);
AppendTo(f,"," , q, "),pts[" , i-1 ,"])\n");
AppendTo(f,"reifyimply(");
AppendTo(f,"sumgeq(");
neighbours(lns,pts,i,"pts",f);
AppendTo(f,"," , q, "),lns[" , i-1 ,"])\n");
AppendTo(f,"reifyimply(");
AppendTo(f,"sumleq(");
neighbours(pts,lns,i,"lns",f);
AppendTo(f,"," , q, "),pts[" , i-1 ,"])\n");
AppendTo(f,"reifyimply(");
AppendTo(f,"sumleq(");
neighbours(lns,pts,i,"pts",f);
AppendTo(f,"," , q, "),lns[" , i-1 ,"])\n");
od;
# Printing out the "orbit" constraints here
# (1-size of orbit) . (first element of orbit) + (sum of rest) = 0
for o in orbits do
AppendTo(f,"weightedsumgeq([", 1-Size(o));
for i in [2..Size(o)] do
AppendTo(f,",1");
od;
AppendTo(f,"],[");
for i in [1..Size(o)] do
if o[i] <= Size(pts) then
AppendTo(f, "pts[", o[i]-1, "],");
else
AppendTo(f, "lns[", o[i]-Size(pts)-1, "],");
fi;
od;
AppendTo(f,"],",0,")\n");
AppendTo(f,"weightedsumleq([", 1-Size(o));
for i in [2..Size(o)] do
AppendTo(f,",1");
od;
AppendTo(f,"],[");
for i in [1..Size(o)] do
if o[i] <= Size(pts) then
AppendTo(f, "pts[", o[i]-1, "],");
else
AppendTo(f, "lns[", o[i]-Size(pts)-1, "],");
fi;
od;
AppendTo(f,"],",0,")\n");
od;
# Now we include the starter set
for i in starter do
if i <= Size(pts) then
AppendTo(f, "eq(pts[", i-1, "],1)\n");
else
AppendTo(f, "eq(lns[", i-Size(pts)-1, "],1)\n");
fi;
od;
AppendTo(f,"**EOF**\n");
return;
end;
ReadResults := function( filename )
# Reading results in and making them GAP read-able.
# We read two lines at a time. It returns
# a list of lists, each solution is an index set for
# a list of points cat a list of lines.
local input, solutions, l, l2, pos;
solutions := [];;
input := InputTextFile(filename);
repeat
if not IsEndOfStream(input) then
l := ReadLine(input);
if l <> fail then
l := EvalString(Concatenation("[",l,"]"));
if not IsEndOfStream(input) then
l2 := ReadLine(input);
l2 := EvalString(Concatenation("[",l2,"]"));
l := Concatenation(l,l2);
pos := Filtered([1..Size(all)], i -> l[i] = 1);;
Add(solutions, pos);;
fi;
fi;
fi;
until IsEndOfStream(input);
CloseStream(input);
return solutions;
end;
ClassifyqRegularSubgraphsWithStarterSets := function(pts, lns, aut, orbits, starters)
# Here we take each starter set and use minion to find all
# q-regular subgraphs containing the starter set. We
# also sort out isomorphism at the end using nauty/GRAPE.
local r, solutions, newsolutions, grs, iso;
solutions := [];;
for r in starters do
MakeMinionFile(pts, lns, "miniontemp.min", orbits, r);
Exec("minion-1.8/bin/minion miniontemp.min -findallsols -printsolsonly > miniontemp.out");
Exec("sed -i -e 's/ /,/g' miniontemp.out");
# Reading results in and making them GAP read-able.
newsolutions := ReadResults( "miniontemp.out" );
Print(" ... ", Size(newsolutions), " solution(s)\n");
Append(solutions, newsolutions);;
od;
# Isomorphism (using nauty/GRAPE functions)
solutions := Filtered(solutions, t -> not IsEmpty(t));;
Print("Now sorting out isomorphism ... \n");
grs := List(solutions, y -> rec(graph:=incgraph,
colourClasses:=[y, Difference([1..Size(all)],y)]));;
iso := GraphIsomorphismClassRepresentatives(grs);;
return iso;
end;
GiveMe8Cycle := function( all )
# Gives an 8-cycle in the incidence graph of the GQ
# Important: we are using the fact that a Moufang GQ
# has one 8-cycle up to automorphism.
local v1, v5, v4, v6, apartment1, apartment2, i;
v1 := 1;
v5 := First([1..Size(pts)], t -> DistanceBetweenElements(all[v1], pts[t]) = 4);
v4 := First([1..Size(all)], u -> DistanceBetweenElements(all[v8],all[u]) = 1);
v6 := First([1..Size(all)], u -> DistanceBetweenElements(all[v8],all[u]) = 1 and u<>v4);
apartment1 :=[v1, v4, v5];
apartment2 :=[v1, v5, v6];
for i in [1,2] do
Add(apartment1, First([1..Size(all)], j -> DistanceBetweenElements(all[v1], all[j]) = i
and DistanceBetweenElements(all[v4], all[j]) = 3-i ));
Add(apartment2, First([1..Size(all)], j -> DistanceBetweenElements(all[v1], all[j]) = i
and DistanceBetweenElements(all[v6], all[j]) = 3-i ));
od;
return Union(apartment1, apartment2);
end;
PrintOutSolutions := function(solutions)
local y, set, perm;
# Print out solutions according to the tables in the paper
for y in solutions do
set := y!.colourClasses[1];
perm := y!.autGroup;;
Print(Size(set), " ", Size(perm), " ",
Collected(OrbitLengths(perm,set)), " ",
Collected(OrbitLengths(perm,Difference([1..Size(pts)],set))), "\n");
od;
return;
end;
q := 3;; # this line can be changed for the other cases q=4,5,7
gq := SymplecticSpace(3,q);;
pts := AsList(Points(gq));;
lns := AsList(Lines(gq));;
all := Concatenation(pts, lns);;
incgraph := IncidenceGraph(gq);;
aut := AutomorphismGroup(incgraph);
# by default, aut acts on Concatenation(pts, lns)
####################################################################
# q < 7
# For q < 7, we want to find all q-regular subgraphs, so
# we fix an 8-cycle and enumerate all q-regular subgraphs
# containing it.
####################################################################
# Find 8-cycle
cycle := GiveMe8Cycle(all);
solutions := ClassifyqRegularSubgraphsWithStarterSets(pts, lns, aut, [], [cycle]);;
PrintOutSolutions(solutions);
####################################################################
# For q = 7, we go through all automorphisms of prime order
# (up to conjugacy)
####################################################################
ccs := ConjugacyClasses(aut);;
ccreps := List(ccs, Representative);;
primeorder := Filtered(ccreps, t -> IsPrime(Order(t)));;
Sort(primeorder, function(i,j) return Order(i) > Order(j); end);
solutions := [];;
for x in primeorder do
Print("Classifying 1-good structures invariant under an element of order ",
Order(x), "\n");
s := Subgroup(aut, [x]);
orbits := Orbits(s, [1..Size(all)]);
# take orbit representatives of the normaliser of s on its orbits
n := Normalizer(aut, s);
orbsn := Orbits(n, List(orbits,AsSet), OnSets);;
starters := List(orbsn, Minimum);
Print("Normaliser has ", Size(starters), " orbits on orbits of subgroup\n");
newsolutions := ClassifyqRegularSubgraphsWithStarterSets(pts, lns, aut, [], starters);;
Print(" ... ", Size(newsolutions), " solution(s)\n");
Append(solutions, newsolutions);
od;
# Extra isomorph rejection employed at the end here
solutions := Filtered(solutions, t -> not IsEmpty(t));;
grs := List(solutions, y -> rec(graph:=incgraph,
colourClasses:=[y, Difference([1..Size(all)],y)]));;
iso := GraphIsomorphismClassRepresentatives(grs);;
PrintOutSolutions(solutions);