maximal_block_stabilizer_class_reps.g

# Return a representative of each conjugacy class of maximal subgroups of a
# permutation group that stabilize a block or point. These are the maximal
# subgroups whose orbit parition is a strict refinement of the whole groups
# orbit partition.
#
# The result is a list of pairs containing the representative subgroup and the
# block or point for which it is the stabilizer. A point is returned as a block
# of size 1.
MaximalBlockStabilizerClassReps := function ( G )
    local i, pt, pt2, orb, lorb, on_lorb, l2g, block_reps, block_rep,
        block_system, partition, part, partitions, candidate_blocks,
        candidate_rep, candidate_reps, candidate_rep_orbits, pending_reps,
        maximal, on_blocks, stab, stab_moved, candidate_stab_index;

    # Below whenever a block is mentioned, we also consider "blocks" consisting
    # of a single point.

    # In candidate_blocks we collect all blocks that we will consider
    # stabilizing to find a maximal subgroup among those stabilizing a block.
    # This list must be closed under the action of G.
    #
    # We initialize it with all points of G, so we can easily recover a
    # subgroup of G from a subgroup of the action of G on these blocks.
    candidate_blocks := List([1..LargestMovedPoint(G)], pt -> [pt]);

    # For each candidate block, at the position of a representative element in
    # candidate_blocks, we store the size of its orbit/the index of the
    # corresponding stabilizer subgroup.
    candidate_stab_index := [];

    # This stores the position of the representative elements of each orbit in
    # candidate_blocks.
    candidate_reps := [];

    # For each orbit we compute the maximal blocks, the stabilizers of these
    # blocks are our candidate subgroups.

    # Using AllBlocks and then filtering the result is probably not the most
    # efficient way to get all maximal blocks, but for every example I've run
    # into AllBlocks is fast enough.
    for orb in Orbits(G) do
        # AllBlocks only works on transitive groups, so we work with the action
        # of G restricted to the current orbit.
        lorb :=  [1 .. Size(orb)];
        on_lorb := Action(G, orb);
        l2g := MappingPermListList(lorb, orb); # maps points back to all of G
        block_reps := List(AllBlocks(on_lorb));

        # If the action of G on orb is primitive, add a point stabilizer to the
        # candidates.
        if block_reps = [] then
            Add(candidate_reps, orb[1]);
            candidate_stab_index[orb[1]] := Size(orb);
            continue;
        fi;

        # Otherwise process blocks in decreasing size, so maximal blocks come
        # before blocks contained in them.
        SortBy(block_reps, block_rep -> -Size(block_rep));

        # We store the block systems we already processed as a list mapping
        # points to the orbit position of the block they are contained in. This
        # allows us to very quickly check whether a candidate block is fully
        # contained in a block system we already saw.
        partitions := [];

        for block_rep in block_reps do
            # If the representative block is contained in a block of another
            # block system it is not maximal, so skip it.
            for partition in partitions do
                part := partition{block_rep};
                if PositionProperty(part, p -> p <> part[1], 1) = fail then
                    block_rep := [];
                    break;
                fi;
            od;
            if block_rep = [] then
                continue;
            fi;

            # Here we know the block is maximal, so we add it to partition,
            # candidate_blocks, etc.
            block_system := Orbit(on_lorb, block_rep, OnSets);
            partition := [];
            for i in [1..Size(block_system)] do
                for pt in block_system[i] do
                    partition[pt] := i;
                od;
            od;
            candidate_rep := Size(candidate_blocks) + 1;
            Add(partitions, partition);
            Add(candidate_reps, candidate_rep);
            candidate_stab_index[candidate_rep] := Size(block_system);
            Append(candidate_blocks, OnSetsSets(block_system, l2g));
        od;
    od;

    # Every maximal subgroup that stabilizes a block must stabilize a maximal
    # block, but the converse is not necesserily true, so we have to filter our
    # candidates.

    # For that we extend the domain of G to include our candidate blocks
    on_blocks := Action(G, candidate_blocks, OnSets);

    # And we process the candidates by increasing index, so we get maximal
    # groups before any contained groups.
    SortBy(candidate_reps, rep -> candidate_stab_index[rep]);

    # During the filtering we might learn that a not-yet-processed group is
    # either not maximal or in the same conjugacy class as a group coming
    # before it. We exclude them by removing the point representing the
    # candidate block from pending_reps. We also remove already processed
    # blocks from pending_reps.
    pending_reps := Set(candidate_reps);
    maximal := [];

    for pt in candidate_reps do
        if not pt in pending_reps then
            continue;
        fi;
        # If the candidate hasn't been excluded yet, its stabilizer is a
        # maximal subgroup among the candidates.
        RemoveSet(pending_reps, pt);
        stab := Stabilizer(on_blocks, pt);
        stab_moved := MovedPoints(stab);
        # If stabilizing the current candidate block (stab) also stabilizes a
        # block of the orbit of later candidate, the stabilizer of that later
        # candidate is conjugate to a subgroup of/to stab, so we can exclude
        # it.
        for pt2 in Set(pending_reps) do
            if not ForAll(Orbit(G, pt2), p -> p in stab_moved) then
                RemoveSet(pending_reps, pt2);
            fi;
        od;

        Add(maximal, [
            Action(stab, [1..LargestMovedPoint(G)]),
            candidate_blocks[pt]
        ]);
    od;

    return maximal;
end;


Example := function ()
    local G, U, Gs, dom, blocks;

    dom := ListX([1..24], [1,2], {x, y} -> [x, y]);

    G := Group(Concatenation([
        GeneratorsOfGroup(
            Action(TransitiveGroup(24, 11), dom, {x, g} -> [x[1]^g, x[2]])),
        GeneratorsOfGroup(
            Action(SymmetricGroup(2), dom, {x, g} -> [x[1], x[2]^g]))
    ]));

    Gs := Concatenation([[G], MaximalSubgroupClassReps(G)]);

    for G in Gs do
        Display("\n===========");
        Display(G);
        Display(Set(Orbits(G), Set));
        for U in MaximalBlockStabilizerClassReps(G) do
            Display("\n---------");
            Display(U[2]);
            Display(U[1]);
            Display(Set(Orbits(U[1]), Set));
        od;
    od;
end;