GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
# include <stdio.h>1extern char wrd,nt,isbase,inf[],outf1[],outf2[],fixed[];2extern int perm[],sv[],cp[],actgen[],orb[],3base[],lorb[],order[],pno[], *pptr[],*svptr[],4mp,mb,mnpt;5extern int psp,svsp;6int npt;7FILE *fopen(),*ip,*op;89/* The data structures in this program are similar to most permutation group10programs. Permutations are numbered 0,1,2,3,... (where 2x+1 is usually the11inverse of 2x) and stored in the array perm. Perm no x is pointed to by12pptr[x]. npt=no. of points. Usually pptr[i][npt+1] gives the number of the13group in the stabilizer chain in which the perm lies. So this no is i if the14perm fixes the first i-1 base points. nb=no of base points.15The base and the lengths of the orbits in the stab chain are stored in base16and lorb.17Schreier vectors are stored in sv, and pointed to by svptr[i], i=1,..,nb.18pno is a list of *pno (=pno[0]) perm nos.19cp is a similar list of length *cp, but it is used to represent the product20of the perms cp[1]cp[2]..cp[*cp]. This product can be evaluated by the21procedure image in permfns.c22*/23int24gpprog (void)25{ int i,j,k,l,m,n,nperms,nb,jobt,np2,seek,cord,ocord,given,ordknown,trivrel,26lsv,u,v,w,x,y,z,mxp,mnb,bpt,bno,id;27int quot;28float grporder;2930if ((ip=fopen(inf,"r"))== 0)31{ fprintf(stderr,"Cannot open file %s\n",inf); return(-1); }32fscanf(ip,"%d%d%d%d",&npt,&nperms,&nb,&jobt);33if (npt>mnpt) { fprintf(stderr,"npt too big. Increase NPT.\n"); return(-1); }34if (jobt>0) { fprintf(stderr,"Wrong input format.\n"); return(-1); }35quot=psp/(npt+1); if (quot>mp) quot=mp; mxp=quot;36quot=svsp/npt; if (quot>mb) quot=mb; mnb=quot; if (mnb>=npt) mnb=npt-1;37if (nb>mnb)38{ fprintf(stderr,"nb to big. Increase SVSP (or MB).\n"); return(-1); }39/* pptr[i] is the i th permutation, svptr[i] is the i the Schreier vector. */40for (i=0;i<mxp;i++) pptr[i]=perm+i*(npt+1)-1;41for (i=1;i<=mnb;i++) svptr[i]=sv+(i-1)*npt-1;4243/* Next we read any base points and orbit lengths */44if (nb!=0)45{ for (i=1;i<=npt;i++) orb[i]=0;46for (i=1;i<=nb;i++)47{ fscanf(ip,"%d",base+i); if (orb[base[i]]!=0)48{ fprintf(stderr,"Repeated base element.\n"); return(-1); }49orb[base[i]]=1;50}51}52if (jobt<0)53{ jobt= -jobt; if (jobt>nb) {fprintf(stderr,"jobt too big.\n"); return(-1); }54seek=jobt; given=jobt; ordknown=1;55for (i=1;i<=jobt;i++) fscanf(ip,"%d",order+i);56}57else ordknown=0;5859/* Now we read the generating permutations */60np2=2*nperms-2;61for (i=0;i<=np2;i+=2)62{ k=i/2 +1; j=readperm(pptr[i]);63if (j==2)64{ fprintf(stderr,"Generator no %d is not a permutation.\n",k); return(-1); }65if (j==1)66{ fprintf(stderr,"Generator no %d is the identity.\n",k);67if (nt) return(-1);68nperms-=1; np2-=2; i-=2;69}70else71{ invert(pptr[i],pptr[i+1]); actgen[i]=1; x=1;72for (z=base[x];x<=nb && pptr[i][z]==z;z=base[x]) x++;73pptr[i][npt+1]=x;74if (x>nb)75{ if (isbase)76{ fprintf(stderr,"Given base is not a base!\n"); return(-1);}77nb++; for (z=1;pptr[i][z]==z;z++); base[nb]=z;78printf("New base element no %d is %d.\n",nb,z);79}80if (x==1) printf("Generator no %d moves first base point.\n",k);81else printf("Generator no %d fixes first %d base point(s).\n",k,x-1);82}83if (nperms==0) { fprintf(stderr,"Trivial group!\n"); return(-1); }84}85fclose(ip);8687if (wrd) {op=fopen(outf2,"w"); fprintf(op,"%4d\n",nperms); }88bno=nb; for (i=0;i<=mnb;i++) lorb[i]=0;8990/* Now the main algorithm begins */91loop:92*pno=0; if (ordknown) ocord= (bno==nb) ? 1 : order[bno+1];93/* We make a list of the perm nos that fix the first bno-1 base pts */94for (i=0;i<=np2;i+=2)95{ if (pptr[i][npt+1]>=bno && actgen[i]<=bno)96{ (*pno)++; pno[*pno]=i; }97}98lorb[bno]=orbitsv(base[bno],svptr[bno],0);99if (ordknown)100{ cord= (bno>=given) ? ocord*lorb[bno] : lorb[bno];101if (bno==seek && cord==order[bno])102{ seek--; printf("Order is now as given for bno = %d.\n",bno);103bno--; if (bno==0) goto foundorder; goto loop;104}105}106/* Now we start generating the Schreier generators that fix the firat bno107base points, test them for membership, and add them as new generators108if necessary.109*/110if (*pno!=0)111{ nperms++; np2+=2; y=np2+1;112if (y>=mxp)113{fprintf(stderr,"Out of space. Increase PSP (or MP).\n"); return(-1); }114for (i=1;i<=npt;i++) fixed[i]=0;115for (i=1;i<bno;i++)116{ u=base[i]; fixed[u]=1; pptr[np2][u]=u; pptr[y][u]=u; }117for (i=1;i<=lorb[bno];i++)118{ *cp=0; addsv(orb[i],svptr[bno]);119for (w=1,x= *cp;w<=x;w++,x--)120{ if (w==x) cp[w]-=1; else {u=cp[w]; cp[w]=cp[x]-1; cp[x]=u-1;}}121lsv= *cp;122for (j=1;j<=*pno;j++)123{ *cp=lsv; u=pno[j]+1;124trivrel = (*cp>0) ? cp[*cp]==(u-1) : 0;125if (trivrel==0)126{ (*cp)++; cp[*cp]=u; id=0;127for (l=bno;l<=nb;l++) fixed[base[l]]=0;128for (l=bno;l<=nb;l++)129{ v=base[l]; u=image(v);130if (svptr[l][u]==0) goto newgen;131addsv(u,svptr[l]); pptr[np2][v]=v; pptr[y][v]=v; fixed[v]=1;132}133l=nb+1; id=1;134newgen: if (isbase==0)135for (k=1;k<=npt;k++)136{ if (fixed[k]==0)137{ u=image(k); pptr[np2][k]=u; pptr[y][u]=k;138if (id && k!=u)139{ id=0; nb++;140if (nb>mnb) { fprintf(stderr,"nb to big. Increase SVSP (or MB).\n"); return(-1); }141base[nb]=k;142printf("New base point no %d is %d.\n",nb,k);143}144}145}146if (id==0)147{ pptr[np2][npt+1]=l; actgen[np2]=bno+1;148if (isbase) for (k=1;k<=npt;k++)149{ u=image(k); pptr[np2][k]=u; pptr[y][u]=k;}150printf("New generator no %d, fixing first %d base pts is:\n",151nperms,l-1);152for (m=1;m<=*cp;m++)153{ z=cp[m]; y=z/2; x= (z==2*y) ? y+1 : -(y+1);154printf("%3d",x); if (m== *cp) printf("\n"); else printf("*");155}156if (wrd)157{for (m=0;m<=*cp;m++) fprintf(op,"%4d",cp[m]);fprintf(op,"\n");}158bno=l; goto loop;159}160}161}162}163nperms--; np2-=2;164}165if (ordknown && bno>given) order[bno]=cord;166bno--;167168foundorder:169if (bno==0)170{ printf("The order of the group is:\n");171for (i=1;i<=nb;i++)172{ printf("%3d",lorb[i]);173if (i==nb) printf(" =\n"); else printf("*");174}175grporder=1; for (i=1;i<=nb;i++) grporder *= lorb[i];176printf("%g\n",grporder);177}178else goto loop;179if (wrd) { fprintf(op,"%d\n",-1); fclose(op); }180181/* Now we output the generating perms and Schreier vectors */182op=fopen(outf1,"w");183fprintf(op,"%4d%4d%4d%4d\n",npt,nperms,nb,1);184printbaselo(nb,base,lorb); *pno=0;185for (i=1;i<=nperms;i++) {(*pno)++; pno[*pno]=2*(i-1);}186printpsv(nb,pno,svptr);187fclose(op); return(0);188}189190191