#group21_v5.mpl
#
#              This file contains some simple procedures
#               to help work with finite permutation groups
#              in MAPLE: 
#               1. listing all the elements as disjoint cycles,
#               2. finding all elements of a given order,
#               3. finding the group table of a permgroup,
#               4. elements conjugate to a given element,
#               5. all conjugacy classes of a permutation group,
#               6. the value (i)p of a permutation as a function
#                        p:{1,2,...,n}->{1,2,...,n}
#                  on a element i where p acts on the right,
#               7. the sign of the permutation,
#               8. the "swapping number" of a permutation,
#               9. the permutation matrix associated to a permutation
#                  in disjoint cycle notation,
#              10. the left *and* right permutation action of a 
#                  permutation (in disjoint cycle notation) on a 
#                  vector (in list notation); there are two routines,
#                  one for the left action, one for the right action,
#              11. multiply a list of elements of a permgroup,
#                  written in disjoint cycle notation,
#              12. New additions (such as induce and right_coset_reps, 
#                  list_to_array, list_to_disjcyc, ... see below).
#
#
#wdj, 11-97, 11-99
########################################################

gp_elements:=proc(n::integer,L::set)
 #L is a set of permutations of [1..n]
 #returns the elements of the group of degree
 #n generated by the elements of L
 local i,j,G,L0,L1,g;
 L0:=combinat[permute](n);
 L1:=[];
 for i from 1 to nops(L0) do
  g[i]:=convert(L0[i],'disjcyc');
 od;
 G:=permgroup(n,L);
 for i from 1 to nops(L0) do
   if groupmember(g[i],G) then
   L1:=[op(L1),g[i]];
   fi;
 od;
 RETURN(L1);
end:

conjugation:=proc(a::list,b::list)
 #conjugates a by b in S_n 
 local p;
 p:=mult_list([group[invperm](b),a,b]);
 RETURN(p);
end:

conjugacy_class:=proc(g::list,n::integer,L::set)
#
#g is an element of permgroup(n,L)
#written in disjoint cycle notation
#
 local i,h,L0,L1;
 L0:=gp_elements(n,L);
 L1:={g};
 for i from 1 to nops(L0) do
  h:=invperm(L0[i]);
  h:=mulperms(h,g);
  h:=mulperms(h,L0[i]);
  if member(h,L0) then L1:={op(L1),h}; fi;
 od;
 RETURN(L1);
end:

conjugacy_classes:=proc(n::integer,L::set)
#finds all conjugacy classes of permgroup(n,L)
local i,L0,L1,A;
 L0:=gp_elements(n,L);
 L1:={{[]}};
 for i from 2 to nops(L0) do
  A:=conjugacy_class(L0[i],n,L);#print(A,L1);
  if not(member(A,L1)) then 
        L1:={op(L1),conjugacy_class(L0[i],n,L)};
  fi;
 od;
RETURN(L1);
end:

conjugacy_classes_reps:=proc(n::integer,L::set)
#finds a complete set of representatives of
#all the conjugacy classes of permgroup(n,L)
local C,i,R;
 C:=conjugacy_classes(n,L);
 R:={};
 for i from 1 to nops(C) do
  R:={op(R),op(1,C[i])};
 od;
RETURN(R);
end:

gp_table:=proc(n::integer,L::set)
 local i,j,L0,S_table;
 L0:=gp_elements(n,L);
 S_table:=array(1..nops(L0),1..nops(L0));
 for i from 1 to nops(L0) do
  for j from 1 to nops(L0) do
   S_table[i,j]:=group[mulperms](L0[i],L0[j]):
  od;
 od;
 convert(S_table, matrix);
end:

abs_gp_table:=proc(n::integer,L::set)
 local i,j,L0,S_table,g,k,a;
 L0:=gp_elements(n,L);
 S_table:=array(1..(nops(L0)+1),1..(nops(L0)+1));
 for i from 1 to nops(L0) do
  for j from 1 to nops(L0) do
   for k from 1 to nops(L0) do
    if L0[k]=group[mulperms](L0[i],L0[j]) then
      S_table[i+1,j+1]:=a[k];
    fi; 
   od;
  od;
 od;
 S_table[1,1]:=`*`;
 for j from 1 to nops(L0) do
  S_table[1,j+1]:=a[j];
  S_table[j+1,1]:=a[j];
 od;
 print(convert(S_table, matrix));
 print(seq(a[i]=L0[i],i=1..nops(L0)));
