GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include"typedef.h"1/**************************************************************************\2@---------------------------------------------------------------------------3@---------------------------------------------------------------------------4@ FILE: orbit_subdivision.c5@---------------------------------------------------------------------------6@---------------------------------------------------------------------------7@8\**************************************************************************/91011typedef struct {12int dim;13int len;14int n;15int **v;16} veclist;1718static int *st_w;192021static void vecmatmul(x, A, y, dim)22int *x, **A, *y, dim;23{24int i, j, xi, *Ai;2526for (j = 0; j < dim; ++j)27y[j] = 0;28for (i = 0; i < dim; ++i)29{30if ((xi = x[i]) != 0)31{32Ai = A[i];33for (j = 0; j < dim; ++j)34y[j] += xi * Ai[j];35}36}37}3839static int comp(x, y, n)40int *x, *y, n;41{42int i;4344for (i = 0; i < n && x[i] == y[i]; ++i);45if (i == n)46return(0);47else if (x[i] > y[i])48return(1);49else50return(-1);51}5253static int numberof(vec, V)54veclist V;55int *vec;56{57int i, sign, dim, low, high, search, cmp;5859sign = 1;60dim = V.dim;61low = 1;62high = V.n;63for (i = 0; i < dim && vec[i] == 0; ++i);64if (i < dim && vec[i] < 0)65{66sign = -1;67for (i = 0; i < dim; ++i)68vec[i] *= -1;69}70while (low <= high)71{72search = low + (high-low)/2;73cmp = comp(vec, V.v[search], dim);74if (cmp == 1)75low = search + 1;76else if (cmp == -1)77high = search - 1;78else79return(sign * search);80}81return(sign * (V.n+low));82}83848586static void quicksort(v, inf, sup, dim) /***** standard quicksort *****/87int **v, inf, sup, dim;88{89int *tmp, low, med, high;9091if(inf+1 < sup)92{93/* interchange v[inf] and v[med] to avoid worst case for pre-sorted lists */94med = (inf+1+sup)/2;95tmp = v[inf];96v[inf] = v[med];97v[med] = tmp;98low = inf+1;99high = sup;100while(low < high)101{102while(comp(v[inf], v[low], dim) >= 0 && low < sup)103++low;104while(comp(v[inf], v[high], dim) <= 0 && high > inf)105--high;106if(low < high)107{108tmp = v[high];109v[high] = v[low];110v[low] = tmp;111}112}113if(inf != high)114{115tmp = v[high];116v[high] = v[inf];117v[inf] = tmp;118}119quicksort(v, inf, high-1, dim);120quicksort(v, high+1, sup, dim);121}122if(inf+1 == sup)123{124if(comp(v[inf], v[sup], dim) == 1)125{126tmp = v[inf];127v[inf] = v[sup];128v[sup] = tmp;129}130}131}132133static void sortvecs(V)134veclist *V;135{136int i, j;137138quicksort(V->v, 1, V->n, V->dim);139j = 1;140for (i = 1; i+j <= V->n; ++i)141{142while (i+j <= V->n && comp(V->v[i], V->v[i+j], V->dim) == 0)143{144free(V->v[i+j]);145++j;146}147if (i+j <= V->n)148{149V->v[i+1] = V->v[i+j];150if (comp(V->v[i], V->v[i+1], V->dim) == 1)151{152fprintf(stderr, "Error: v[%d] > v[%d]\n", i, i+1);153exit (3);154}155}156}157V->n -= j-1;158}159160161static int operate(nr, A, V)162veclist V;163int nr, **A;164{165int i, im;166167vecmatmul(V.v[abs(nr)], A, st_w, V.dim);168if (nr < 0)169{170for (i = 0; i < V.dim; ++i)171st_w[i] *= -1;172}173/**********************************174for(i=0;i<V.dim;i++)175printf("%d ", st_w[i]);176printf("\n");177**********************************/178im = numberof(st_w, V);179if (abs(im) > V.n)180{181fprintf(stderr, "Error: image of vector %d not found\n", nr);182exit (3);183}184return(im);185}186187188189190/**************************************************************************\191@---------------------------------------------------------------------------192@ int *orbit_subdivision(vecs, G, orbit_no)193@ matrix_TYP *vecs;194@ bravais_TYP *G;195@ int *orbit_no;196@197@ 'orbit_subdivision' calculates representatives of the orbit198@ of the group 'G' on the rows of the matrix 'vecs'199@ The action is assumed to be v -> vg^{tr} for v a row of 'vecs'200@ and g in 'G'.201@ It is assumed that -Identity is an element of 'G'202@ and for a row v the -v must not be contained as a row of 'vecs'.203@ Furthermore it is assumed, that the rows of 'vecs' are closed under204@ the action of 'G', so if vg^{tr} or -vg^{tr} is no row of 'vecs'205@ the programm exits (v rows of 'vecs'. g in 'G').206@207@ The number of orbits is returned via (int *orbit_no) and208@ the result is a pointer to integer of length 'orbit_no'209@ where the i-th entry of this pointer is the number of the210@ row of 'vecs' that is an representative of the i-th orbit.211@212@---------------------------------------------------------------------------213@214\**************************************************************************/215int *orbit_subdivision(vecs, G, orbit_no)216matrix_TYP *vecs;217bravais_TYP *G;218int *orbit_no;219{220veclist V;221int i, j, k, n, dim, nG, orblen, orbsum, orbnr, im, cnd;222int *orb, *flag, ***grp;223int *Vvi;224225nG = G->gen_no;226dim = G->gen[0]->cols;227V.dim = dim;228V.len = vecs->cols;229V.n = vecs->rows;230if ((orb = (int*)malloc(V.n * sizeof(int))) == 0)231exit (2);232if ((flag = (int*)malloc((V.n + 1) * sizeof(int))) == 0)233exit (2);234for (i = 0; i <= V.n; ++i)235flag[i] = 0;236if ((st_w = (int*)malloc(V.dim * sizeof(int))) == 0)237exit (2);238if ((V.v = (int**)malloc(((V.n)+1) * sizeof(int*))) == 0)239exit (2);240for(i=0;i<V.n;i++)241V.v[i+1] = vecs->array.SZ[i];242if( (grp = (int ***)malloc(nG *sizeof(int **))) == NULL)243{244printf("malloc of 'grp' in 'orbit_subdivision' failed\n");245exit(2);246}247for(i=0;i<nG;i++)248{249if( (grp[i] = (int **)malloc(dim *sizeof(int *))) == NULL)250{251printf("malloc of 'grp[%d]' in 'orbit_subdivision' failed\n",i);252exit(2);253}254for(j=0;j<dim;j++)255{256if( (grp[i][j] = (int *)malloc(dim *sizeof(int))) == NULL)257{258printf("malloc of 'grp[%d][%d]' in 'orbit_subdivision' failed\n", i, j);259exit(2);260}261for(k=0;k<dim;k++)262grp[i][j][k] = G->gen[i]->array.SZ[k][j];263}264}265for (i = 1; i <= V.n; ++i)266{267Vvi = V.v[i];268for (j = 0; j < V.dim && Vvi[j] == 0; ++j);269if (j < V.dim && Vvi[j] < 0)270{271for (j = 0; j < V.dim; ++j)272Vvi[j] *= -1;273}274}275sortvecs(&V);276for (i = 1; i <= V.n; ++i)277vecs->array.SZ[i-1] = V.v[i];278orbsum = 0;279orbnr = 1;280while (orbsum < 2*V.n)281{282for (i = 1; i <= V.n && flag[i] != 0; ++i);283orb[0] = i;284flag[i] = orbnr;285orblen = 1;286cnd = 0;287while (cnd < orblen)288{289for (i = 0; i < nG; ++i)290{291im = abs(operate(orb[cnd], grp[i], V));292if (flag[im] == 0)293{294++orblen;295orb[orblen-1] = im;296flag[im] = orbnr;297}298}299++cnd;300}301/**********************************302for (i = 0; i < V.dim; ++i)303printf(" %2d", V.v[orb[0]][i]);304printf("\t Length %d\n", 2*orblen);305**********************************/306orbsum += 2*orblen;307++orbnr;308}309*orbit_no = orbnr-1;310311/* inserted the next 8 lines 15/1/97 */312for (i=0;i<nG;i++){313for (j=0;j<dim;j++){314free(grp[i][j]);315}316free(grp[i]);317}318free(grp);319free(V.v);320321free(orb);322free(st_w);323for (i = 1; i <= V.n; ++i)324flag[i-1] = flag[i];325return(flag);326}327328329