#Program Permutation Reps is a series of functions that take a group and generate the (minimum number of) permutation representations of the group that contain the irriducibles

if
	not(LoadPackage("atlasrep"))
then
	LoadPackage("atlasrep");
fi;

if
	not(LoadPackage("chop"))
then
	LoadPackage("chop");
fi;


###################################################################################################
#Function ColumnSorter converts a certain number of columns and the colunmns of a matrix into numbers (0 or 1) to be sorted (using a bubble sort routine)
#F ColumnSorter( <num>, [<mat>] )
###################################################################################################

ColumnSorter:=function(lcolumns,rows)
local columns, lrows, colsort, row, m, n, p, i, j;

lrows:=Length(rows);
colsort:=[];
row:=[];

for m in [1..lcolumns] do

	colsort[m]:=0;
	row[m]:=0;

	for n in [1..lrows] do

		if
			not(rows[n][m]=0)
		then
			colsort[m]:=colsort[m]+10^(n-1);
			row[m]:=n;
		fi;
	od;

od;

SortParallel(colsort,row);
SortParallel(colsort,row);

return[colsort,row];

end;


###################################################################################################
#Function WhichPerms(g,prime) takes as an input g a finite group and prime, the characteristic of a finite field. Returns the minimum number of permutation characters that contain all of the irriducibles.
###################################################################################################
WhichPerms:=function(g,prime)

local modtbl, tbl, tom, chars, res, irr, dec, lirr, ldec, sorted, i, j, whichpermchars, permchars, next, locator, check, missingirr, llocator;

modtbl:=CharacterTable(Concatenation(g,"mod",String(prime)));
tbl:=CharacterTable(g);
tom:=TableOfMarks(g);
chars:=PermCharsTom(tbl,tom);
res:=RestrictedClassFunctions(tbl,chars,modtbl);
irr:=Irr(modtbl);
lirr:=Length(irr);
dec:=Decomposition(irr,res,5);
ldec:=Length(dec);

#Convert columns to numbers to sort permutation characters by irreducibles contained
sorted:=ColumnSorter(lirr,dec);

#Pick off the permutation characters with smallest dimension that contain all the irreducibles. Begin with largest dimension necessary
whichpermchars:=[];
whichpermchars[1]:=dec[sorted[2][1]];
next:=1;
permchars:=[];
permchars[next]:=[chars[sorted[2][1]],sorted[2][1]];

repeat
	missingirr:=[];
	locator:=[];

	#First find the missing irreducibles in the highest dimension permutation character needed note that i is the column in dec NOT colsort
	for i in [1..lirr] do
		check:=0;

		for j in [1..next] do

		if
			not(whichpermchars[j][i]=0)
		then
			check:=check+1;
		fi;

	od;

		if
			check=0
		then
			Append(locator,[i]);
		fi;
		
	od;
llocator:=Length(locator);

	if
		not(llocator=0)
	then
		next:=next+1;

		for i in [1..ldec] do
			missingirr[i]:=[];

			for j in [1..llocator] do

				missingirr[i][j]:=dec[i][locator[j]];

			od;

		od;

		whichpermchars[next]:=dec[ColumnSorter(llocator,missingirr)[2][1]];
		permchars[next]:=[chars[ColumnSorter(llocator,missingirr)[2][1]],ColumnSorter(llocator,missingirr)[2][1]];
	fi;

until llocator=0;

return(permchars);

end;


###################################################################################################
#Functon ImprimPerm is a subroutine of ImprimPermMult
#F ImprimPerm( <grp>, <grp>, [<elm>], [<list>] )
###################################################################################################

ImprimPerm:=function( g, u1, list, start )

local t1, newlist, i, j, cosetrep, imcoset, imcosetrep, rtpermuted, difference, pos, imcoset2, index1;

newlist:=[];
t1:=RightTransversal(g,u1);
index1:=Length(t1);
rtpermuted:=[];
start:=(start-1)*index1;