end:

mulperm_power:=proc(g::list,k::integer)
 #g is a disjoint cycle
 local h,i;
 h:=[];
 for i from 1 to k do
  h:=group[mulperms](h,g);
 od;
 RETURN(h);
end:

elements_order:=proc(n::integer,L::set,k::integer)
 #finds the elements in permgroup(n,L) of order k
 local L1,count,L0,i;
 count:=0;
 L1:=[];
 L0:=gp_elements(n,L);
 for i from 1 to nops(L0) do
  if mulperm_power(L0[i],k)=[] then
    L1:=[op(L1),L0[i]];
    count:=count+1;
  fi:
 od:
 RETURN([count,L1]);
end:

swap:=proc(A::list,N::integer)
##
## A is a permutation in the symmetric gp S_N
##  written in MAPLE's disjoint cycle notation
## RETURNs the swapping nyumber of A in S_N
##
local i1,i2,j1,j2,temp;
temp:=0;
for i1 from 1 to N-1 do
 j1:=perm_value(A,i1);
 for i2 from i1+1 to N do
 j2:=perm_value(A,i2);
 if j1>j2 then temp:=temp+1; fi;
 od;
od;
RETURN(temp);
end:

perm_value_cyclic:=proc(A::list,i0::integer)
##
## A is a cyclic permutation in MAPLE notation
##
local j,k,n;
n:=nops(op(1,A));
for j from 1 to n-1 do
 if i0=op(j,op(1,A)) then
   RETURN(op(j+1,op(1,A))); 
 fi;
od;
if i0=op(n,op(1,A)) then RETURN(op(1,op(1,A))); fi;
RETURN(i0);
end:

perm_value:=proc(A::list,i0::integer)
##
## A is a permutation in MAPLE's disjoint cycle notation
##
local j,n,temp;
n:=nops(A);
temp:=i0;
if n=1 then RETURN(perm_value_cyclic(A,i0)); fi;
for j from 1 to n do
 temp:=perm_value_cyclic([op(j,A)],temp);
od;
RETURN(temp);
end:

permcol_matrix:=proc(A::array,L::list)
 #return the matrix A with columns permuted
 #by L in Symm(coldim(A))
 local i,j,B,r,N,L0;
 N:=linalg[coldim](A);
 L0:=group[invperm](L);
 for i from 1 to N do
  r[i]:=convert(col(A,perm_value(L0,i)),list);
 #print(i,i,N,N,L,L,perm_value(L0,i),r[i]);
 od;
 B:=matrix([seq(r[i],i=1..N)]);
 RETURN(linalg[transpose](B));
end:

perm_sign:=proc(A::list,N::integer)
##
## A is a permutation in S_N written in MAPLE's
## disjoint cycle notation
##
RETURN((-1)^(swap(A,N)));
end:

perm_matrix:=proc(L::list,nn::integer)
 # L is a cycle in disjoint cycle notation
 # nn is arbitray - if omitted then the order
 # of the matrix is the max of L
 local i,j,n1,A,A0,ll,maxlist,n,m,L0;
 m:=nops(L);
 if nargs=1 then 
  L0:=[];
  for j from 1 to m do 
   L0:=[op(L0),op(L[j])]; 
  od;
  n:=max(op(L0));
 else n:=nn;
 fi;
 if nargs=1 and min(op(L0))<=0 then ERROR(`L must contain positive entries`); fi;
 for ll from 1 to nops(L) do
 n1:=nops(L[ll]);
 maxlist:=max(op(L[ll]));
 for i from 1 to n do
  for j from 1 to n do 
  if j = perm_value(L,i) then A[i,j]:=1; 
   else A[i,j]:=0;
  fi;
 od;
 od;
 od;
 A0:=linalg[matrix]([seq([seq(A[i,j],j=1..n)],i=1..n)]);
 RETURN(evalm(A0));
end:

permute_vector_left:=proc(L::list,v::list)
 local i,v0;
 for i from 1 to nops(v) do
  v0[i]:=v[perm_value(group[invperm](L),i)];
 od;
 v0:=[seq(v0[i],i=1..(nops(v)))];
 RETURN(v0);
end:

