jix · October 27, 2020 21:12
diff --git a/maximal_block_stabilizer_class_reps.g b/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;
	# 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;