for i in [1..Length(list)] do

	rtpermuted[i]:=[];
    newlist[i]:=[];
        
	for j in [1..Length(t1)] do

        cosetrep:=t1[j];
        imcoset:=cosetrep*list[i];
        pos:=PositionCanonical(t1,imcoset);
        Add(rtpermuted[i], start[i]+pos);
	    imcosetrep:=t1[pos];
        difference:=imcoset*imcosetrep^-1;
        Add(newlist[i], difference);

   	od;     

od;

return [rtpermuted, newlist];

end ;


###################################################################################################
#Function ImprimPermMult takes a descending chain of subgroups of a group $G$ and a list of elements from $G$ and returns how those elements permute the coset reperesentatives of $G$ modulo a subgroup at each step in the chain. 
#F ImprimPermMult( [<grp>], [<elm>] )
###################################################################################################

ImprimPermMult:=function( grplist, elmlist )

local indexin, indexnext, elemin, indexlist, list2, list3, u1, u2, r, i, j, k, action, start;
	
indexin:=Length(grplist);
indexnext:=Length(elmlist);	
elemin:=indexnext;	
action:=[];	
list3:=[];
start:=[];
action:=[];
action[1]:=[];

for k in [1..Length(RightTransversal(grplist[1],grplist[2]))] do

	start[k]:=1;

od;

r:=ImprimPerm(grplist[1],grplist[2], elmlist, start);

for k in [1..elemin] do
	
	action[1][k]:=PermList(r[1][k]);

od;

start:=r[1];
elmlist:=r[2];

for i in [2..indexin-1] do

	indexnext:=Length(elmlist);
	u1:=grplist[i];
	u2:=grplist[i+1];
	action[i]:=[];
	list3:=[];

	for j in [1..indexnext] do

		list2:=elmlist[j];
		indexlist:=Length(list2);
		r:=ImprimPerm(u1,u2,list2,start[j]);
		Add(action[i], PermList(Flat(r[1])));
		start[j]:=Flat(r[1]);
		list3[j]:=Flat(r[2]);

	od;

	elmlist:=list3;

od;

return action;

end ;


###################################################################################################
#Function PermReps( <grp>, <prime> ) takes a group from the Atlas Database and a prime and returns the (minimum number of) permutation representations containing the irriducibles
###################################################################################################

PermReps:=function(g, prime)

local tom, permchars, lpermchars, i, groupgens, group, bottomofchain, descendingchains, index, perms, lperms, permsmat, matrixreps, permscmat, permsmodule, permreps;

permchars:=WhichPerms(g,prime);
lpermchars:=Length(permchars);
bottomofchain:=[];
tom:=TableOfMarks(g);
group:=UnderlyingGroup(tom);
groupgens:=GeneratorsOfGroup(group);
index:=[];

for i in [1..lpermchars] do

	bottomofchain[i]:=RepresentativeTom(tom,permchars[i][2]);
	index[i]:=Size(group)/Size(bottomofchain[i]);

od;



#Create Descending chains
descendingchains:=[];

for i in [1..lpermchars] do

	descendingchains[i]:=Reversed(AscendingChain(group,bottomofchain[i]));

od;

#Compute permutations
perms:=[];

for i in [1..lpermchars] do

	Add(perms,Reversed(ImprimPermMult(descendingchains[i],groupgens))[1]);

od;

lperms:=Length(perms);
permsmat:=[];

for i in [1..lperms] do

	permsmat[i]:=List(perms[i],x->PermutationMat(x,index[i],GF(2)));

od;

for i in [1..lperms] do

	List(permsmat[i],x->ConvertToMatrixRep(x));

od;

permscmat:=[];

for i in [1..lperms] do

	permscmat[i]:=List(permsmat[i],x->CMat(x));

od;

permsmodule:=[];

for i in [1..lperms] do

	permsmodule[i]:=Module(permscmat[i]);

od;

permreps:=Chop(permsmodule[1]);

for i in [2..lpermchars] do

	Chop(permsmodule[i],rec(db:=permreps.db));

od;



return permreps.db;

end;