matrix* Weyl_orbit(entry* v, matrix** orbit_graph)
{ lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp);
matrix* result; entry** m;
lie_Index level_start=0, level_end=1, cur=1;
{ entry* lambda=mkintarray(r);
copyrow(v,lambda,r); make_dominant(lambda);
result=mkmatrix(bigint2entry(Orbitsize(lambda)),r);
copyrow(lambda,result->elm[0],r); freearr(lambda);
if (orbit_graph!=NULL) *orbit_graph=mkmatrix(result->nrows,s);
}
m=result->elm;
while (level_start<level_end)
{
for (k=level_start; k<level_end; ++k)
for (i=0; i<s; ++i)
if (m[k][i]>0) /* only strictly cross walls, and from dominant side */
{ w_refl(m[k],i);
for (j=level_end; j<cur; ++j)
if (eqrow(m[k],m[j],s)) break;
if (orbit_graph!=NULL)
{ (*orbit_graph)->elm[k][i]=j; (*orbit_graph)->elm[j][i]=k; }
if (j==cur)
{ assert(cur<result->nrows);
copyrow(m[k],m[cur++],r);
}
w_refl(m[k],i);
}
else if (m[k][i]==0 && orbit_graph!=NULL) (*orbit_graph)->elm[k][i]=k;
level_start=level_end; level_end=cur;
}
return result;
}
int main(int argc, char *argv[]) {
int n = ((argc == 2) ? atoi(argv[1]) : 1);
int** A = mkmatrix(SIZE, SIZE);
int** B = mkmatrix(SIZE, SIZE);
int** C = mkmatrix(SIZE, SIZE);
int* X = mkvector(SIZE);
int* Y = mkvector(SIZE);
int i, j, k, l;
for (l=0; l<n; l++) {
/* initialization */
for (i=0; i<SIZE; ++i) {
X[i] = Y[i] = 2;
for (j=0; j<SIZE; ++j) {
A[i][j] = B[i][j] = C[i][j] = 2;
}
}
/* 5-pointed system */
for (i=1; i<SIZE-1; ++i)
for(j=1; j<SIZE-1; ++j)
A[i][j] = (4*A[i][j] + A[i-1][j] + A[i+1][j]
+ A[i][j-1] + A[i][j+1])/8;
/* 9-pointed system */
for (i=1; i<SIZE-1; ++i)
for (j=1; j<SIZE-1; ++j)
A[i][j] = (8*A[i][j] + A[i-1][j] + A[i+1][j]
+ A[i][j-1] + A[i][j+1] + A[i-1][j+1]
+ A[i+1][j+1] + A[i-1][j-1]
+ A[i+1][j-1])/16;
/* Matrix-Vector Multiply */
for (i=0; i<SIZE; ++i)
for (j=0; j<SIZE; ++j)
Y[i] += A[i][j] * X[j];
/* Matrix-Matrix Multiply */
for (i=0; i<SIZE; ++i)
for (j=0; j<SIZE; ++j)
for (k=0; k<SIZE; ++k)
C[i][j] += A[i][k] * B[k][j];
}
printf("%d %d\n", Y[2], C[2][3]);
freematrix(SIZE, A);
freematrix(SIZE, B);
freematrix(SIZE, C);
delete[] X;
delete[] Y;
return(0);
}
matrix* simp_icart(simpgrp* g)
{ if (g->icartan) return g->icartan;
{ _index i, j, r=g->lierank;
matrix* icartan=g->icartan=mkmatrix(r,r); entry** m=icartan->elm;
setlonglife(icartan); /* permanent data */
switch (g->lietype)
{ case 'A':
for (i=0; i<r; ++i) for (j=0; j<=i; ++j)
m[i][j]=m[j][i]=(r-i)*(j+1);
break; case 'B':
for (i=0; i<r; ++i) for (j=0; j<=i; ++j) m[i][j]=m[j][i]=2*(j+1);
for (i=0; i<r; ++i) m[r-1][i]=i+1;
break; case 'C':
for (i=0; i<r; ++i) for (j=0; j<=i; ++j) m[i][j]=m[j][i]=2*(j+1);
for (i=0; i<r; ++i) m[i][r-1]=i+1;
break; case 'D':
for (i=0; i<r-2; ++i) for (j=0; j<=i; ++j) m[i][j]=m[j][i]=4*(j+1);
for (i=0; i<r-2; ++i) m[r-1][i]=m[r-2][i]=m[i][r-1]=m[i][r-2]=2*(i+1);
m[r-1][r-1]=m[r-2][r-2]=r; m[r-1][r-2]=m[r-2][r-1]=r-2;
break; case 'E':
m[0][0]=4; m[1][0]=m[0][1]=r-3; m[0][2]=m[2][0]=r-1;
m[1][1]=r; m[1][2]=m[2][1]=2*r-6; m[2][2]=2*r-2;
for (i=1; i<r-2; ++i) for (j=0; j<3; ++j) m[r-i][j]=m[j][r-i]=(j+2)*i;
for (i=1; i<r-2; ++i) for (j=1; j<=i; ++j)
m[r-i][r-j]=m[r-j][r-i]=(9-r+i)*j;
break; case 'F':
for (i=1; i<4; ++i) for (j=1; j<4; ++j) m[r-i][j-1]=i*j;
m[1][2]=8;
for (i=0; i<3; ++i) m[0][i]=m[r-i-1][3]=i+2;
m[0][3]=2;
break; case 'G': m[0][0]=m[1][1]=2; m[0][1]=1; m[1][0]=3;
}
return icartan;
}
}
int main(int argc, char *argv[]) {
int i, n = ((argc == 2) ? atoi(argv[1]) : 1);
int **m1 = mkmatrix(SIZE, SIZE);
int **m2 = mkmatrix(SIZE, SIZE);
int **mm = mkmatrix(SIZE, SIZE);
for (i=0; i<n; i++) {
mm = mmult(SIZE, SIZE, m1, m2, mm);
}
printf("%d %d %d %d\n", mm[0][0], mm[2][3], mm[3][2], mm[4][4]);
freematrix(SIZE, m1);
freematrix(SIZE, m2);
freematrix(SIZE, mm);
return(0);
}
matrix* Schur_char(entry* lambda, lie_Index l)
{ lie_Index i,n=check_part(lambda,l); entry np=n_parts(n);
matrix* result=mkmatrix(np,n+1); entry** res=result->elm;
res[0][0]=n; for (i=1; i<n; ++i) res[0][i]=0; i=0;
while (res[i][n]=Schur_char_val(lambda,res[i],l,n),++i<np)
{ copyrow(res[i-1],res[i],n); Nextpart(res[i],n); }
return result;
}
matrix* Weyl_mat(vector* word)
{ lie_Index i,j,r=Lierank(grp); matrix* res=mkmatrix(r,r); entry** m=res->elm;
for (i=0; i<r; ++i)
{ for (j=0; j<r; ++j) m[i][j]= i==j;
Waction(m[i],word);
}
return res;
}
matrix* To_Part_m (entry** wt, _index n_rows, _index n)
{ _index i; matrix* result=mkmatrix(n_rows,n+1); entry** lambda=result->elm;
for (i=0; i<n_rows; ++i)
{ _index j=n; entry sum=0;
while (lambda[i][j]=sum, --j>=0) sum+=wt[i][j];
}
return result;
}
matrix* simp_Weylmat(vector* word, simpgrp* g)
{ lie_Index i,j,r=g->lierank; matrix* res=mkmatrix(r,r);
entry** m=res->elm,* w=word->compon;
for (i=0; i<r; ++i)
{ for (j=0; j<r; ++j) m[i][j]= i==j;
for (j=0; j<word->ncomp; ++j)
if(w[j]!=0) simp_w_refl(m[i],w[j]-1,g);
}
return res;
}
/*
object vec_not_vec(vector* a)
{ _index i, n=a->ncomp; vector* result= mkvector(n);
for (i = 0; i<n; ++i) result->compon[i] = a->compon[n-1-i];
return (object) result;
}
*/
matrix* mat_min_mat(matrix* a) {
matrix* result;
_index i, j;
result = mkmatrix(a->nrows, a->ncols);
for (i = 0; i<a->nrows; i++) {
for (j = 0; j<a->ncols; j++)
*(*(result->elm + i) + j) = -*(*(a->elm + i) + j);
}
return result;
}
matrix* Partitions(lie_Index n)
{ matrix* result=mkmatrix(n_parts(n),n);
if (n>0)
{ entry* lambda=mkintarray(n),** res=result->elm; lie_Index i=0,j;
lambda[0]=n;
for(j=1;j<n;j++) lambda[j]=0; /* initialise |lambda| to $[n,0,0,\ldots]$ */
do copyrow(lambda,res[i++],n); while(Nextpart(lambda,n));
freearr(lambda);
}
return result;
}
bigint* sub_Worder(vector* v)
{ lie_Index i,j,s=Ssrank(grp), n=v->ncomp; matrix* roots=mkmatrix(n,s);
entry** m=roots->elm; group* h; bigint* result;
if (n==0) { freemem(roots); return one; }
for (i=0; i<n; ++i) /* select rows od an identity matrix */
{ entry* mij= *m++,vi=v->compon[i]-1;
for (j=0; j<s; ++j) *(mij++)= (j==vi);
}
h=Carttype(roots); freemem(roots);
result= Worder((object)h); freemem(h); return(result);
}
matrix *mat_append_mat_mat(matrix *a, matrix *b) {
matrix *result;
_index i,n1=a->nrows,n2=b->nrows,m;
if (a->ncols != b->ncols)
error("Unequal number of columns. (%ld <-> %ld) \n",
(long)a->ncols, (long)b->ncols);
m=a->ncols;
result = mkmatrix(n1+n2,m);
for (i=0;i<n1;++i) copyrow(a->elm[i],result->elm[i],m);
for (i=0;i<n2;++i) copyrow(b->elm[i],result->elm[n1+i],m);
return result;
}
matrix* Resmat(matrix* roots)
{ lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp), n=roots->nrows;
vector* root_norms=Simproot_norms(grp);
entry* norms=root_norms->compon;
/* needed to compute $\<\lambda,\alpha[i]>$ */
matrix* root_images=Matmult(roots,Cartan()),* result=mkmatrix(r,r);
entry** alpha=roots->elm,** img=root_images->elm,** res=result->elm;
for (i=0; i<r; i++) for (j=0; j<r; j++) res[i][j]= i==j;
/* initialise |res| to identity */
for (j=0; j<n; j++) /* traverse the given roots */
{ entry* v=img[j], norm=(checkroot(alpha[j]),Norm(alpha[j]));
for (k=s-1; v[k]==0; k--) {}
if (k<j)
error("Given set of roots is not independent; apply closure first.\n");
if (v[k]<0)
{ for (i=j; i<n; i++) img[i][k]= -img[i][k];
for (i=k-j; i<s; i++) res[i][k]= -res[i][k];
}
while(--k>=j)
/* clear |v[k+1]| by unimodular column operations with column~|j| */
{
entry u[3][2]; lie_Index l=0;
u[0][1]=u[1][0]=1; u[0][0]=u[1][1]=0;
u[2][1]=v[k]; u[2][0]=v[k+1];
if (v[k]<0) u[2][1]= -v[k], u[0][1]= -1; /* make |u[2][1]| non-negative */
do /* subtract column |l| some times into column |1-l| */
{ entry q=u[2][1-l]/u[2][l]; for (i=0; i<3; i++) u[i][1-l]-=q*u[i][l];
} while (u[2][l=1-l]!=0);
if (l==0) for (i=0; i<2; i++) swap(&u[i][0],&u[i][1]);
{ for (i=j; i<n; i++) /* combine columns |k| and |k+1| */
{ entry img_i_k=img[i][k];
img[i][k] =img_i_k*u[0][0]+img[i][k+1]*u[1][0];
img[i][k+1]=img_i_k*u[0][1]+img[i][k+1]*u[1][1];
}
for (i=k-j; i<s; i++)
{ entry res_i_k=res[i][k];
res[i][k]=res_i_k*u[0][0]+res[i][k+1]*u[1][0];
res[i][k+1]=res_i_k*u[0][1]+res[i][k+1]*u[1][1];
}
}
}
for (i=0; i<s; i++)
{ lie_Index inpr= norms[i]*alpha[j][i]; /* this is $(\omega_i,\alpha[j])$ */
if (inpr%norm!=0) error("Supposed root has non-integer Cartan product.\n");
res[i][j]=inpr/norm; /* this is $\<\omega_i,\alpha[j]>$ */
}
}
freemem(root_norms); freemem(root_images); return result;
}
matrix *mat_div_mat_int(matrix *a, entry b) {
_index i,j;
matrix* result;
_index n = a->ncols, m =a->nrows;
if (!b)
error("Division by zero\n");
result = mkmatrix(a->nrows, a->ncols);
for (i = 0; i<m; i++)
for (j = 0; j<n; j++)
*(*(result->elm + i) + j) = *(*(a->elm + i) + j)/b;
return result;
}
matrix* Tableaux(entry* lambda, lie_Index l)
{ bigint* nt=n_tableaux(lambda,l); lie_Index n=check_part(lambda,l);
matrix* result=mkmatrix(bigint2entry(nt),n);
entry** res=result->elm,* t=mkintarray(n);
freemem(nt);
{ lie_Index i=0,j,k;
for (j=1; j<=l; ++j) for (k=lambda[j-1]; k>0; --k) t[i++]=j;
}
{ lie_Index i=0; do copyrow(t,res[i++],n); while(Nexttableau(t,n)); }
freearr(t); return result;
}
matrix* Permutations(entry* v,lie_Index n)
{ lie_Index N=1; entry* w=mkintarray(n); copyrow(v,w,n); sortrow(w,n);
{ lie_Index i=0,j=n-1; while (i<j) swap(&w[i++],&w[j--]); }
/* increasing order */
{ lie_Index i=0, mult=1;
while (++i<n) { N*=i+1; if (w[i]>w[i-1]) mult=1; else N /= ++mult; }
}
{ matrix* result=mkmatrix(N,n); lie_Index i=0;
do copyrow(w,result->elm[i++],n); while (Nextperm(w,n));
freearr(w); return result;
}
}
matrix* Weyl_root_orbit(entry* v)
{ lie_Index i,j,r=Lierank(grp),s=Ssrank(grp);
entry* x=mkintarray(r); matrix* orbit, *result; entry** m;
lie_Index dc=Detcartan();
mulvecmatelm(v,Cartan()->elm,x,s,r);
orbit=Weyl_orbit(x,NULL);
result=mkmatrix(orbit->nrows,s); m=result->elm;
mulmatmatelm(orbit->elm,Icartan()->elm,m,orbit->nrows,s,s);
freemem(orbit);
for (i=0; i<result->nrows; ++i)
for (j=0; j<s; ++j) m[i][j]/=dc;
return result;
}
matrix *mat_mod_mat_int(matrix *a, entry b) {
_index i, j;
_index m = a->nrows, n = a->ncols;
matrix* result;
if (b<0)
error("LiE can only take the modulus by a positive number.\n");
result = mkmatrix(a->nrows, a->ncols);
for (i = 0; i<m; i++)
for (j = 0; j<n; j++)
*(*(result->elm + i) + j) =
imod(*(*(a->elm + i)+j), b);
return result;
}
local simpgrp* simp_type(entry** m, entry n)
{ matrix* adjs=mkmatrix(n,3);
entry** adj=adjs->elm /* |adj[i]| lists up to 3 neighbours of node |i| */
,* norm=mkintarray(3*n) /* norms of roots */
,* valency=&norm[n] /* valencies in Dynkin diagram */
,* p=&valency[n]; /* permutation of |n| */
simpgrp* result;
lie_Index i,j,k, a_val[4]={-1,-1,-1,-1};
/* |a_val[i]| is index of a node of valency |i|, if any */
if (n==0) error("empty input in simp_type\n");
{ for (i=0;i<n;i++) valency[i]=0;
/* |valency[i]| is also index of next slot in |adj[i]| */
for (i=n; --i>=0;)
{ norm[i]= Norm(m[i]); /* where |Norm(x)==Inprod(x,x)/2| */
for (j=i; --j>=0;)
if (Inprod(m[i],m[j])!=0) /* then valencies increase */
{ if (valency[i]>=3 || valency[j]>=3) error ("valency >3 found\n");
adj[i][valency[i]++]=j; adj[j][valency[j]++]=i;
/* update valencies and adjacencies */
}
a_val[valency[i]]=i; /* valency of node |i| is now known */
}
}
if (a_val[3]<0)
{ lie_Index e; /* index of end node (|valency[e]<=1|) */
if (a_val[0]>=0) p[0]=e=a_val[0]; /* must be type $A_1$ */
else
{ if (a_val[1]>=0) p[0]=e=a_val[1]; /* other linear types */
else error("no end node found\n");
{ k=p[1]=adj[e][0]; /* the unique neighbour of node |e| */
for(i=2;i<n;i++) p[i]=k=opposite(p[i-2],k); /* here |k==p[i-1]| */
}
if ( n==2 && norm[p[0]]+2*norm[p[1]]==5
|| n>=3 && norm[p[0]]!=norm[p[1]]
|| n==4 && norm[p[1]]<norm[p[2]]
)
{ for (i=0; i<n-1-i; i++) swap(&p[i],&p[n-1-i]); e=p[0]; }
}
{ entry norm0=norm[p[0]], norm1=norm[p[n-1]];
if (norm0==norm1) result = mksimpgrp('A',n);
else if (norm1==3) result=mksimpgrp('G',2);
else if (norm1==2) result=mksimpgrp('C',n);
else if (norm0!=2) error("I don't recognize this Cartan Type\n");
else if (n==4 && norm[p[2]]==1) result=mksimpgrp('F',4);
else result=mksimpgrp('B',n);
}
}
/* no nodes of valency 3 */
else
{ entry* branch=adj[a_val[3]], end[3], end_count=0;
for (j=2; j>=0; j--)
if (valency[branch[j]]==1) end[end_count++]=branch[j];
if (end_count>1)
{ p[n-1]=end[1]; p[n-2]=end[0]; p[n-3]=a_val[3];
k=p[n-4]=branch[0]+branch[1]+branch[2]-p[n-1]-p[n-2];
/* the remaining branch */
for(i=n-5; i>=0; i--)
{ if (valency[k]!=2) error("unlinear Dn tail.\n");
p[i]=k=opposite(p[i+2],k);
}
result=mksimpgrp('D',n);
}
else if (end_count==1)
{ p[3]=a_val[3]; p[1]=end[0];
for (j=2; j>=0; j--)
if (valency[branch[j]]==2)
if (valency[opposite(a_val[3],branch[j])]==1) break;
if (j<0) error("type E not recognised\n");
p[2]=branch[j]; p[0]=opposite(p[3],p[2]);
p[4]=k=branch[0]+branch[1]+branch[2]-p[1]-p[2]; /* remaining branch */
for(i=5;i<n;i++)
{ if (valency[k]!=2) error("wrong type E system.\n");
p[i]=k=opposite(p[i-2],k);
}
result=mksimpgrp('E',n);
}
else error("no end node adjacent to valency 3 node\n");
}
for (i=0; i<n; i++) if (p[i]>=0) /* then |p[i]| starts an untreated cycle */
{ entry* mi=m[j=i]; /* record beginning of cycle */
while (p[j]!=i)
{ k=j; j=p[j]; m[k]=m[j]; p[k]= -1; }
/* assign |m[j]=m[p[j]]| and advance */
m[j]=mi; p[j]= -1; /* close the cycle */
}
freemem(adjs); freearr(norm);
return result;
}
matrix* simp_proots(simpgrp* g)
{ if (g->roots!=NULL) return g->roots;
{ _index r=g->lierank,l,i,last_root;
entry** cartan=simp_Cartan(g)->elm;
entry** posr=(g->roots=mkmatrix(simp_numproots(g),r))->elm;
entry* level=(g->level=mkvector(simp_exponents(g)[r-1]+1))->compon;
entry* norm=(g->root_norm=mkvector(g->roots->nrows))->compon;
entry* alpha_wt=mkintarray(r);
/* space to convert roots to weight coordinates */
setlonglife(g->roots),
setlonglife(g->level),
setlonglife(g->root_norm); /* permanent data */
{ _index i,j; for (i=0; i<r; ++i) for (j=0; j<r; ++j) posr[i][j] = i==j;
level[0]=0; last_root=r;
for (i=0; i<r; ++i) norm[i]=1; /* norms are mostly |1| */
switch (g->lietype) /* here are the exceptions */
{ case 'B':
for (i=0; i<r-1; ++i) norm[i]=2; /* $2,2,\ldots,2,1$ */
break; case 'C': norm[r-1]=2; /* $1,1,\ldots,1,2$ */
break; case 'F': norm[0]=norm[1]=2; /* $2,2,1,1$ */
break; case 'G': norm[1]=3; /* $ 1,3$ */
}
}
for (l=0; last_root>level[l]; ++l)
{ level[l+1]=last_root; /* set beginning of a new level */
for (i=level[l]; i<level[l+1]; ++i)
{ _index j,k; entry* alpha=posr[i]; mulvecmatelm(alpha,cartan,alpha_wt,r,r);
/* get values $\<\alpha,\alpha_j>$ */
for (j=0; j<r; ++j) /* try all fundamental roots */
{ entry new_norm;
{ if (alpha_wt[j]<0) /* then $\alpha+\alpha_j$ is a root; find its norm */
if (norm[j]==norm[i]) new_norm=norm[j]; /* |alpha_wt[j]==-1| */
else new_norm=1; /* regardless of |alpha_wt[j]| */
else if (norm[i]>1 || norm[j]>1) continue; /* both roots must be short now */
else if (strchr("ADE",g->lietype)!=NULL) continue;
/* but long roots must exist */
else if (alpha_wt[j]>0)
if (g->lietype!='G'||alpha_wt[j]!=1) continue; else new_norm=3;
/* $[2,1]\to[3,1]$ for $G_2$ */
else if (alpha[j]==0) continue;
/* $\alpha-\alpha_j$ should not have a negative entry */
else
{
{ --alpha[j];
for (k=level[l-1]; k<level[l]; ++k)
if (eqrow(posr[k],alpha,r)) break;
++alpha[j];
if (k==level[l]) continue;
}
new_norm=2; }
}
++alpha[j]; /* temporarily set $\alpha\K\alpha+\alpha_j$ */
for (k=level[l+1]; k<last_root; ++k)
if (eqrow(posr[k],alpha,r)) break;
/* if already present, don't add it */
if (k==last_root)
{ norm[last_root]=new_norm; copyrow(alpha,posr[last_root++],r); }
--alpha[j]; /* restore |alpha| */
}
}
}
freearr(alpha_wt); return g->roots;
}
}
matrix* From_Part_m (entry** lambda, _index n_rows, _index n)
{ _index i,j; matrix* result=mkmatrix(n_rows,n-1); entry** res=result->elm;
for (i=0; i<n_rows; ++i)
for (j=0; j<n-1; ++j) res[i][j]=lambda[i][j]-lambda[i][j+1];
return result;
}
