# Find all "clones" of the i-th irrep of W(S): the set of all W(S)-reps # (irreducible or not) that have the same W(S0)-module structure. # If there are no clones, return the empty list. # If there *are* clones, then look for a set of conjugacy classes of # para-Coxeter type that are able to distinguish the traces of the i-th # irrep from those of its clones. The output is a list of the form # [[w1,t1],[w2,t2],...], where w1 is a para-Coxeter group element and t1 # is the trace of w1 on the i-th irrep. If para-Coxeter classes are unable # to distinguish the i-th irrep from its clones, an ERROR is generated. # Branch[0,n] is the list of all para-Coxeter classes that involve n, # sorted by length and indexed by position in the character table. clone_test:=proc(i,S0,S) local cl,cr,j,k,l,n,b,c,q; global Branch; cl:=NULL; n:=nops(S); b:=convert([seq(q^abs(k),k=get_branch(i,n,S0,S))],`+`); for j to nops(Rep[n]) do if i<>j and Rep[n][j][1]<=Rep[n][i][1] then c:=convert([seq(q^abs(k),k=get_branch(j,n,S0,S))],`+`); if min(coeffs(b-c))>=0 then cl:=cl,[j,c] fi; fi od; cl:=`clone_test/parts`(b,[cl]); if nops(cl)=0 then RETURN([]) fi; lprint(cat(i,` has clones`),op(cl)); if not assigned(Branch[0,n]) then cr:=zip((x,y)->[x,y],[\$1..nops(Rep[n])],coxeter['class_rep'](S)); cr:=map(proc(x,y) if nops({op(x[2])})=nops(x[2]) and member(y,x[2]) then x fi end,cr,n); Branch[0,n]:=sort(cr,(x,y)->evalb(nops(x[2])<=nops(y[2]))); fi; cr:=NULL; for j in Branch[0,n] do c:=false; for k from nops(cl) by -1 to 1 do if Rep[n][i][j[1]]<>convert([seq(Rep[n][l][j[1]],l=cl[k])],`+`) then c:=true; cl:=subsop(k=NULL,cl) fi od; if c then cr:=cr,[j[2],Rep[n][i][j[1]]] fi; if nops(cl)=0 then RETURN([cr]) fi; od; ERROR(`could not find enough para-Coxeter discriminators`); end; # Given a polynomial f with >=0 coefficients, and a list nl of named # nonneg polynomials (i.e., a list [[name1,poly1],[name2,poly2],...]), # return a list of all partitions of f into sums of these polynomials. # Each partition is identified as a list of names. `clone_test/parts`:=proc(f,nl) local g,new; if f=0 then [[]] elif nops(nl)=0 then [] else g:=f-nl[1][2]; new:=map(proc(x,y) if min(coeffs(y-x[2]))>=0 then x fi end,nl,g); [op(procname(f,subsop(1=NULL,nl))), op(map((x,y)->[y,op(x)],procname(g,new),nl[1][1]))] fi end: