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);
}
vector* Trans_part(entry* lambda, lie_Index l)
{ lie_Index i,j=0;
vector* result=mkvector(l ? lambda[0] : 0); entry* res=result->compon;
for (i=l-1; i>=0; --i)
while (j<lambda[i]) res[j++]=i+1;
return result;
}
/*
object bin_pow_bin_bin(object a, object b)
{
if (b->b.size<0)
error("Negative exponent; I cannot compute that power.\n");
return power(a,(bigint*)b,(object)one,(f2object)mult);
}
object pol_pow_pol_bin(object a, object b)
{
if (b->b.size<0)
error("Negative exponent; I cannot compute that power.\n");
return power(a,(bigint*)b,(object)poly_one(a->pl.ncols)
,(f2object)Mul_pol_pol);
}
*/
vector* vec_mul_int_vec(long a, vector* b) {
vector *result;
_index i;
result = mkvector(b->ncomp);
for (i = 0; i<b->ncomp; i++)
result->compon[i] = a * b->compon[i];
return (result);
}
vector* vec_div_vec_int(vector *a, long b) {
vector* result;
_index i;
result = mkvector(a->ncomp);
if (!b) error("Division by 0\n");
for (i = 0; i<a->ncomp; i++)
result->compon[i] = a->compon[i]/b;
return (result);
}
vector* vec_mod_vec_int(vector *a, entry b) {
vector* result;
_index i;
if (b<0)
error("LiE can only take the modulus by a positive number.\n");
result = mkvector(a->ncomp);
for (i = 0; i<a->ncomp; i++)
result->compon[i] = imod(a->compon[i],b);
return result;
}
vector *vec_append_vec_vec(vector *v, vector *w) {
vector *result;
_index i,nv=v->ncomp, nw=w->ncomp;
result = mkvector(nv+nw);
for (i=0;i<nv;i++)
result->compon[i]=v->compon[i];
for (i=0;i<nw;i++)
result->compon[nv+i]=w->compon[i];
return result;
}
/* mktree - make a tree of nodes with depth d. */
static obj_t mktree(mps_ap_t ap, unsigned d, obj_t leaf) {
obj_t tree;
size_t i;
if (d <= 0) return leaf;
tree = mkvector(ap, width);
for (i = 0; i < width; ++i) {
aset(tree, i, mktree(ap, d - 1, leaf));
}
return tree;
}
local bigint* simp_stabsize(entry* v, simpgrp* g)
{ object sav_grp=grp; vector* I; bigint* result;
lie_Index i,nz=0,r=g->lierank;
for (i=0; i<r; ++i) if (v[i]==0) nz++; /* count non-zero coordinates */
if (nz==0) return one;
if (nz==r) return simp_worder(copybigint(one,NULL),g);
I=mkvector(nz);
for (i=0,nz=0; i<r; ++i) if (v[i]==0) I->compon[nz++]=i+1;
grp=(object)g; result=sub_Worder(I); grp=sav_grp;
freemem(I); return result;
}
vector* Simproot_norms(object grp)
{ if (type_of(grp)==SIMPGRP)
{ simp_proots(&grp->s); return grp->s.root_norm; }
{ _index i; for (i=0; i<grp->g.ncomp; ++i) simp_proots(Liecomp(grp,i)); }
if (grp->g.ncomp==1) return Liecomp(grp,0)->root_norm;
{ _index i,t=0; vector* result=mkvector(Ssrank(grp));
for (i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i); _index r=g->lierank;
copyrow(g->root_norm->compon,&result->compon[t],r); t+=r;
}
return result;
}
}
vector *vec_mul_vec_mat(vector *v, matrix *m) {
_index i, k, nrows=m->nrows, ncols=m->ncols;
vector *result;
if (v->ncomp != nrows)
error("Number rows arg2 unequal number of components arg1 .\n");
result = mkvector(ncols);
for (i = 0; i<ncols; i++) {
result->compon[i] = 0;
for (k = 0; k<nrows; k++)
result->compon[i] += v->compon[k] * *(*(m->elm + k) + i);
}
return result;
}
vector* check_tabl(vector* v)
{ vector* shape; entry* t=v->compon,* sh; lie_Index i,d,n=v->ncomp, max=0;
for(i=0; i<n; ++i)
if( (d=t[i])<=0 ) error ("Non-positive number in tableau.\n");
else if (d>max) max=d;
shape=mkvector(max); sh=shape->compon; for(i=0; i<max; ++i) sh[i]=0;
for(i=0; i<n; ++i)
if( ++sh[d=t[i]-1], d>0 && sh[d]>sh[d-1] )
Printf("%ld at position %ld ",(long)(d+1),(long)(i+1)),
error("violates tableau condition.\n");
return shape;
}
/* initvars -- initialize the variable machinery */
extern void initvars(void) {
globalroot(&vars);
globalroot(&noexport);
globalroot(&env);
globalroot(&sortenv);
vars = mkdict();
noexport = NULL;
env = mkvector(10);
#if ABUSED_GETENV
# if READLINE
initgetenv();
# endif
#endif
}
vector* vec_mul_mat_vec(matrix *a, vector *b) {
_index i, k, n, m;
vector *result;
if (a->ncols != b->ncomp)
error("Number columns arg1 unequal number of components arg2 .\n");
n = a->nrows;
m = a->ncols;
result = mkvector(n);
for (i = 0; i<n; i++) {
result->compon[i] = 0;
for (k = 0; k<m; k++)
result->compon[i] += b->compon[k] * *(*(a->elm + i) + k);
}
return result;
}
/* new_tree - Make a new tree from an old tree.
* The new tree is the same depth as the old tree and
* reuses old nodes with probability preuse.
* NOTE: If a new node is reused multiple times, the total size
* will be smaller.
* NOTE: Changing preuse will dramatically change how much work
* is done. In particular, if preuse==1, the old tree is returned
* unchanged. */
static obj_t new_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
obj_t subtree;
size_t i;
if (rnd_double() < preuse) {
subtree = random_subtree(oldtree, depth - d);
} else {
if (d == 0)
return objNULL;
subtree = mkvector(ap, width);
for (i = 0; i < width; ++i) {
aset(subtree, i, new_tree(ap, oldtree, d - 1));
}
}
return subtree;
}
vector* Exponents(object grp)
{ if (type_of(grp)==SIMPGRP)
{ simp_exponents(&grp->s); return grp->s.exponents; }
if (simpgroup(grp))
{ simp_exponents(Liecomp(grp,0)); return Liecomp(grp,0)->exponents; }
{ _index i,t=0; vector* v=mkvector(Lierank(grp)); entry* e=v->compon;
{ for (i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i); _index r=g->lierank;
copyrow(simp_exponents(g),&e[t],r); t+=r;
}
for (i=0; i<grp->g.toraldim; ++i) e[t+i]=0;
}
return v;
}
}
extern Vector *mkenv(void) {
if (isdirty || rebound) {
env->count = envmin;
gcdisable(); /* TODO: make this a good guess */
dictforall(vars, mkenv0, NULL);
gcenable();
env->vector[env->count] = NULL;
isdirty = FALSE;
rebound = FALSE;
if (sortenv == NULL || env->count > sortenv->alloclen)
sortenv = mkvector(env->count * 2);
sortenv->count = env->count;
memcpy(sortenv->vector, env->vector, sizeof (char *) * (env->count + 1));
sortvector(sortenv);
}
return sortenv;
}
/* Update tree to be identical tree but with nodes reallocated
* with probability pupdate. This avoids writing to vector slots
* if unecessary. */
static obj_t update_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
obj_t tree;
size_t i;
if (oldtree == objNULL || d == 0)
return oldtree;
if (rnd_double() < pupdate) {
tree = mkvector(ap, width);
for (i = 0; i < width; ++i) {
aset(tree, i, update_tree(ap, aref(oldtree, i), d - 1));
}
} else {
tree = oldtree;
for (i = 0; i < width; ++i) {
obj_t oldsubtree = aref(oldtree, i);
obj_t subtree = update_tree(ap, oldsubtree, d - 1);
if (subtree != oldsubtree) {
aset(tree, i, subtree);
}
}
}
return tree;
}
static void mkenv0(void *dummy, char *key, void *value) {
Var *var = value;
assert(gcisblocked());
if (
var == NULL
|| var->defn == NULL
|| (var->flags & var_isinternal)
|| !isexported(key)
)
return;
if (var->env == NULL || (rebound && (var->flags & var_hasbindings))) {
char *envstr = str(ENV_FORMAT, key, var->defn);
var->env = envstr;
}
assert(env->count < env->alloclen);
env->vector[env->count++] = var->env;
if (env->count == env->alloclen) {
Vector *newenv = mkvector(env->alloclen * 2);
newenv->count = env->count;
memcpy(newenv->vector, env->vector, env->count * sizeof *env->vector);
env = newenv;
}
}
local entry* simp_exponents (simpgrp* g)
{ if (g->exponents!=NULL) return g->exponents->compon;
{ static entry
exp_E[3][7] = {{4,5,7,8,11},{5,7,9,11,13,17},{7,11,13,17,19,23,29}}
, exp_F4[3] = {5,7,11};
_index i,r=g->lierank; entry* e=(g->exponents=mkvector(r))->compon;
setlonglife(g->exponents); e[0]=1;
switch (g->lietype)
{ case 'A': /* $1,2,3,\ldots,r$ */
for (i=1; i<r; ++i) e[i]=i+1;
break; case 'B': case 'C': /* $1,3,5,\ldots,2r-1$ */
for (i=1; i<r; ++i) e[i]=2*i+1;
break; case 'D': /* $1,3,5,\ldots,r-2,r-1,r,\ldots,2r-3$
or $1,3,5,\ldots,r-1,r-1,\ldots,2r-3$ */
for (i=0; 2*i+1<r; ++i) { e[i]=2*i+1; e[r-i-1]=2*(r-i)-3; }
if (2*i+1==r) e[i]=r-1;
break; case 'E': copyrow(exp_E[r-6],&e[1],r-1);
break; case 'F': copyrow(exp_F4,&e[1],3);
break; case 'G': e[1]=5;
}
return e;
}
}
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;
}
}
vector* vec_min_vec(vector* a) {
_index i; vector* result= mkvector(a->ncomp);
for (i = 0; i<a->ncomp; ++i) result->compon[i] = -a->compon[i];
return result;
}
vector* From_Part_v (entry* lambda, _index n)
{ _index i; vector* result=mkvector(n-1); entry* res=result->compon;
for (i=0; i<n-1; ++i) res[i]=lambda[i]-lambda[i+1];
return result;
}
vector* To_Part_v (entry* wt,_index n)
{ _index i=n; vector* result=mkvector(n+1); entry* lambda=result->compon;
entry sum=0;
while (lambda[i]=sum, --i>=0) sum+=wt[i];
return result;
}
vector* Highroot(simpgrp* g)
{ matrix* posr=simp_proots(g); _index r=g->lierank; vector* high=mkvector(r);
copyrow(posr->elm[posr->nrows-1],high->compon,r); return high;
}