permute_vector_right:=proc(L::list,v::list)
 local i,v0;
 for i from 1 to nops(v) do
  v0[i]:=v[perm_value(L,i)];
 od;
 v0:=[seq(v0[i],i=1..(nops(v)))];
 RETURN(v0);
end:

mult_list:=proc(L::list)
 local x,y;
 y:=[];
if nops(L)=1 then RETURN(L); fi:
 for x in L do
  y:=mulperms(y,x);
 od;
 RETURN(y);
end:

mult_sets:=proc(L1::set,L2::set)
#multiplies two sets of group elements together
 local x,y,S;
 S:={};
 for x in L1 do
  for y in L2 do
   S:={op(S),mulperms(x,y)};
  od; 
 od;
 RETURN(S);
end:

is_subset:=proc(S1::set,S2::set)
local x;
for x in S1 do
 if not(member(x,S2)) then RETURN(`false`); fi;
od;
RETURN(`true`);
end:

is_sublist:=proc(S1::list,S2::list)
local x;
for x in S1 do
 if not(member(x,S2)) then RETURN(`false`); fi;
od;
RETURN(`true`);
end:

left_coset_reps:=proc(G::function,H::function)
RETURN(cosets(G,H));
end:

right_coset_reps:=proc(G::function,H::function)
#replaces cosets, which gives left coset reps
local S,T,U,C,x;
S:=gp_elements(op(1,G),op(2,G));
T:=convert(gp_elements(op(1,H),op(2,H)),set);
U:=T;
C:={[]};
for x in S do
 if not(is_subset(mult_sets({x},T),U)) then
  U:=`union`(U,mult_sets({x},T));
  C:={op(C),x};
#print(`C,U,x = `,C,U,x);
 fi;
od;
RETURN(C);
end:

#I don't know where the following came from.
#May have copied it from a book.
stabilizer:=proc(n::integer,pg,deg::integer)
 #n is the point in [1,...,deg] to be
 #stabilized, pg is the permgroup of degree
 #deg (ie, pg<Symm(deg))
 #which the group returned will be a
 #subgroup of
 local g,L,G,GG,I_deg,S_deg;
 L:=[];
 I_deg:=permgroup(deg,{[]});
 S_deg:=right_coset_reps(pg,I_deg);
 for g in S1 do 
   G:=permgroup(deg,{g});
   if nops(orbit(G,n))=1 then L:=[op(L),g];
   fi;
 od;
 GG:=permgroup(deg,convert(L,set));
 RETURN(GG);
end:

cartesian_product:=proc(L1::list,L2::list)
 local i,j,L3;
 L3:=[];
  for i in L1 do
   for j in L2 do
    L3:=[op(L3),[i,j]];
   od;
  od;
 RETURN(L3);
end:

cartesian_power:=proc(L::list,n::integer)
 local i,j,k,L0,L1;
 if n=0 then RETURN([]); fi;
 if n=1 then RETURN(L); fi;
 if n<0 then ERROR(`must have `,n,` >0`); fi;
 L0:=cartesian_product(L,L);
 if n=2 then RETURN(L0); fi;
 for k from 3 to n do
 L1:=[];
 for i in L0 do
   for j in L do
    L1:=[op(L1),[op(i),j]];
   od;
 od;
 L0:=L1;
 od;
 RETURN(L1);
end:

mu:=proc(ell::integer,ii::list,ee::list)
 local j,z,n;
 n:=nops(ii);
 z:=exp(2*Pi*I/ell);
 RETURN(expand(product(z^(op(j,ee)*op(j,ii)),j=1..n)));
end:

#sum_mu:=proc(ell::integer,mutype::list,g::list,w::list,p::list)
#ell is the order of mu
#mutype is the type of mu
#(w,g) is an element of the wreath product
#p is the permutation summed over in induce_mu
# local v,L,summ,n,invp,i;
# n:=nops(mutype);
# summ:=0;
# invp:=invperm(p);
# L:=cartesian_power([seq(i,i=0..ell-1)],n);
# for v in L do
#    summ:=summ+mu(ell,v+permute_vector_left(p,w)-
#        permute_vector_left(mult_list([p,g,invp]),v),mutype);
# od;
# RETURN(summ);
#end:

