make this a gap package.

2 files changed, 158 insertions, 0 deletions

diff --git a/gap/subgroupladders.gd b/gap/subgroupladders.gd
new file mode 100644
index 0000000..0ba67e9
--- /dev/null
+++ b/gap/subgroupladders.gd
@@ -0,0 +1,26 @@
+#
+# subgroupladders: This package provides an algorithm that computes a subgroup ladder from a permutation group up to the parent symmetric group.
+#
+# Declarations
+#
+
+#! @Description
+#! Given a list of lists <A>part</A> of positive integers, this will compute 
+#! the Young #! subgroup corresponding to this partition.
+#! @Returns a group
+#! @Arguments part
+DeclareGlobalFunction( "YoungGroupFromPartition" );
+#! @Description
+#! Given a permutation group <A>G</A>, this will compute a subgroup ladder
+#! from <A>G</A> up to the parent symmetric group.
+#! A subgroup ladder is series of subgroups <M>G = H_0,…,H_k = S_n</M> of the 
+#! symmetric group such that for every <M>1 \leq i \leq k</M>, <M>H_i</M> is a 
+#! subgroup of <M>H_{{i-1}}</M> or <M>H_{{i-1}}</M> is a subgroup of <M>H_i</M>.
+#! If <A>G</A> is a Young subgroup of <M>S_n</M>, we can guarantee that all 
+#! the indices are at most the degree <M>n</M> of the permutation group. 
+#! Otherwise, we will at first embed <A>G</A> into the Young subgroup 
+#! corresponding to the orbits of <A>G</A>. 
+#! At this step, the index may be larger than the degree.
+#! @Returns a list of groups
+#! @Arguments G
+DeclareGlobalFunction( "SubgroupLadder");
diff --git a/gap/subgroupladders.gi b/gap/subgroupladders.gi
new file mode 100644
index 0000000..aba383a
--- /dev/null
+++ b/gap/subgroupladders.gi
@@ -0,0 +1,132 @@
+#
+# subgroupladders: This package provides an algorithm that computes a subgroup ladder from a permutation group up to the parent symmetric group.
+#
+# Implementations
+#
+
+
+InstallGlobalFunction( YoungGroupFromPartition,
+function(part)
+	local
+		i,
+		P,
+		G,
+		grps,
+		olds,
+		news,
+		perms,
+		info,
+		generators;
+
+	grps := [];
+	olds := [];
+	news := [];
+	perms := [];
+	generators := [];
+
+	for i in part do
+		G := SymmetricGroup(i);
+		Append(generators, GeneratorsOfGroup(G));
+		Add(grps, G);
+		Add(olds, i);
+		Add(news, i);
+		Add(perms, ());
+	od;
+
+	P := Group(generators);
+	info := rec( groups := grps,
+	             olds := olds,
+	             news := news,
+	             perms := perms,
+	             embeddings := [],
+	             projections := [] );
+	SetDirectProductInfo(P, info);
+
+	return P;
+end);
+
+
+InstallGlobalFunction( SubgroupLadder,
+function(G)
+	local
+		orb,
+		i,
+		k,
+		n,
+		pair,
+		ladder,
+		directfactors,
+		generators,
+		mapping,
+		output,
+		partition,
+		FindPos;
+
+	FindPos := function(list, x)
+		local n, i;
+		n := Length(list);
+		for i in [1..n] do
+			if x in list[i] then
+				return i;
+			fi;
+		od;
+	end;
+
+	if (not IsPermGroup(G)) then
+		ErrorNoReturn("the argument must be a permutation group!\n");
+	fi;
+
+	n := LargestMovedPoint(G);
+
+	orb := List(Orbits(G, [1..n]));
+	SortBy(orb, x->-Length(x));
+
+	output := [];
+
+	if (YoungGroupFromPartition(orb) <> G) then
+		output := [G];
+	fi;
+
+	partition := List(orb, Length);
+	mapping := List([1..n], x -> FindPos(orb, x));
+	ladder := [[List(partition), List(mapping)]];
+
+	while (Length(partition) <> 1 or partition[1] < n) do
+		if (Length(partition) = 1 and partition[1] < n) then
+			mapping[Position(mapping, 0)] := 1;
+			partition[1] := partition[1] + 1;
+			Add(ladder, [List(partition), List(mapping)]);
+		else
+			if (partition[2] = 1) then
+				Remove(partition, 2);
+				for i in [1..n] do
+					if (mapping[i]) > 1 then
+						mapping[i] := mapping[i] - 1;
+					fi;
+				od;
+				partition[1] := partition[1] + 1;
+				Add(ladder, [List(partition), List(mapping)]);
+			else
+				mapping[Position(mapping, 2)] := Length(partition)+1;
+				partition[2] := partition[2] - 1;
+				Add(partition, 1);
+				Add(ladder, [List(partition), List(mapping)]);
+
+				mapping[Position(mapping, Length(partition))] := 1;
+				Remove(partition);
+				partition[1] := partition[1] + 1;
+				Add(ladder, [List(partition), List(mapping)]);
+			fi;
+		fi;
+	od;
+
+	for pair in ladder do
+		k := Length(pair[1]);
+		mapping := pair[2];
+		Add(output, YoungGroupFromPartition(List([1..k], i -> Filtered([1..n], x -> i = mapping[x]))));
+	od;
+
+	return output;
+end);
+
+# vim: set noet ts=4: