GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include <stdio.h>1extern char inf1[],inf2[],inf3[],outf1[],outf2[],outf3[],temp1[],temp2[],2expg,exph,cr,dcr,triv;3extern int psp,trsp,svsp;4extern int mpt,mb,5tree[],perm[],gorb[],lorbg[],lorbh[],base[],6fpt[],bpt[],coh_index[],*cp[],*trad[],*sv[],7*tailad[],**cpad[],**svgptr[],**svhptr[];8int trptr;9int npt,**lcp,**ucp,*stop,dummy,*pst,*pend,nb,fnt,lnt,10ind,coind,oind,cind,bno,pt,**expp,npg;11FILE *fopen(),*ip,*op,*opx;1213/* The data structures of this program differ from other permutation group14programs. Permutations are not numbered, but are located by their base15adresses. Consequently, arrays sv and cp are arrays of pointers. The16current permutation in cp is stored in the middle of cp (since it has to be17expanded in both directions), between adresses lcp and ucp of cp.18The next six procedures are the equivlents of the corresponding ones19in permfns.c, but addsv can go in both directions.20In this half of the program, coset reps of H in G are computed.21*/2223int24image (int pt)25{ int **p;26p=lcp;27while (p<=ucp) {pt=(*p)[pt]; p++;}28return(pt);29}3031int32addsvb (int pt, int **sv)33{ int *p;34while ((p=sv[pt])!=stop) {pt=p[pt]; lcp--; *lcp =p-npt; }35}3637int38addsvf (int pt, int **sv)39{ int *p;40while ((p=sv[pt])!=stop) {pt=p[pt]; ucp++; *ucp=p; }41}4243int44invert (int *a, int *b)45{int i; for (i=1;i<=npt;i++) b[a[i]]=i; }4647int48rdperm (int *a, int *b)49{ int i,*r;50for (i=1;i<=npt;i++) fscanf(ip,"%d",a+i);51r=pst+1; fscanf(ip,"%d",r); invert(a,b);52}5354int55rdsv (int **sv)56{ int i,j;57for (i=1;i<=npt;i++)58{ fscanf(ip,"%d",&j); sv[i]= (j==0) ? 0 : (j== -1) ? stop : cp[j];}59}6061int62cnprg1 (void)63{ int i,j,k,ad,sad,nph,*svpt,*p1,*p2,**csvg,**csvh,nexp;64char pthere,w,ok,allok; long fac;65stop = &dummy;66if ((ip=fopen(inf1,"r"))==0)67{ fprintf(stderr,"Cannot open %s.\n",inf1); return(-1); }68fscanf(ip,"%d%d%d%d",&npt,&npg,&nb,&k);69if (npt>mpt) {fprintf(stderr,"npt too big. Increase mpt.\n"); return(-1); }70if (nb>=mb) {fprintf(stderr,"nb too big. Increase MB.\n"); return(-1); }71if (2*nb*npt>svsp)72{ fprintf(stderr,"svsp too small. Increase SVSP.\n"); return(-1); }73if (k<=0) {fprintf(stderr,"Wrong input format for G.\n"); return(-1); }74for (i=1;i<=nb;i++) fscanf(ip,"%d",base+i);75for (i=1;i<=nb;i++) fscanf(ip,"%d",lorbg+i);76pst=perm-1; pend=perm+psp-1;77if (pst+2*npg*npt>pend)78{ fprintf(stderr,"Out of space.Increase PSP.\n"); return(-1);}79for (i=1;i<=npg;i++)80{ p1=pst; p2=pst+npt; pst+=(2*npt); rdperm(p1,p2); cp[2*i-1]=p2; }81for (i=1;i<=nb;i++) {svgptr[i]=sv+npt*(i-1)-1; rdsv(svgptr[i]); }82fclose(ip);83/* G is read. Now read the subgroup H */84if (triv)85{ nph=0; for (i=1;i<=nb;i++)86{ lorbh[i]=1; svhptr[i]=sv+npt*(nb+i-1)-1;87for (j=1;j<=npt;j++) svhptr[i][j]=0; svhptr[i][base[i]]=stop;88}89}90else91{ if ((ip=fopen(inf2,"r"))==0)92{ fprintf(stderr,"Cannot open %s.\n",inf2); return(-1); }93fscanf(ip,"%d%d%d%d",&i,&nph,&j,&k); w=0;94if (k<=0) { fprintf(stderr,"Wrong input format for H.\n"); return(-1); }95if (i!=npt || j!=nb) w=1;96else for (i=1;i<=nb;i++)97{ fscanf(ip,"%d",lorbh+i); if (lorbh[i]!=base[i]) w=1; }98if (w)99{ fprintf(stderr,"npt or base for G and H do not agree.\n");return(-1);}100for (i=1;i<=nb;i++) fscanf(ip,"%d",lorbh+i);101if (pst+2*npt*nph+2>pend)102{ fprintf(stderr,"Out of space.Increase PSP.\n"); return(-1);}103for (i=1;i<=nph;i++)104{ p2=pend-npt; p1=p2-npt; pend-=(2*npt); rdperm(p1,p2); cp[2*i-1]=p2;}105for (i=1;i<=nb;i++) {svhptr[i]=sv+npt*(nb+i-1)-1; rdsv(svhptr[i]); }106fclose(ip);107}108for (i=1;i<=nb;i++) fpt[i]=0;109p1=pst; p2=p1+npt; pst+=(2*npt); lcp=cp; expp= cp+2*npt-1;110cind=1; fac=1; coh_index[nb+1]=1; lnt=0;111112/* Now we compute the indices of H in G in the stabilizer chain into the array113coh_index. The nontrivial indices are linked by fpt and bpt.114*/115for (i=nb;i>=1;i--)116{ j=lorbg[i]; fac=fac*j; j=lorbh[i]; fac=fac/j; ind=fac; coh_index[i]=ind;117if (ind>coh_index[i+1])118{ if (lnt==0) lnt=i;119else { fpt[i]=fnt; bpt[fnt]=i; }120fnt=i;121}122}123bpt[fnt]= -1; fpt[lnt]= -1;124printf("Indices: ");125for (i=1;i<=nb;i++) printf("%5d",coh_index[i]); printf("\n");126if (ind==1) { fprintf(stderr,"G=H.\n"); return(-1); }127nexp=0; ind=1; oind=1; trptr=0;128129/* Now we start the backtrack search for the left coset reps of H in G. The130necessary information about these is stored in the array tree. This is done131so as to make it as easy as possible to compute which coset an arbitrary132element of G lies in. If expg is true, then those perms in G which arise133are expanded and stored.134If dcr is true, then a small subset of the coset reps will need to be135output as perms, later. For this purpose, the base images of all coset reps136are output to a temporary file.137ind is the current coh_index coh_index[bno], and cind is the no of coset reps138found so far.139*/140for (i=fnt;i!= -1;i=fpt[i])141{ trad[i]=tree+trptr; tree[trptr]=base[i]; trptr+=2; }142if (dcr) opx=fopen(temp2,"w");143if (cr)144{ op=fopen(outf3,"w");145fprintf(op,"%4d %d%4d%4d\n",npt,coh_index[1]-1,0,0);146}147sad=trptr; tree[trptr]=1; trptr++;148for (bno=lnt;bno!= -1;bno=bpt[bno])149{ printf("bno=%d.\n",bno);150*gorb=1; gorb[1]=base[bno];151ind=coh_index[bno]; csvg=svgptr[bno]; csvh=svhptr[bno];152allok=(lorbh[bno]==1);153/* if allok, then all coset reps in this link of the stabilizer chain will be154coset reps of H in G.155*/156if (expg) {for (i=1;i<=npt;i++) expp[i]=0; expp[base[bno]]=stop; }157for (pt=1;pt<=npt;pt++)158{ svpt=csvg[pt];159if (svpt!=0 && svpt!=stop)160{ ucp=lcp-1; addsvf(pt,csvg); pthere=0;161if (expg)162{ for (i=1;i<=npt;i++) p1[i]=image(i);163invert(p1,p2); ucp=lcp; *ucp=p1;164}165j=sad;166for (i=fpt[bno];i!= -1;i=fpt[i])167{ tailad[i]=tree+j; cpad[i]=ucp+1; j+=2; }168/* In the search, for each basic coset rep g in the stabilizer chain, we have169to try out gh as a possible coset rep of H in G, for each h in the list of170coset reps of H[bno-1] in G[bno-1]. coind and oind record the search171through this list.172*/173coind=1;174while (coind<=oind)175{ if (coind>1) advance(); ok=1;176if (allok==0)177for (i=1;i<=*gorb && ok;i++) if (csvh[image(gorb[i])]!=0) ok=0;178/* That was the membership test. ok true means we have found a new rep */179if (ok)180{ if (pthere)181{ ad=fpt[bno];182while (*tailad[ad]== *trad[ad]) ad=fpt[ad];183tree[trptr]= *tailad[ad];184}185else186{ pthere=1; ad=bno; tree[trptr]=pt;187if (expg)188{ expp[pt]=p1; p1=pst; p2=p1+npt; pst+=(2*npt); nexp++;189if (pst>pend)190{ fprintf(stderr,"Out of perm space. Increase PSP.\n");191return(-1);192}193}194}195*(trad[ad]+1)=trptr; trad[ad]=tree+trptr; trptr+=2;196for (i=fpt[ad];i!= -1;i=fpt[i])197{ *(trad[i]+1)= -1; tree[trptr]= *tailad[i];198trad[i]=tree+trptr; trptr+=2;199}200cind++; tree[trptr]=cind; trptr++;201if (trptr>trsp)202{ fprintf(stderr,"Out of tree space. Increase TRSP.\n");203return(-1);204}205if (dcr) for (i=fnt;i!= -1;i=fpt[i]) fprintf(opx,"%5d",*trad[i]);206/* if cr, then we output each coset rep */207if (cr)208if (npt>=1000)209{ for (i=1;i<=npt;i++) fprintf(op,"%5d",image(i));fprintf(op,"\n");}210else211{ for (i=1;i<=npt;i++) fprintf(op,"%4d",image(i));fprintf(op,"\n");}212if (cind==ind) goto nextbno;213} /* if (ok) */214coind++;215} /* while (coind<=oind) */216(*gorb)++; gorb[*gorb]=pt;217} /* if (svpt!=0 ... */218} /* for (pt=1;pt<=npt;... */219fprintf(stderr,"Premature end of search.\n"); return(-1);220nextbno:221if (expg) for (i=1;i<=npt;i++) svgptr[bno][i]=expp[i];222sad-=2; oind=ind;223} /* main bno loop */224if (dcr) fclose(opx); if (cr) fclose(op);225for (i=fnt;i!= -1;i=fpt[i]) *(trad[i]+1)= -1;226printf("Tree space used = %d.\n",trptr);227if (expg) printf("Number of perms expanded = %d.\n",nexp);228return(0);229}230231int232advance (void)233/* This advances the element h in the search through elements gh */234{ int ad,k,*p,*q;235ad=lnt;236while ((k= *(tailad[ad]+1)) == -1) ad=bpt[ad];237q=tree+k; ucp=cpad[ad]-1;238while (ad!= -1)239{ tailad[ad]=q; cpad[ad]=ucp+1;240if (expg) { p=svgptr[ad][*q]; if (p!=stop) {ucp++; *ucp=p; }}241else addsvf(*q,svgptr[ad]);242q+=2; ad=fpt[ad];243}244}245246247