GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include "typedef.h"1#include "matrix.h"2#include "gmp.h"3#include "zass.h"4#include "getput.h"567extern int INFO_LEVEL;8910static int and(int *a,int n)11{12int i;1314for (i=0;i<n;i++) if (a[i] == FALSE) return FALSE;1516return TRUE;17}181920static int cmp_red(matrix_TYP *x,matrix_TYP *y)21{22int i,23j,24rows,25cols;2627if (x->cols < y->cols)28cols = x->cols;29else30cols = y->cols;3132if (x->rows < y->rows)33rows = x->rows;34else35rows = y->rows;3637for (i=0;i<cols;i++)38for (j=0;j<rows;j++){39if (x->array.SZ[i][j] < y->array.SZ[i][j]) return -1;40if (x->array.SZ[i][j] > y->array.SZ[i][j]) return 1;41}4243return 0;44}454647static int red_pos(matrix_TYP *x,48matrix_TYP **A,49struct tree *knoten,50int n,51int flag)52{53int erg;5455erg = cmp_red(x,A[knoten->no]);5657if (erg == 1){58if (knoten->right == NULL){59if (flag == 1){60knoten->right = (struct tree *) calloc(1,sizeof(struct tree));61knoten->right->no = n;62return(n);63}64if (flag == 0){65knoten->right = (struct tree *) calloc(1,sizeof(struct tree));66knoten->right->no = n;67return(-1);68}69if (flag == (-1)){70return(-1);71}72}73else{74return(red_pos(x,A,knoten->right,n,flag));75}76}77if (erg == (-1)){78if (knoten->left == NULL){79if (flag == 1){80knoten->left = (struct tree *) calloc(1,sizeof(struct tree));81knoten->left->no = n;82return(n);83}84if (flag == 0){85knoten->left = (struct tree *) calloc(1,sizeof(struct tree));86knoten->left->no = n;87return(-1);88}89if (flag == (-1)){90return(-1);91}92}93else{94return(red_pos(x,A,knoten->left,n,flag));95}96}97if (erg == 0){98return(knoten->no);99}100}101102/**********************************************************************103@104@----------------------------------------------------------------------105@106@ matrix_TYP *reget_gen(matrix_TYP **map,int number,bravais_TYP *G,107@ int **words,int word_flag)108@109@----------------------------------------------------------------------110@111***********************************************************************/112matrix_TYP *reget_gen(matrix_TYP **map,int number,bravais_TYP *G,113int **words,int word_flag)114{115int *found, /* gives a flag for each generator of G, TRUE iff116we already found this element */117length = number, /* the number of elements found so far */118speicher = MIN_SPEICHER,119k,120i,121j;122123int **ele_words; /* for each matrix in ele we store a word in the124generators here which gives this element:125a general convention for the use of words:126word[0] stores the length of the word */127128matrix_TYP *erg,129**ele,130*tmp;131132struct tree *baum,133*baum2;134135136baum = (struct tree *) calloc(1,sizeof(struct tree));137baum2 = (struct tree *) calloc(1,sizeof(struct tree));138139erg = init_mat(G->gen_no * G->dim,1,"");140141/* changed tilman 15/07/99 from142for (i=0;i<G->gen_no;i++) to: */143for (i=0;i<number;i++)144Check_mat(map[i]);145146/* there are to cases: the function is called the first time147for this generating set, then we have to calculate orbits and so on,148otherwise we already got the desired words in words */149if (word_flag == TRUE){150found = (int *) calloc(G->gen_no+1 , sizeof(int));151found++;152ele = (matrix_TYP **) malloc(MIN_SPEICHER * sizeof(matrix_TYP *));153ele_words = (int **) malloc(MIN_SPEICHER * sizeof(int*));154155for (i=0;i<G->gen_no;i++){156red_pos(G->gen[i],G->gen,baum,i,1);157}158for (i=0;i<G->gen_no;i++)159Check_mat(G->gen[i]);160161/* changed tilman 15/07/99 from162for (i=0;i<G->gen_no;i++){ to */163for (i=0;i<number;i++){164ele[i] = map[i];165k = red_pos(ele[i],G->gen,baum,i,-1);166found[k] = TRUE;167ele[i]->cols--; ele[i]->rows--;168red_pos(ele[i],ele,baum2,i,1);169ele[i]->cols++; ele[i]->rows++;170ele_words[i] = (int *) malloc(2 * sizeof(int));171ele_words[i][0] = 1;172ele_words[i][1] = i;173}174175176for (i=0;i<length && !and(found,G->gen_no);i++){177for (j=0;j<number;j++){178tmp = mat_mul(ele[i],map[j]);179tmp->cols--;tmp->rows--; /* for red_pos */180if (red_pos(tmp,ele,baum2,length,0) == (-1)){181tmp->cols++;tmp->rows++;182183if (length >= speicher){184speicher = speicher + MIN_SPEICHER;185ele = (matrix_TYP **) realloc(ele,186speicher*sizeof(matrix_TYP *));187ele_words = (int **) realloc(ele_words,188speicher*sizeof(int *));189}190191/* we found an new element of the orbit,192set the matrix and the word */193ele[length] = tmp;194ele_words[length] = (int *) malloc((ele_words[i][0]+2)195* sizeof(int*));196memcpy(ele_words[length],ele_words[i],197(ele_words[i][0]+1) * sizeof(int));198ele_words[length][0] = ele_words[i][0]+1;199ele_words[length][ele_words[length][0]] = j;200length++;201202/* it might be one of the generators we are looking for */203found[red_pos(tmp,G->gen,baum,G->gen_no,-1)] = TRUE;204}205else{206tmp->cols++;tmp->rows++;207free_mat(tmp);208}209}210}211212if (!and(found,G->gen_no)){213fprintf(stderr,"reget_gen: shouldn't happen\n");214exit(3);215}216217/* now calculate the resulting cozycle alltogether */218for (i=0;i<G->gen_no;i++){219k = red_pos(G->gen[i],ele,baum2,length,-1);220tmp = ele[k];221words[i] = ele_words[k];222ele_words[k] = NULL;223if (INFO_LEVEL & 16){224printf("length %d \n",length);225printf("red_pos %d \n",k);226Check_mat(tmp);227put_mat(tmp,NULL,"tmp",2);228put_mat(G->gen[i],NULL,"G->gen[i]",2);229printf("word[%d]\n c ",i);230for (j=1;j<=words[i][0];j++)231printf("%d ",words[i][j]+1);232printf("\n");233}234for (j=0;j<G->dim;j++){235erg->array.SZ[i*G->dim +j][0] = tmp->array.SZ[j][G->dim];236}237}238239/* cleaning up memory */240found--;241free(found);242/* changed on 16/07/99 from:243for (i=G->gen_no;i<length;i++) free_mat(ele[i]); to */244for (i=number;i<length;i++) free_mat(ele[i]);245free(ele);246for (i=0;i<length;i++) if (ele_words[i] != NULL) free(ele_words[i]);247free(ele_words);248}249else{250/* we are in the briliant position to know how the element looks251like */252for (i=0;i<G->gen_no;i++){253tmp = copy_mat(map[words[i][1]]);254for (j=2;j<=words[i][0];j++)255mat_muleq(tmp,map[words[i][j]]);256257/* calculate the part of the cozycle belonging to the i-th258generator */259for (j=0;j<G->dim;j++)260erg->array.SZ[i*G->dim +j][0] = tmp->array.SZ[j][G->dim];261262if (INFO_LEVEL & 16){263printf("reget of %d-th generator\n",i+1);264put_mat(tmp,NULL,NULL,2);265}266267/* clean up tmp */268free_mat(tmp);269}270}271free_tree(baum);272free_tree(baum2);273274return erg;275} /* reget_gen(....) */276277278279280