/* ========================== C MeatAxe =============================
   words.c - Functions for the calculation of words in the algebra.

   (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: words.c,v 2.0 1993/10/14 18:54:18 mringe Exp $
 *
 * $Log: words.c,v $
 * Revision 2.0  1993/10/14  18:54:18  mringe
 * MeatAxe-2.0, Phase I
 *
 * Revision 2.0  1993/10/14  18:54:18  mringe
 * MeatAxe-2.0, Phase I
 *
 * Revision 1.15  1993/08/12  16:14:23  mringe
 * Include <string.h>.
 *
 * Revision 1.14  1993/08/06  14:01:59  mringe
 * Neuer File-header.
 *
 * Revision 1.13  1993/02/17  11:16:12  mringe
 * Include-Files...
 *
 * Revision 1.12  1993/02/13  11:46:41  mringe
 * Bug in mkbasisname() behoben.
 *
 * Revision 1.11  1993/02/13  11:34:45  mringe
 * nameof() von ZSM hierher verlagert.
 *
 * Revision 1.10  1993/02/12  17:06:59  mringe
 * Woerter mit N Erzeugern.
 *
 * Revision 1.9  1993/02/10  19:40:54  mringe
 * Libraries angelegt (YYY und ZZZ).
 *
 * Revision 1.8  1993/01/18  16:54:27  mringe
 * Fehler beseitigt.
 *
 * Revision 1.7  1993/01/18  16:51:36  mringe
 * z3 entfernt. Berechne Fingerprint via mkword().
 *
 * Revision 1.6  1993/01/08  00:24:45  mringe
 * makeword() verbessert. Macht jetzt keine Annahme
 * ueber vorangegangene Aufrufe mehr.
 *
 * Revision 1.5  1992/09/03  12:53:44  mringe
 * Bug in mkword() behoben.
 *
 * Revision 1.4  1992/08/31  14:40:32  mringe
 * Worte -1..-6 (=Standard-Fingerprint)
 *
 * Revision 1.3  1992/07/22  07:10:30  mringe
 * Changed 'global.h' to 'lattice.h'
 *
 * Revision 1.2  1992/06/01  08:34:25  mringe
 * CL warnings entfernt.
 *
 * Revision 1.1  1992/05/24  09:43:36  mringe
 * Initial revision
 *
 */

#include <string.h>
#include <stdlib.h>

#include "meataxe.h"
#include "lattice.h"

#include "words.h"


static void mkbasis _PL((matrix_t *basis[], int ngen, int max));
static void mkbasisname _PL((char *basisname[], int ngen, int max));


/* ------------------------------------------------------------------
   nextword() - Given a word number, return the number of the
	next normed word (i.e., leaving out scalar multiples).
	Also handles 'fingerprint' words with numbers < 0.
   ------------------------------------------------------------------ */

long nextword(w)
long w;

{
    long x, i;

    if (w < 0)
		return ((w > -MAXFP) ? w-1 : 1);
    else
    {
	++w;
	for (x = 1; (i = w/x) >= zfl; x *= zfl);
	if (i == 1)
	    return w;
	else
	    return (x * zfl);
    }
}


/* ------------------------------------------------------------------
   initbasis()
   ------------------------------------------------------------------ */

void initbasis(gen, ngen, basis)
matrix_t *gen[];
int ngen;
basis_t *basis;

{
    int i;
    long nor = gen[0]->nor;

    zsetlen(gen[0]->fl,nor);
    basis->ngen = ngen;
    basis->b[0] = matid(gen[0]->fl,nor);
    for (i = 1; i <= ngen; ++i)
	basis->b[i] = matdup(gen[i-1]);	/* Copy generators */
    for (i = ngen+1; i < MAXBASIS; ++i)
    	basis->b[i] = NULL;		/* Mark as unused */
    basis->w = matalloc(gen[0]->fl,nor,nor);
    basis->z4 = NULL;
    basis->z5 = NULL;
    basis->z7 = NULL;
    basis->z9 = NULL;
    basis->z10 = NULL;
    basis->z11 = NULL;
    basis->z12 = NULL;
}


/* ------------------------------------------------------------------
   freebasis()
   ------------------------------------------------------------------ */

#define MATFREE(x) if ((x) != NULL) { matfree(x); (x) = NULL; }

void freebasis(basis)
basis_t *basis;

{
    int i;

    for (i = 0; i < MAXBASIS; ++i)
	MATFREE(basis->b[i]);
    MATFREE(basis->w);
    MATFREE(basis->z4);
    MATFREE(basis->z5);
    MATFREE(basis->z7);
    MATFREE(basis->z9);
    MATFREE(basis->z10);
    MATFREE(basis->z11);
    MATFREE(basis->z12);
}


/* ------------------------------------------------------------------
   mkbasis() - Calculate basis elements up to number <max>
   ------------------------------------------------------------------ */

static void mkbasis(basis,ngen,max)
matrix_t *basis[];
int ngen;
int max;

{
    int i, k, g;

    if (max >= MAXBASIS)
	FATAL("mkbasis() ERROR, INCREASE MAXBASIS");
    g = i = 1;
    for (k = ngen+1; k <= max; ++k)
    {
	if (basis[k] == NULL)
	{
	    basis[k] = matdup(basis[i]);
	    matmul(basis[k],basis[g]);
	}
	if (++g > ngen)
	{
	    g = 1;
	    ++i;
	}
    }
}


/* ------------------------------------------------------------------
   mkword() - Calculate a word, given its number n. If n > 0,
	the formula is

		w = n0*b[0] + ... + nk*b[k]
   
	where b[i] are the basis elements (basis.b[k]) and the
	coefficients n0...nk are defined by

		n = n0 + n1*q + n2*q^2 ... +nk*q^k
      
	zitof() is used to map integers onto field elements. The word
	is stored in b.w.

	If n<0, the standard fingerprint is calculated.
   ------------------------------------------------------------------ */

