egprog()
{ short nperms,ngens,nb,stab,olfb,nlfb,i,l,m,z,ct;
if (full)
{ if ((ip=fopen(inf2,"r"))==0)
{ printf("Cannot open %s.\n",inf2); return(-1); }
fscanf(ip,"%hd%hd",&i,&ngens);
fclose(ip);
}
if ((ip=fopen(inf,"r"))==0) { printf("Cannot open %s.\n",inf); return(-1); }
if (stabcall)
{ printf("Stabilize how many points? "); scanf("%hd",&stab);}
else stab=0;
fscanf(ip,"%hd%hd%hd%hd",&npt,&nperms,&nb,&l);
if (npt>mnpt) {fprintf(stderr,"npt,too big. Increase NPT.\n"); return(-1); }
if (nperms>mp)
{ fprintf(stderr,"nperms too big. Increase MXP.\n"); return(-1);}
if (nb>mb) {fprintf(stderr,"nb too big. Increase MNB.\n"); return(-1); }
if (l<=0) {fprintf(stderr,"Wrong input format.\n"); return(-1); }
for (i=0;i<=nperms;i++) pptr[i]=perm+(npt+1)*i-1;
for (i=1;i<=nb;i++) svptr[i]=sv2+npt*(i-1)-1;
for (i=1;i<=npt;i++) pptr[0][i]=i;
readbaselo(nb,base,lorb);
for (i=1;i<=nperms;i++) readvec(pptr[i],1);
fclose(ip);
/* Main algorithm begins */
op=fopen(outf,"w");
*pno=0; fixpt[nb+1]=0;
for (l=nb;l>stab;l--)
{ for (i=1;i<=nperms;i++) if (pptr[i][npt+1]==l) {(*pno)++; pno[*pno]=i; }
fixpt[l]= *pno;
}
for (l=stab;l>=1;l--) fixpt[l]=fixpt[stab+1];
for (l=nb;l>stab;l--)
{ olfb=fixpt[l+1]; nlfb=fixpt[l];
if ((nlfb-olfb)>1) for (i=olfb+1;i<=nlfb;i++)
{ z=pno[i];
/* We test whether perm no z is redundant as a generator.
If so, we leave pno[i]=0, if not we put it back to z.
*/
if (full==0 || z>ngens)
{ pno[i]=0;
for (m=l;m>stab && pno[i]==0;m--)
{*pno=fixpt[m]; if (orbitsv(base[m],svptr[m],0)<lorb[m]) pno[i]=z;}
}
}
}
*pno=0; l=0;
for (i=nb;i>=1;i--)
{ z=fixpt[i];
while (l<z)
{ l++;
if (pno[l]>0) { (*pno)++; pno[*pno]=pno[l]; }
}
lorb[i]=orbitsv(base[i],svptr[i],0);
}
fprintf(op,"%4d%4d%4d%4d\n",npt,*pno,nb,3);
printbaselo(nb,base,lorb); printpsv(nb,pno,svptr);
for (i=1;i<=*pno;i++) fprintf(op,"%4d",pno[i]); fprintf(op,"\n");
return(0);
}
int
sylprog (int x)
/* x!=0 means that a subgroup of the sylp-group has already been computed, and
is stored in inf2. The search should now start at bno=abs(x). sylnorm always
returns the current bno, if it exits in order to compute the normalizer. It
returns 0 if it completes the computation of the sylp-group
If x>0, its normalizer has also been computed, and lies in outf1,
and so the next element of the sylp-group will be sought from this
normalizer. Any p-element will do in this case.
*/
{ char nontriv,seek,b,incadno,comm,pow,id;
short i,j,k,l,m,n,lnt,fnt,mxp,mnb,mxexp,nperms,ct,stp,
*z,*ap,*sva,ct1,ct2,ct3,ord,kord,pt,stbno,skct,
*tpk,*itpk,*commp,*icommp,*spptr;
int quot;
adpt=obase; lorbdef=nbase; ntfpt=ntorno; ntbpt=lorbn; invbase=reg;
facord=ipno; orno=tsv1; lporb=tsv2; deft=tsv3; orbp=orep, gorb=intorb;
if (chpar)
/* par1,par2 and par3 are used when seeking random elts. See line 152 (approx).
When searching for an element normalizing a subgroup, we give up after
par4 attempts, and use normalizer program to compute the complete
normalizer first.
*/
{ printf("Choose values of par1,par2,par3,par4. (Defaults are %d %d %d %d.)\n",
par1,par2,par3,par4);
scanf("%hd%hd%hd%hd",&par1,&par2,&par3,&par4);
}
if ((ip=fopen(inf1,"r"))==0)
{ fprintf(stderr,"Cannot open %s.\n",inf1); return(-1);}
if (x==0) { printf("Input prime! "); scanf("%hd",&prime);}
fscanf(ip,"%hd%hd%hd%hd",&npt,&nperms,&nb,&l);
if (npt>mnpt) {fprintf(stderr,"npt too big. Increase NPT.\n"); return(-1);}
if (nb>mb) {fprintf(stderr,"nb too big. Increase MB.\n"); return(-1);}
if (nb*npt*2>svsp)
{ fprintf(stderr,"Out of sv space. Increase SVSP.\n");return(-1);}
if (l<=2) { fprintf(stderr,"Wrong input format.\n"); return(-1); }
readbaselo(nb,gbase,lorbg);
for (i=1;i<=npt;i++) invbase[i]=0;
for (i=1;i<=nb;i++) invbase[gbase[i]]=i;
lnt=0; fnt=0;
/* Determine order of sylp subgroup . Links ntfpt and ntbpt are used to bypass
trivial indices in the stab chain.
*/
for (i=nb;i>=1;i--)
{ j=lorbg[i]; lorbh[i]=1;
if (j>1)
{ if (lnt==0) { lnt=i; k=i; ntfpt[lnt]=nb+1; }
else { ntbpt[k]=i; ntfpt[i]=k; k=i; }
while (j%prime==0) {lorbh[i]*=prime; j/=prime; }
if (lorbh[i]>1) fnt=i;
}
else invbase[gbase[i]]=0;
}
ntbpt[fnt]=0; ntfpt[0]=fnt;
if (fnt==0) {fprintf(stderr,"Sylp-group is trivial!\n"); return(-1); }
printf("Orbit lengths of Sylp-group:\n");
for (i=1;i<=nb;i++) printf("%4d",lorbh[i]); printf(".\n");
quot=psp/(npt+1); if (quot>mp) quot=mp; mxp=quot;
quot=sp/npt; if (quot>mexp) quot=mexp; mxexp=quot;
np2=2*nperms-1;
if (np2>=mxp)
{fprintf(stderr,"Out of space. Increase PSP (or MP).\n"); return(-1); }
for (i=0;i<mxp;i++) pptr[i]=perm+(npt+1)*i-1;
for (i=1;i<=nb;i++) svgptr[i]=sv+npt*(i-1)-1;
for (i=1;i<=nb;i++) svhptr[i]=sv+npt*(i+nb-1)-1;
readpsv(0,nb,nperms,svgptr);
fclose(ip);
tpk=space-1; itpk=tpk+npt; commp=itpk+npt; icommp=commp+npt;
spptr=icommp+npt+1; sp-=4*npt;
for (i=fnt;i<=nb;i=ntfpt[i])
{ gorb[i]=spptr; sva=svgptr[i];
for (j=1;j<=npt;j++) if (sva[j]!=0) *(spptr++)=j;
sp-=lorbg[i];
}
/* We now determine how much space we have to store cosetrep perms, and
calculate these with the function exprep
*/
lexp=0; ct=0;
for (i=nb;i>fnt;i--)
{ ct+=(lorbg[i]-1); if (ct+i>=mxexp) {lexp=i; break; } }
if (lexp==0) lexp=fnt;
z=spptr-1; i=0;
while (i!=lexp)
{ i= (i==0) ? fnt : ntfpt[i]; expptr[i]=z;
z+=npt; start[i]=i-1;
}
printf("lexp=%d.\n",lexp);
start[lexp+1]=lexp; k=lexp;
for (i=lexp+1;i<=lnt;i++)
{ l=lorbg[i]; start[i+1]=start[i]+l-1;
if (l>1) for (j=1;j<=npt;j++) if (svgptr[i][j]>0)
{ k++; expptr[k]=z; z+=npt; exprep(j,k,svgptr[i]); }
}
/* nontriv nonzero means in this case that any p-element in G will do; i.e. we
are not looking for an element in the normalizer of the group found so far.
This is the case either when x=0, right at the beginning, or when x>0, and
we have already computed this normalizer.
*/
nontriv = (x>=0) ? 0 : 1;
*pno=0; deft[0]=0; stp=np2+1;
if (x!=0)
{ ip=fopen(inf2,"r");
fscanf(ip,"%hd%hd%hd%hd",&i,&nperms,&i,&i);
readbaselo(nb,gbase,lorbdef);
readpsv(stp,nb,nperms,svhptr);
for (i=1;i<=nperms;i++)
{ (*pno)++; pno[*pno]= ++np2; fscanf(ip,"%hd",facord+np2); np2++;}
fclose(ip);
k=abs(x); l=0;
for (i=1;i<=npt;i++) if (svhptr[k][i]!=0) orb[++l]=i;
}
else for (i=1;i<=nb;i++)
{ for (j=1;j<=npt;j++) {svhptr[i][j]=0; svhptr[i][gbase[i]]= -1; }
lorbdef[i]=1;
}
/* Starting search. lorbdef records the length of the orbit ofthe Sylp group
found so far. tp is a perm that we are currently considering as a
possible new element of Sylp. nontriv is set true as soon as the first
element of Sylp has been found. adno is then number in the stabilizer chain
for which the coset reps are currently being advanced in the search.
*/
stbno= (x==0) ? lnt : abs(x);
for (bno=stbno;bno>=fnt;bno=ntbpt[bno])
{ printf("bno=%d.\n",bno);
if (bno!=abs(x)) orb[1]=gbase[bno];
adno=bno;
while (lorbdef[bno]<lorbh[bno])
{ if (np2+2>=mxp)
{fprintf(stderr,"Out of space. Increase PSP.\n"); return(-1); }
*expcp=0; tp=pptr[np2+1]; itp=pptr[np2+2]; tp[npt+1]=bno;
/* When any p-element suffices, we seek random elements until one of them has
order a multiple of p. If after par1 elements, we have not found one, we try
commutators of the last element with new elements. If after par2 such
attempts we still have not found one, we try commutators with powers of the
last element. Then if after par3 tries we are still unsuccessful, we try a new
random element, and use commutators with that and so on...
*/
if (nontriv==0)
{ ct1=0; seek=1; comm=0;
while (seek)
{ (*expcp)=0; ranelt(); ord=findord(tp,itp);
if (ord%prime!=0)
{ ct1++;
if (comm)
{ id=1;
for (i=1;i<=npt;i++)
{ j=itpk[itp[tpk[tp[i]]]];
if (id && j!=i) id=0;
commp[i]=j; icommp[i]=0;
}
if (id)
{ ct2++;
if (ct2>par2) comm=0;
continue;
}
ct2=0;
ord=findord(commp,icommp);
if (ord%prime!=0)
{ ct3++;
if (ct3>par3)
{ if (pow) { comm=0; continue;}
printf("Trying powers.\n");
pow=1; ct3=0; ct2=0;
for (i=2;i<=kord;i++) if (kord%i==0)
{ if (kord==i) { comm=0; continue;}
k=kord/i;
for (i=1;i<=npt;i++)
{ pt=i; for (j=1;j<=k;j++) pt=tpk[pt]; itpk[pt]=i;}
invert(itpk,tpk);
}
}
}
else
{ for (i=1;i<=npt;i++) {tp[i]=commp[i]; itp[i]=icommp[i];}
seek=0;
}
} /* if (comm) */
else if (ct1>par1 && ord>1)
{ printf("Trying commutators.\n");
ct2=0; ct3=0; kord=ord; comm=1; pow=0;
for (i=1;i<=npt;i++) { tpk[i]=tp[i]; itpk[i]=itp[i];}
}
} /* if (ord%prime... */
else seek=0;
if (seek==0)
{ while (ord%prime==0) ord/=prime;
if (ord>1)
{ for (i=1;i<=npt;i++)
{ pt=i; for (j=1;j<=ord;j++) pt=tp[pt]; itp[pt]=i; }
invert(itp,tp);
}
if (svhptr[bno][tp[gbase[bno]]]!=0) { seek=1; comm=0; }
else { nontriv=1; fndelt();}
}
} /* while (seek) */
continue;
} /* if (nontriv==0) */
for (i=1;i<=npt;i++) tp[i]=i;
/* Now we compute all orbits of Sylp. The new element must
permute these orbits.
*/
allorbs(lporb,orno); bnoorno=orno[gbase[bno]]; bt=0;
opno=bnoorno; opct=1; skct=0;
for (i=1;i<= *lporb;i++) {orbp[i]=0; deft[i]=0; }
seek=1;
while (seek)
{ skct++; if (skct>par4)
{ printf("Exiting to try normrun.\n");
for (i=1;i<=npt;i++) if (svhptr[bno][i]== -2) svhptr[bno][i]=0;
goto exit;
}
for (i=1;i<=npt;i++) itp[i]=0;
b=1; ok=1;
while(1)
{ k=expcp[*expcp];
/* Advance to next element in search. ok is set false if this element is
eliminated from membership of Sylp, and we advance again.
*/
if (b && (*expcp==0 || k<=start[adno]))
{ (*expcp)++;
if (adno<=lexp) {adpt[adno]=0; expcp[*expcp]=adno;}
else expcp[*expcp]=start[adno];
b=0;
}
else
{ if (adno<=lexp)
{ sva=svgptr[adno]; ap=adpt+adno; (*ap)++;
while (sva[*ap]<=0 && *ap<=npt) (*ap)++;
if (*ap<=npt) { exprep(*ap,adno,sva); break; }
}
else if (k<start[adno+1]) {expcp[*expcp]++; break;}
if (*expcp==1)
{ fprintf(stderr,"Premature end of search.\n"); return(-1); }
(*expcp)--; bt=1; adno=ntbpt[adno]; b=1;
if (adno==bno)
{ im=expimage(gbase[adno]); l=orno[im];
if (lporb[l]>1) for (i=1;i<=npt;i++)
if (orno[i]==l) svhptr[adno][i]= -2;
/* Setting sv= -2 when bno=adno avoids testing more elements than necessary
which map the main orbit of gbase[bno] to another.
*/
}
}
}
incadno=1;
while (incadno)
{ cb=gbase[adno]; im=expimage(cb);
if (adno==bno && svhptr[adno][im]!=0) {ok=0;break;}
if (bt)
{ for (i=1;i<=*lporb;i++)
{ j=orbp[i]; if (deft[j]>=adno) {orbp[i]=0;deft[j]=0;}}
opno=bnoorno; opct=1; l=orbp[opno];
while (l!=0 && l!=bnoorno) { opct++; opno=l; l=orbp[l];}
}
bt=0; deforbp();
if (ok==0) break;
/* This means either that the element does not permute the orbits,
or that it permutes the base orbit with a cycle of p' length.
*/
else tp[cb]=im;
if (adno==lnt)
{ incadno=0;
for (cb=1;cb<=npt;cb++) if (invbase[cb]==0)
{ im=expimage(cb); deforbp();
if (ok==0) { bt=1; break; }
else tp[cb]=im;
}
}
else adno=ntfpt[adno];
}
if (ok)
{ ord=findord(tp,itp);
while (ord%prime==0) ord/=prime;
if (ord>1)
{ for (i=1;i<=npt;i++)
{ n=i; for (j=1;j<=ord;j++) n=tp[n]; itp[n]=i;}
invert(itp,tp);
}
}
/* if ok then tp is a p-element permuting the orbits. The final test is to
check that it normalizes Sylp.
*/
if (ok) for (i=stp;i<np2 && ok;i+=2)
{ *cp=0;
for (j=fnt;j<=lnt;j=ntfpt[j])
{ k=image(tp[pptr[i][itp[gbase[j]]]]);
if (svhptr[j][k]!=0) addsv(k,svhptr[j]);
else {ok=0; bt=1; break; }
}
if (ok==0 && ord>1)
for (j=bno;j<lnt;j=ntfpt[j]) tp[gbase[j]]=expimage(gbase[j]);
}
/* if ok then tp is the new element of Sylp */
if (ok) { seek=0; fndelt();}
}
}
for (i=1;i<=npt;i++) if (svhptr[bno][i]== -2) svhptr[bno][i]=0;
}
exit:
op=fopen(inf2,"w");
fprintf(op,"%4d%4d%4d%4d\n",npt,*pno,nb,4);
printbaselo(nb,gbase,lorbdef); printpsv(nb,pno,svhptr);
if (bno==0) fprintf(op,"%3d",prime);
for (i=stp;i<np2;i+=2) fprintf(op,"%4d",facord[i]); fprintf(op,"\n");
fclose(op);
if (x<=0 && bno>0)
{ op=fopen(outf1,"w");
*pno=0;
for (i=0;i<stp;i+=2) if (pptr[i][npt+1]>=bno)
{ (*pno)++; pno[*pno]=i;}
for (i=1;i<bno;i++) if (lorbg[i]>1)
{ lorbg[i]=1;
for (j=1;j<=npt;j++) svgptr[i][j]=0;
svgptr[i][gbase[i]]= -1;
}
fprintf(op,"%4d%4d%4d%4d\n",npt,*pno,nb,3);
printbaselo(nb,gbase,lorbg); printpsv(nb,pno,svgptr);
fclose(op);
}
return(bno);
}