induce3_mu:=proc(ell::integer,mutype::list,g::list,v::list)
 #ell is the order of mu
 #mutype is the vector of integers parameterizing mu
 #the elements of mutype must be distinct mod ell
 #(g,v) in S_3 wr C_ell is the element we evaluate on 
 local theta,p,s3;
 if g<>[] then RETURN(0); fi;
 s3:=gp_elements(3,{[[1,2]],[[1,2,3]]});
 theta:=add(mu(ell,permute_vector_left(p,v),mutype),p=s3):
# print(g,v,ell,mutype,theta);
RETURN(theta);
end:

induce3_signxmu:=proc(ell::integer,mutype::list,g::list,v::list)
 #ell is the order of mu
 #mutype is the vector of integers parameterizing mu
 #(g,v) in S_3 wr C_ell is the element we evaluate on 
 local theta,p,s3;
 s3:=gp_elements(3,{[[1,2]],[[1,2,3]]});
 theta:=add(perm_sign(g,3)*mu(ell,permute_vector_left(p,v),mutype),p=s3):
# print(g,v,ell,mutype,theta);
RETURN(theta);
end:

induce4_mu:=proc(ell::integer,mutype::list,g::list,v::list)
 #ell is the order of mu
 #mutype is the vector of integers parameterizing mu
 #the elements of mutype must be distinct mod ell
 #(g,v) in S_4 wr C_ell is the element we evaluate on 
 local theta,p,s4;
 if g<>[] then RETURN(0); fi;
 s4:=gp_elements(4,{[[1,2]],[[1,2,3,4]]});
 theta:=add(perm_sign(g,4)*mu(ell,permute_vector_left(p,v),mutype),p=s4):
# print(g,v,ell,mutype,theta);
RETURN(theta);
end:

conj_type:=proc(L::list,n::integer)
 #returns the partition of n associated to the
 #conjugacy class represented by L in S_n
 local t1,t2,t3,t4,s2,i,j;
 t1:=seq(nops(L[i]),i=1..nops(L));
 t2:=sort([t1]);
 s2:=add(j,j=t2);
 t3:=t2;
 if s2<n then t3:=[op(t2),seq(1,i=1..n-s2)]; fi;
t4:=[seq(t3[nops(t3)-i+1],i=1..nops(t3))];
RETURN(t4);
end:

conj_to_part:=proc(L::list,n::integer)
 #returns the partition of n associated to the
 #conjugacy class represented by L in S_n
 local t1,t2,t3,t4,s2,i,j;
 t1:=seq(nops(L[i]),i=1..nops(L));
 t2:=sort([t1]);
 s2:=add(j,j=t2);
 t3:=t2;
 if s2<n then t3:=[op(t2),seq(1,i=1..n-s2)]; fi;
t4:=[seq(t3[nops(t3)-i+1],i=1..nops(t3))];
RETURN(t4);
end:

part_to_conj:=proc(L::list,n::integer)
 #returns an element of S_n representing the
 #conjugacy class associated to the
 #partition of n given by L
 local g,i,j,s;
 for i from 1 to nops(L) do
  s[i]:=add(L[j],j=1..i);
#print(s[i]);
 od;
 s[0]:=0;
 g:=[seq([seq(i,i=s[j-1]+1..s[j])],j=1..nops(L))];
 RETURN(g);
end:

Symm:=proc(n::integer,degree::integer)
#returns the symmetric group S_n embedded as a
#subgroup of S_degree
 local i,S:
 if degree<n then ERROR(`arg2 must be > arg1`); fi;
 S:=permgroup(degree,{[[1,2]],[[seq(i,i=1..n)]]});
RETURN(S);
end:

induce_symm:=proc(n::integer,p::list,g::list)
 #returns the value of the character of the
 #repn induced from S_{n-1} to S_n by the 
 #irred char of S_{n-1} at g in S_n
 local x,a,b,C,C_new,G,H;
 G:=Symm(n,n); H:=Symm(n-1,n);
 C:=right_coset_reps(G,H);
 C_new:=[];
 for x in C do
 #print(x,conjugation(g,x));
  if group[groupmember](conjugation(g,x),H) then
   C_new:=[op(C_new),x]:
  fi:
 od:
 a:=add(Chi(p,conj_type(conjugation(g,x),n-1)),x=C_new);
 RETURN(a);
end:

