/* ========================== 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  <mringe@tiffy.math.rwth-aachen.de>
   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 <stdlib.h>

#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;
}


