/* ========================== C MeatAxe =============================
   yperm.c - Operations with permutations

   (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: yperm.c,v 2.4 1994/03/12 13:38:48 mringe Exp $
 *
 * $Log: yperm.c,v $
 * Revision 2.4  1994/03/12  13:38:48  mringe
 * Benutze zreadlong() und zwritelong().
 *
 * Revision 2.3  1994/02/13  18:26:56  mringe
 * Neu: os.c, os.h.
 *
 * Revision 2.3  1994/02/13  18:26:56  mringe
 * Neu: os.c, os.h.
 *
 * Revision 2.2  1994/02/12  04:10:13  mringe
 * UMFANGREICHE AENDERUNGEN AN VIELEN DATENTYPEN.
 *
 * Revision 2.1  1993/10/21  21:57:35  mringe
 * Permutationen.
 *
 * Revision 2.0  1993/10/14  18:54:18  mringe
 * MeatAxe-2.0, Phase I
 *
 * Revision 1.10  1993/10/11  19:05:28  mringe
 * Neue Library-Struktur.
 *
 * Revision 1.9  1993/10/06  04:41:05  mringe
 * utils Library eliminiert.
 *
 * Revision 1.8  1993/10/05  19:04:39  mringe
 * *** empty log message ***
 *
 * Revision 1.7  1993/10/05  19:02:08  mringe
 * yerror eliminiert.
 *
 * Revision 1.6  1993/10/05  18:57:28  mringe
 * Neue Fehlermeldungen.
 *
 * Revision 1.5  1993/10/05  17:33:26  mringe
 * permsave() und permload().
 *
 * Revision 1.4  1993/08/06  14:01:59  mringe
 * Neuer File-header.
 *
 * Revision 1.3  1993/07/13  20:30:59  mringe
 * Neue File i/o library.
 *
 * Revision 1.2  1993/02/17  11:16:12  mringe
 * Include-Files...
 *
 * Revision 1.1  1993/02/10  19:40:54  mringe
 * Initial revision
 *
 * Revision 1.5  1992/07/22  07:10:30  mringe
 * Changed 'global.h' to 'lattice.h'
 *
 * Revision 1.4  1992/07/15  09:25:55  mringe
 * Some minor changes.
 *
 * Revision 1.3  1992/07/10  15:21:55  mringe
 * Typdeklarationen aus Arugumentlisten entfernt.
 *
 * Revision 1.2  1992/05/29  07:29:53  mringe
 * Neu: permpower()
 *
 * Revision 1.1  1992/05/26  18:34:08  mringe
 * Initial revision
 *
 */

#include <stdlib.h>
#include "meataxe.h"


/* ------------------------------------------------------------------
   permdesc() - Describe
   ------------------------------------------------------------------ */
    
char *permdesc(p)
perm_t *p;

{
    static char buf[50];
    sprintf(buf,"permutation of degree %ld",p->deg);
    return buf;
}

/* ------------------------------------------------------------------
   permalloc() - Allocate a permutation
   permfree() - Free a permutation
   ------------------------------------------------------------------ */

perm_t *permalloc(deg)
long deg;

{
    perm_t *p;

    p = (perm_t *)malloc(sizeof(perm_t));
    if (p == NULL)
    {
	MTXFAIL(ERR_NOMEM,NULL);
    }
    p->id = T_PERM;
    p->deg = deg;
    p->d = (PTR) malloc(deg * sizeof(long));
    if (p == NULL)
    {
	free(p);
	MTXFAIL(ERR_NOMEM,NULL);
    }
    return p;
}


void permfree(p)
perm_t *p;

{	free(p->d);
	free(p);
}


/* ------------------------------------------------------------------
   permdup() - Duplicate a permutation
   permmove() - Move a permutation
   ------------------------------------------------------------------ */

perm_t *permdup(src)
perm_t *src;

{
    perm_t *p;

    p = permalloc(src->deg);
    if (p == NULL) return NULL;
    memcpy(p->d,src->d,zsize((long)1));
    return p;
}

perm_t *permmove(dest, src)
perm_t *dest, *src;

{
    if (dest->deg != src->deg)
	MTXFAIL(ERR_INCOMPAT,NULL);
    memcpy(dest->d,src->d,(size_t) src->deg * sizeof(long));
    return dest;
}


