/* ========================== C MeatAxe ============================= Split a module. This is the function version of the ZSP program. (C) Copyright 1993 Michael Ringe, Lehrstuhl D fuer Mathematik, RWTH Aachen, Germany This program is free software; see the file COPYING for details. ================================================================== */ /* $Id: split.c,v 2.3 1993/12/13 08:25:53 mringe Exp $ * * $Log: split.c,v $ * Revision 2.3 1993/12/13 08:25:53 mringe * Reihenfolge der Fkt.-argumente vereinheitlicht. * * Revision 2.2 1993/12/07 14:34:24 mringe * Teste bei realloc() auf size==0. * * Revision 2.1 1993/10/20 18:17:07 mringe * MeatAxe-2.0, Phase II. * * Revision 2.0 1993/10/14 18:54:18 mringe * MeatAxe-2.0, Phase I * * Revision 1.12 1993/08/06 14:01:59 mringe * Neuer File-header. * * Revision 1.11 1993/02/12 17:06:59 mringe * Woerter mit N Erzeugern. * * Revision 1.10 1993/02/12 08:31:41 mringe * Benutze Library-Funktionen fuer sun und quot. * * Revision 1.9 1993/02/10 19:40:54 mringe * Libraries angelegt (YYY und ZZZ). * * Revision 1.8 1993/01/27 13:05:02 mringe * Benutze F_ZERO und F_ONE statt 0 und 1. * * Revision 1.7 1993/01/15 07:31:42 mringe * try_split() auf N Erzeuger umgestellt. * * Revision 1.6 1993/01/15 06:48:03 mringe * sbasis() auf N Erzeuger umgestellt. * * Revision 1.5 1993/01/09 14:50:26 mringe * Berechne Projektion des seed space auf quot. * * Revision 1.4 1992/10/02 15:50:28 mringe * Benutze F_ZERO statt 0. * * Revision 1.3 1992/10/01 13:50:10 mringe * Header eingef"ugt. * * Revision 1.2 1992/07/22 07:10:30 mringe * Changed 'global.h' to 'lattice.h' * * Revision 1.1 1992/05/24 08:29:47 mringe * Initial revision * */ #include #include "meataxe.h" #include "lattice.h" #include "split.h" #include "words.h" /* For nextword() */ static void init _PL((int ngen, matrix_t *gen[], matrix_t *seed)); static void cleanup _PL((void)); static int nextseed _PL((void)); static void do_split _PL((int ngen, matrix_t *gen[],matrix_t *seed)); /* ------------------------------------------------------------------ Static global data ------------------------------------------------------------------ */ static split_t *spl; static PTR mat; static PTR mygen[MAXGEN]; static long *piv; static long sdim, qdim; static PTR base[MAXSEED+1]; /* Basis of seed vector space */ static PTR seedv; static FEL co[MAXSEED+1]; static PTR m4; static long nor, /* Dimension */ ssdim; /* Dimension of seed vector space */ /* ------------------------------------------------------------------ split() - Try to split a module. For each seed vector (i.e., for a representative of each one dimensionsional subspace of `seed'), the smallest invariant submodule containing this vector is calculated. If a seed vector generates a proper submodule, the action of the generators on the subspace and on the quotient is calculated, and the function returns. If tr==1, only one seed vector is examined. split() returns a pointer to a structure of type split_t. This structure contains the result (split or not split) and, if the module was split, the actions of the generators on both subspace and quotient. ------------------------------------------------------------------ */ split_t *split(seed,ngen,gen,tr) matrix_t *seed; int ngen; matrix_t *gen[]; int tr; { init(ngen,gen,seed); while (nextseed()) { zmoverow(mat,seedv); /* Seed vector */ sdim = zspinup(mat,(long)1,piv,mygen,ngen,T_MATRIX); if (sdim == -1) FATAL("SPLIT ERROR"); qdim = nor - sdim; if (sdim < nor) /* Split */ { do_split(ngen,gen,seed); /* Calculate actions */ break; } else { if (tr) break; } } cleanup(); spl->result = (sdim < nor); return spl; } /* ------------------------------------------------------------------ init() ------------------------------------------------------------------ */ static void init(ngen,gen,seed) int ngen; matrix_t *gen[]; matrix_t *seed; { int i; PTR x; nor = gen[0]->nor; zsetlen(zfl,nor); for (i = 0; i < ngen; ++i) mygen[i] = gen[i]->d; /* Allocate memory --------------- */ piv = (long*) malloc((size_t)(nor+1)*sizeof(long)); mat = zalloc(nor); m4 = zalloc((long)1); seedv = zalloc((long)1); /* Initialize seed vector generator -------------------------------- */ ssdim = seed->nor; if (ssdim > MAXSEED) FATAL("SEED SPACE TO BIG"); x = seed->d; for (i = 1; (long) i <= ssdim; ++i) { base[i] = x; co[i] = 0; zadvance(&x,(long)1); } /* Initialize the spl structure ---------------------------- */ spl = (split_t *) malloc(sizeof(split_t)); for (i = 0; i < MAXGEN; ++i) { spl->sub[i] = NULL; spl->quot[i] = NULL; } spl->proj = NULL; } static void cleanup() { free(m4); free(seedv); free(mat); free(piv); } /* ------------------------------------------------------------------ nextseed() - generate next seed vector This function will not work correctly with the `big' ZZZ module. We should use mkseed() here! ------------------------------------------------------------------ */ static int nextseed() { int l = 1; while (1) { if (l < (int) ssdim) { if (++co[l] == (FEL) zfl) co[l++] = 0; else break; } else { if (++co[l] == 1) break; else return 0; } } zmulrow(seedv,F_ZERO); for (l = 1; l <= (int) ssdim; ++l) zaddmulrow(seedv,base[l],co[l]); return 1; } /* ------------------------------------------------------------------ do_split() - Calculate the action of the generators on subspace and quotient. Calculate the projection of the seed space on the quotient. ------------------------------------------------------------------ */ static void do_split(ngen, gen, seed) int ngen; matrix_t *gen[]; matrix_t *seed; { int g; long fl = seed->fl; long i; PTR xi, yi; /* Subspace -------- */ for (g = 0; g < ngen; ++g) { spl->sub[g] = matalloc(fl,sdim,sdim); xi = mat; yi = spl->sub[g]->d; for (i = 1; i <= sdim; ++i) { zsetlen(fl,sdim); zmulrow(yi,F_ZERO); zsetlen(fl,nor); zmaprow(xi,gen[g]->d,nor,m4); zadvance(&xi,(long)1); zcleanrow2(m4,mat,sdim,piv,yi); zsetlen(fl,sdim); zadvance(&yi,(long)1); } } /* Quotient -------- */ zsetlen(fl,nor); zquotinit(mat,sdim,piv); for (g = 0; g < ngen; ++g) { spl->quot[g] = (matrix_t *) malloc(sizeof(matrix_t)); spl->quot[g]->fl = fl; spl->quot[g]->nor = qdim; spl->quot[g]->noc = qdim; spl->quot[g]->d = zquotop(gen[g]->d); } /* Calculate the projection of the seed space on the quotient ---------------------------------------------------------- */ zsetlen(fl,nor); spl->proj = (matrix_t *) malloc(sizeof(matrix_t)); spl->proj->fl = fl; spl->proj->nor = seed->nor; spl->proj->noc = qdim; spl->proj->d = zquot(seed->d,seed->nor); zsetlen(fl,qdim); zmkechelon(spl->proj->d,spl->proj->nor,piv); if (piv[0] != spl->proj->nor) { size_t size; zsetlen(fl,spl->proj->noc); spl->proj->nor = piv[0]; size = zsize(piv[0]); if (size == 0) size = 1; spl->proj->d = realloc(spl->proj->d,size); } zsetlen(zfl,nor); } /* ------------------------------------------------------------------ splfree() ------------------------------------------------------------------ */ void splfree(s) split_t *s; { int i; for (i = 0; i < MAXGEN; ++i) { if (s->sub[i] != NULL) matfree(s->sub[i]); if (s->quot[i] != NULL) matfree(s->quot[i]); } if (s->proj != NULL) matfree(s->proj); free(s); } /* ------------------------------------------------------------------ sbasis() - Spin up `canonically' ------------------------------------------------------------------ */ matrix_t *sbasis(seed, ngen, gen) matrix_t *seed; /* A seed vector */ int ngen; /* Number of generators */ matrix_t *gen[]; /* The generators */ { matrix_t *ba; PTR b; long i, k, j, *piv; PTR xi, xk, xj, yi, yk, a; int igen; FEL f; long dim = gen[0]->nor; long fl = gen[0]->fl; /* Check arguments --------------- */ for (i = 0; i < ngen; ++i) { if (gen[i]->nor != dim || gen[i]->noc != dim) FATAL("sbasis(): generator not square"); } if (seed->nor < 1 || seed->noc != dim) FATAL("sbasis(): bad seed"); ba = matalloc(fl,dim,dim); b = ba->d; zsetlen(fl,dim); a = zalloc(dim); piv = (long *)malloc((size_t)(dim+1)*sizeof(long)); zmoverow(a,seed->d); /* seed vector */ zmoverow(b,seed->d); i = 1; xi = a; yi = b; k = 1; xk = a; yk = b; igen = -1; /* Fange mit Erzeuger 0 an */ while (1) { if ((piv[k] = zfindpiv(xk,&f)) != 0) { if (k == dim) break; /* Finished */ ++k; zadvance(&xk,(long)1); zadvance(&yk,(long)1); } if (++igen >= ngen) { igen = 0; if (++i >= k) /* Oops: Not irreducible */ { fprintf(stderr,"dim= %ld, sdim=%ld\n",dim,k-1); FATAL("sbasis(): not irreducible"); } zadvance(&xi,(long)1); zadvance(&yi,(long)1); } zmaprow(yi,gen[igen]->d,znoc,yk); zmoverow(xk,yk); xj = a; for (j = 1; j < k; ++j) { f = zsub(0,zdiv(zextract(xk,piv[j]),zextract(xj,piv[j]))); zaddmulrow(xk,xj,f); zadvance(&xj,(long)1); } } free(a); free(piv); return ba; } /* ------------------------------------------------------------------ mkseed() - Make seed vectors. ------------------------------------------------------------------ */ matrix_t *mkseed(subsp) matrix_t *subsp; { matrix_t *seed; PTR x, y; long i, ns, k, l; /* ns = number of seed vectors = (q^n-1)/(q-1) ------------------------------------------- */ ns = zfl; for (i = 1; i < subsp->nor; ++i) ns *= zfl; ns = (ns - 1) / (zfl - 1); seed = matalloc(subsp->fl,ns,subsp->noc); /* Make seed vectors ----------------- */ x = seed->d; zsetlen(zfl,subsp->noc); l = 1; for (i = 0; i < ns; ++i) { zmulrow(x,F_ZERO); y = subsp->d; for (k = l; k > 0; k /= zfl) { zaddmulrow(x,y,zitof(k % zfl)); zadvance(&y,(long)1); } zadvance(&x,(long)1); l = nextword(l); } return seed; }