void mkword(b, n)
basis_t *b;
long n;

{
    long k;
    int l;
    PTR x, y;
    FEL f;

    zsetlen(b->b[0]->fl,b->w->noc);

    if (n < 0)	/* Standard fingerprint */
    {

	/* Fingerprint F1
	   -------------- */
	if (b->z4 == NULL)
	{
	    b->z4 = matdup(b->b[1]);
	    matmul(b->z4,b->b[2]);
	}
	if (b->z5 == NULL)
	{
	    b->z5 = matdup(b->z4);
	    matadd(b->z5,b->b[1]);
	    matadd(b->z5,b->b[2]);
	}
	if (n == -1)
	{
	    matmove(b->w,b->z5);
	    return;
	}

	/* Fingerprint F2
	   -------------- */
	if (b->z7 == NULL)
	{
	    b->z7 = matdup(b->z4);
	    matmul(b->z7,b->b[2]);
	    matadd(b->z7,b->z5);
	}
	if (n == -2)
	{
	    matmove(b->w,b->z7);
	    return;
	}

	/* Fingerprint F3
	   -------------- */
	if (b->z9 == NULL)
	{
	    b->z9 = matdup(b->b[2]);
	    matmul(b->z9,b->z7);
	    matadd(b->z9,b->b[1]);
	}
	if (n == -3)
	{
	    matmove(b->w,b->z9);
	    return;
	}

	/* Fingerprint F4
	   -------------- */
	if (b->z10 == NULL)
	{
	    b->z10 = matdup(b->b[2]);
	    matadd(b->z10,b->z9);
	}
	if (n == -4)
	{
	    matmove(b->w,b->z10);
	    return;
	}

	/* Fingerprint F5
	   -------------- */
	if (b->z11 == NULL)
	{
	    b->z11 = matdup(b->z4);
	    matadd(b->z11,b->z10);
	}
	if (n == -5)
	{
	    matmove(b->w,b->z11);
	    return;
	}
	
	/* Fingerprint F6
	   -------------- */
	if (b->z12 == NULL)
	{
	    b->z12 = matdup(b->b[1]);
	    matadd(b->z12,b->z11);
	}
	if (n == -6)
	{
	    matmove(b->w,b->z12);
	    return;
	}
	FATAL("Illegal word number in fingerprint");
    }
    else /* `Normal' word */
    {
	rand_init((unsigned int)n);

	x = b->w->d;
	for (k = 1; k <= b->w->nor; ++k) /* Clear matrix */
	{	zmulrow(x,0);
		zadvance(&x,(long)1);
	}
	for (l = 0; n != 0; ++l)
	{
	    int j = rand_int(MAXBASIS - 2);

	    f = zitof(n % zfl);	/* Get next digit */
	    n /= zfl;
	    if (f == F_ZERO) continue;
	    if (b->b[j] == NULL)
		mkbasis(b->b,b->ngen,j);
	    x = b->b[j]->d;
	    y = b->w->d;
	    for (k = b->w->nor; k != 0; --k)
	    {
		zaddmulrow(y,x,f);
		zadvance(&x,(long)1);
		zadvance(&y,(long)1);
	    }
	}
    }
}




/* ------------------------------------------------------------------
   makefp() - Calculate standard fingerprint
   ------------------------------------------------------------------ */
#if (MAXFP != 6)
	************* FEHLER *****************
#endif

void makefp(basis,fp)
basis_t *basis;
long fp[];

{	
    int i;

    for (i = 0; i < MAXFP; ++i)
    {
	mkword(basis,-1-i);
    	fp[i] = nullity(basis->w);
    }
}



/* ------------------------------------------------------------------
   mkbasisname() - Make names of basis elements up to number <max>
   ------------------------------------------------------------------ */

static void mkbasisname(name,ngen,max)
char *name[];
int ngen;
int max;

{
    int i, k, g;
    static char *genname[MAXGEN] =
	{"I","A","B","C","D","E","F","G","H","I","J","K","L","M","N",
	 "O","P","Q","R","S","T","U","V","W","X","Y","Z","a","b","c",
	 "d","e","f","g","h","i","j","k","l","m","n","o","p","q","r",
	 "s","t","u","v","w"};

    for (i = 0; i <= max && i <= ngen; ++i)
    	if (name[i] == NULL) name[i] = genname[i];
    g = i = 1;
    for (k = ngen+1; k <= max; ++k)
    {
	if (name[k] == NULL)
	{
	    name[k] = (char *)
		malloc(strlen(name[i])+strlen(name[g])+1);
	    strcpy(name[k],name[i]);
	    strcat(name[k],name[g]);
	}
	if (++g > ngen)
	{
	    g = 1;
	    ++i;
	}
    }
}


/* ------------------------------------------------------------------
   nameof() - Returns the name of a word (given its number).
   ------------------------------------------------------------------ */

char *nameof(b,n)
basis_t *b;
long n;

{	static char name[200];
	char *c = name;
	char *basisname[MAXBASIS];
	int i;
	long digit;

	for (i = 0; i < MAXBASIS; ++i) basisname[i] = NULL;
	rand_init((unsigned)n);
	for (; n != 0; )
	{   digit = n % zfl;	/* Get next digit */
	    i = rand_int(MAXBASIS-2);
		n /= zfl;
		if (digit == 0) continue;
		if (c != name) *c++ = '+';
		mkbasisname(basisname,b->ngen,i);
		if (digit != 1)
			sprintf(c,"%ld*%s",digit,basisname[i]);
		else
			sprintf(c,"%s",basisname[i]);
		while (*c != 0) ++c;
	}
	return name;
}