/* ------------------------------------------------------------------
   permread() - Read a permutation
   permwrite() - Write a permutation
   ------------------------------------------------------------------ */
   
perm_t *permread(f)
FILE *f;

{
    perm_t *p;
    long hdr[3];

    if (zreadlong(f,hdr,3) != 3) MTXFAIL(ERR_FILEREAD,NULL);
    if (hdr[0] != -1) MTXFAIL(ERR_NOTPERM,NULL);
    p = permalloc(hdr[1]);
    if (p == NULL) return NULL;
    if (zreadlong(f,(long *)p->d,hdr[1]) != hdr[1])
    {
	permfree(p);
	MTXFAIL(ERR_FILEREAD,NULL);
    }
    return p;
}


int permwrite(f, perm)
FILE *f;
perm_t *perm;

{
    long hdr[3];

    hdr[0] = -1;
    hdr[1] = perm->deg;
    hdr[2] = 1;
    if (zwritelong(f,hdr,3) != 3) 
	MTXFAIL(ERR_FILEWRITE,-1);
    if (zwritelong(f,(long *)perm->d,hdr[1]) != hdr[1])
    	MTXFAIL(ERR_FILEWRITE,-1);
    return 0;
}



/* ------------------------------------------------------------------
   permload() - Read a permutation
   permsave() - Write a permutation
   ------------------------------------------------------------------ */

perm_t *permload(fn)
char *fn;

{
    FILE *f;
    perm_t *p;

    if ((f = os_fopen(fn,FM_READ)) == NULL)
    {
	perror(fn);
	errexit(ERR_FILEREAD,fn);
    }
    p = permread(f);
    if (p == NULL) errexit(ERR_FILEREAD,fn);
    fclose(f);
    return p;
}


int permsave(perm, fn)
perm_t *perm;
char *fn;

{
    FILE *f;
    int result;

    if ((f = os_fopen(fn,FM_CREATE)) == NULL)
    {
	perror(fn);
	errexit(ERR_FILEREAD,fn);
    }
    result = permwrite(f,perm);
    fclose(f);
    if (result != 0) errexit(ERR_FILEREAD,fn);
    return result;
}


/* ------------------------------------------------------------------
   permmul() - Multiply permutations
   ------------------------------------------------------------------ */

perm_t *permmul(dest, src)
perm_t *dest;
perm_t *src;

{
    long i;
    long *d = (long *)dest->d;
    long *s = ((long *)src->d)-1;

    if (dest->deg != src->deg)
    {
	MTXFAIL(ERR_INCOMPAT,NULL);
    }
    for (i = dest->deg; i > 0; --i)
    {
	*d = s[*d];
	++d;
    }
    return dest;
}


/* ------------------------------------------------------------------
   permorder() - Order of a permutation
   ------------------------------------------------------------------ */

long permorder(perm)
perm_t *perm;

{	long ord = 1, tord;
	long *p = ((long *)perm->d) -1;
	long i, j, k;

	while (1)
	{	for (i = 1; i <= perm->deg && p[i] < 0; ++i);
		if (i > perm->deg) break;
		j = i;
		tord = 0;
		do { k = p[i]; p[i] = -p[i]; i = k; ++tord; }
		while (j != i);
		
		i = ord;
		j = tord;
		while (1)
		{	if ((i %= j) == 0)
			{	k = j; break;
			}
			if ((j %= i) == 0)
			{	k = i; break;
			}
		}
		ord = ord / k * tord;
	}
	for (i = 1; i <= perm->deg; ++i) p[i] = -p[i];
	return ord;
}


/* ------------------------------------------------------------------
   permpower() - Power of a permutation
   ------------------------------------------------------------------ */

perm_t *permpower(p,n)
perm_t *p;
long n;

{	perm_t *q = permalloc(p->deg);
	long *xp = (long *)(p->d) - 1;
	long *xq = (long *)(q->d) - 1;
	long i, k, l;

	for (i = 1; i <= p->deg; ++i)
	{	for (k = i, l = n; l > 0; --l)
			k = xp[k];
		xq[i] = k;
	}
	return q;
}