#induce:=proc(G::function,H::function,chi::string,g::list) #in R4
induce:=proc(G::function,H::function,chi::symbol,g::list) #in R5
 #
 # H is a permsubgroup of G
 # chi is a function on H
 # g is an element of G
 #
local C,h,a,b,S,x,H0;
 if op(1,G)<>op(1,H) then ERROR(`G,H must have same degree`); fi;
 S:=right_coset_reps(G,H);
H0:=gp_elements(op(1,H),op(2,H));
#print(S);
 C:=[];
 for x in S do
  #print(x,conjugation(g,x));
   if member(conjugation(g,x),H0) then
    C:=[op(C),x]:
#print(x,conjugation(g,x));
   fi:
 od:
#print(C,`elements which conjugate g into H`);
 a:=add(chi(conjugation(g,x)),x=C);
#b:=0;
#for x in C do
# b:=b+chi(conjugation(g,x));
#print(x,conjugation(g,x),chi(conjugation(g,x)));
#od;
#print(a,b);
RETURN(a);
end:

#innerprod:=proc(G::function,f1::string,f2::string) # in R4
innerprod:=proc(G::function,f1::symbol,f2::symbol) #in R5
#
# computes the inner product of two functions on G
# uses group2, group
#
local S,N,x,inn;
S:=gp_elements(op(1,G),op(2,G));
N:=nops(S);
inn:=add(f1(x)*conjugate(f2(x)),x=S)/N;
RETURN(inn);
end:

#is_reducible:=proc(G::function,f::string) #in R4
is_reducible:=proc(G::function,f::symbol) #in R5
#
# checks if f has innerprod<>1
#
local inn;
inn:=innerprod(G,f,f);
if inn<>1 then 
  print(`If f is a character then it is reducible`);
fi;
if inn=1 then 
  print(`If f is a character then it is irreducible`);
fi;
end:

list_to_disjcyc:=proc(p::list)
# converts a permutation list (as outputted from
# combinat[permute](n); for example) to a disjoint cycle
# (as used in group2_v5.mpl or with(group);)
 local i,j,L,p1,L0,S1,a,n;
 n:=nops(p);
 p1:=[seq(i,i=1..n)];
 S1:=convert(p1,set);
 L0:=[];
 #print(n,p1,S1);
 for j from 1 to n do
 if member(j,S1) then
  L:=[j];
  a:=j;
  for i from 1 to n do
   a:=p[a];
   if a=j then break; fi;
   L:=[op(L),a];
  od;
 fi;
 if (not(member(L,L0)) and nops(L)>1) then L0:=[op(L0),L]; fi; 
 S1:=S1 minus convert(L,set);
 od;
 RETURN(group[invperm](L0));
end:

list_to_array:=proc(p::list)
# converts a permutation list (as outputted from
# combinat[permute](n); for example) to a n array
# (as used in introductory group theory texts)
 local i,j,A,p1,L0,S1,n;
 n:=nops(p);
 p1:=[seq(i,i=1..n)];
 A:=linalg[matrix]([p1,p]);
 RETURN(evalm(A));
end:

array_to_list:=proc(A)
 local i,j,p2,S1,n;
 n:=linalg[coldim](A);
 p2:=convert(linalg[row](A,2),list);
 RETURN(p2);
end:

array_to_disjcyc:=proc(A)
# converts an array to a disjoint cycle
# (as used in group2_v5.mpl or with(group);) 
local i,j,p2,S1,n;
 n:=linalg[coldim](A);
 p2:=convert(linalg[row](A,2),list);
 RETURN(list_to_disjcyc(p2));
end:

print(`   Basic group theory commands:   `);
print(`gp_elements, elements_order, conjugation, conjugacy_class, conjugacy_classes`);
print(`conjugacy_classes_reps, gp_table, abs_gp_table, mulperm_power, swap, permcol_matrix,`);
print(`perm_value, perm_sign, permute_vector_left, permute_vector_right, mult_list,`);
print(`mult_sets, is_subset, is_sublist, left_coset_reps, right_coset_reps, stabilizer,`);
print(`cartesian_product, cartesian_power, conj_type, conj_to_part, part_to_conj, induce,`);
print(`innerprod, is_reducible, array_to_disjcyc, list_to_disjcyc, array_to_list, `);
print(`list_to_array ... loaded. group21_v5.mpl MAPLEV5, last updated 12-99`);