1 #include "defs.h"
2 #include "permfns.h"
3
4 # define SCP 100
5 extern char heqg,words,fullg,check,outf[],inf1[],inf2[],inf3[],outf0[];
6 extern short perm[],sv[],cp[],actgen[],orb[],
7 base[],lorbc[],lorbg[],lorbh[],order[],pno[],
8 *pptr[],*svptr1[],*svptr2[],*svptr3[],scpf[],scps[],sadpt[],
9 mp,mb;
10 extern int psp,svsp;
11 short npt,mxp,sth,stcom,np2,nb,npt1,cps,cpf;
12 char hing,cthere,hsvth;
13 FILE *ip,*op;
14
15 int
optprog(void)16 optprog (void)
17 { short i,j,k,nperms,jobt,*ptr,*iptr;
18 int quot;
19 char c,err,opt[80];
20
21 /* This program stores up to three groups G,H and C. G must always have a s.g.
22 set and Schreier Vectors svptr1. H and C may have Schreier vectors
23 svptr2 and svptr3. C is not always defined.
24 heqg=1 means H=G. cthere=1 means C is defined.
25 Perms in G have nos. from 0 to sth-2.
26 Perms in H have nos. from sth to stcomm-2 (unless H=G, when H is not stored)
27 stcomm-2=np2 if C not defined.
28 If C defined, perms in C have nos from stcomm to np2.
29 First read inf1 = G
30 */
31 if ((ip=fopen(inf1,"r"))==0)
32 { printf("Cannot open %s.\n",inf1); return(-1);}
33 fscanf(ip,"%hd%hd%hd%hd",&npt,&nperms,&nb,&jobt);
34 if (jobt<=0) { fprintf(stderr,"Wrong input format for G.\n"); return(-1); }
35 npt1=npt+1;
36 quot=psp/npt1; if (quot>mp) quot=mp; mxp=quot;
37 np2=2*nperms-2;
38 if (spacecheck()== -1) return(-1);
39 if (svsp/npt<3*nb) {fprintf(stderr,"Not enough sv space.\n"); return(-1); }
40 for (i=0;i<mxp;i++) pptr[i]=perm+i*(npt+1)-1;
41 for (i=1;i<=nb;i++) svptr1[i]=sv+(i-1)*npt-1;
42 for (i=1;i<=nb;i++) svptr2[i]=sv+(i+nb-1)*npt-1;
43 for (i=1;i<=nb;i++) svptr3[i]=sv+(i+2*nb-1)*npt-1;
44 readbaselo(nb,base,lorbg); readpsv(0,nb,nperms,svptr1);
45 sth = (heqg) ? 0 : 2*nperms;
46 fclose(ip);
47 /* if fullg read from gpname.inperm to determine minimal generating set for G */
48 if (fullg)
49 { if ((ip=fopen(inf3,"r"))==0)
50 { printf("Cannot open %s.\n",inf3); return(-1);}
51 fscanf(ip,"%hd%hd",&i,&k); fclose(ip);
52 }
53 else k=nperms;
54 /* actgen=1 means we have a genuine generator of G */
55 for (i=1;i<=k;i++) actgen[2*i-2]=1;
56 for (i=k+1;i<=nperms;i++) actgen[2*i-2]=2;
57 if (heqg==0)
58 /* Read inf2 = H */
59 { if ((ip=fopen(inf2,"r"))==0)
60 { fprintf(stderr,"Cannot open %s.\n",inf2); return(-1);}
61 fscanf(ip,"%hd%hd%hd%hd",&i,&nperms,&j,&k); err=0;
62 np2+=2*nperms;
63 if (spacecheck()== -1) return(-1);
64 if (i!=npt || (k>0 && j!=nb)) err=1;
65 if (err==0)
66 if (k>0)
67 { for (i=1;i<=nb;i++)
68 { fscanf(ip,"%hd",&j); if (j!=base[i]) {err=1; break;} }
69 if (err==0)
70 { for (i=1;i<=nb;i++) fscanf(ip,"%hd",lorbh+i);
71 readpsv(sth,nb,nperms,svptr2); hsvth=1;
72 }
73 for (i=1;i<=nperms;i++) actgen[2*i+sth-2]=1;
74 } else
75 { seeknln(); if (j!=0) seeknln(); if (k!=0) seeknln();
76 for (i=1;i<=nperms;i++)
77 { j=sth+2*i-2; ptr=pptr[j]; iptr=ptr+npt1; readvec(ptr,0); seeknln();
78 invert(ptr,iptr); actgen[j]=1;
79 for (k=1;k<=nb;k++) if (ptr[base[k]]!=base[k]) break;
80 ptr[npt1]=k;
81 }
82 hsvth=0;
83 }
84 if (err) { fprintf(stderr,"Wrong input format for H.\n"); return(-1); }
85 fclose(ip);
86
87 /* Check whether H is a subgroup of G and express generators of H as words
88 in gens of G if required.
89 */
90 hing=1;
91 for (i=1;i<=nperms;i++)
92 { *cp=1; cp[1]=sth+2*i-2;
93 if (test(svptr1,words)==0) { hing=0; if (words==0) break; }
94 }
95 } else
96 { sth=0; hing=1; hsvth=1; for (i=1;i<=nb;i++) lorbh[i]=lorbg[i];}
97 if (hing)
98 { if (check) printf("true\n"); else printf ("H is a subgroup of G.\n");}
99 else
100 { if (check) printf("false\n"); else printf("H is not a subgroup of G.\n");}
101 if (check) return(0);
102 cthere=0; stcom=sth+2*nperms; np2=stcom-2;
103
104 while (1)
105 /* Now start processing according to chosen options. */
106 { printf("Choose option. ('l' for list options.)\n");
107 scanf("%s",opt);
108 if (strcmp(opt,"ex")==0) scanf("%hd",&k);
109 while ((c=getchar())!='\n');
110 if (strcmp(opt,"l")==0)
111 { printf("Options:\nnc Put C=normal closure of H in G,\n");
112 printf("comm Put C=[G,H],\nint Put C=G ^ H,\njoin Put C=<G,H>,\n");
113 printf("core Replace H by its core w.r.t. G,\n");
114 printf("oph Output H,\nopc Output C,\n");
115 printf("hsv Calculate s.g.set, Schreier vectors and order of H,\n");
116 printf("rgh Replace G by H and set H=G,\n");
117 printf("rghc Replace G by H and H by C,\n");
118 printf("rhc Replace H by C,\n");
119 printf("ex n Test if perm. no n of H lies in G. If so express it in gens of G,\n");
120 printf("q Quit.\n");
121 printf("WARNING: core,hsv,rghc and rhc render C undefined.\n");
122 }
123 else if (strcmp(opt,"nc")==0)
124 { if (heqg) printf("H = G. Normal closure = G.\n");
125 else if (nc(0,0,sth-2)== -1) return(-1);
126 }
127 else if (strcmp(opt,"comm")==0) {if (comm()== -1) return(-1);}
128 else if (strcmp(opt,"int")==0)
129 { if (hing) printf("H <= G. Intersection = H.\n");
130 else if (hsvth==0) printf("hsv must be called first.\n");
131 else if (intsect(svptr1,svptr2,svptr3,stcom)== -1) return(-1);
132 }
133 else if (strcmp(opt,"core")==0)
134 { if (heqg) printf("H = G. Core = G.\n");
135 else if (hsvth==0) printf("hsv must be called first.\n");
136 else if (core()== -1) return(-1);
137 }
138 else if (strcmp(opt,"join")==0)
139 { if (hing) printf("H <= G. Join = G.\n"); else join(); }
140 else if (strcmp(opt,"oph")==0)
141 { if (hsvth==0) fprintf(stderr,"H has no sv. Output not done.\n");
142 else if (outp(0)== -1) return(-1);
143 }
144 else if (strcmp(opt,"opc")==0)
145 { if (cthere==0) fprintf(stderr,"No subgroup C to output.\n");
146 else if (outp(1)== -1) return(-1);
147 }
148 else if (strcmp(opt,"hsv")==0)
149 { if (hsvth) fprintf(stderr,"H has sv already.\n");
150 else
151 { cthere=0; np2=stcom-2; if (gp(sth,nb,lorbh,svptr2)== -1) return(-1);
152 hsvth=1; stcom=np2+2;
153 }
154 }
155 else if (strcmp(opt,"rhc")==0)
156 { if (cthere==0) fprintf(stderr,"No subgroup C.\n"); else rhc(); }
157 else if (strcmp(opt,"rgh")==0)
158 { if (heqg) fprintf(stderr,"H = G already.\n"); else rgh(0); }
159 else if (strcmp(opt,"rghc")==0)
160 { if (heqg) fprintf(stderr,"H = G already.\n");
161 else if (cthere==0) printf("No subgroup C.\n");
162 else rgh(1);
163 }
164 else if (strcmp(opt,"ex")==0)
165 { if (heqg) fprintf(stderr,"H=G, so this option is pointless.\n");
166 else if (abs(k)>nperms || k==0)
167 fprintf(stderr,"Inappropriate perm no.\n");
168 else
169 { j= (k>0) ? sth+2*(k-1) : sth+2*(-k-1)+1;
170 *cp=1; cp[1]=j;
171 if (test(svptr1,0)==0) printf("Perm is not in G.\n");
172 else
173 { printf("Perm is in G. It is:\n");
174 for (i= *cp;i>1;i--)
175 { j=cp[i]; k= (j%2==0) ? -j/2-1 : (j-1)/2+1; printf("%d",k);
176 if (i==2) printf("\n"); else printf(" * ");
177 }
178 }
179 }
180 }
181 else if (strcmp(opt,"q")==0) break;
182 else printf("Invalid option.\n");
183 } /* Main option choosing loop */
184 return(0);
185 }
186
187 int
gp(int spno,int sbno,short * lorb,short ** svptr)188 gp (int spno, int sbno, short *lorb, short **svptr)
189 /* Compute s.g. set and group order of a group K (=H or C).
190 Similar to program gprun.
191 spno=no. of first perm in K; the last no. is the external np2.
192 lorb and svptr for placing orbit lengths and Schreier vectors of K.
193 sbno=no. of base points.
194 Warning: It is assumed that the given base really is a base for K,
195 and no new base points are added. This is the main difference
196 from gprun. The answer will be false if this assumption is false.
197 However, the call from intsect uses a deliberately smaller value
198 of sbno, to save time.
199
200 */
201 { short i,j,l,m,bno,u,v,w,x,y,z,lsv;
202 char trivrel,id; float grporder;
203 bno=sbno;
204 loop:
205 *pno=0; z = (spno==0) ? sth-2 : np2;
206 for (i=spno;i<=z;i+=2)
207 { if (pptr[i][npt1]>=bno && actgen[i]<=bno)
208 { (*pno)++; pno[*pno]=i; }
209 }
210 lorb[bno]=orbitsv(base[bno],svptr[bno],0);
211 if (*pno!=0)
212 { np2+=2; y=np2+1;
213 if (spacecheck()== -1) return(-1);
214 for (i=1;i<bno;i++)
215 { u=base[i]; pptr[np2][u]=u; pptr[y][u]=u; }
216 for (i=1;i<=lorb[bno];i++)
217 { *cp=0; addsv(orb[i],svptr[bno]);
218 for (w=1,x= *cp;w<=x;w++,x--)
219 { if (w==x) cp[w]-=1; else {u=cp[w]; cp[w]=cp[x]-1; cp[x]=u-1;}}
220 lsv= *cp;
221 for (j=1;j<=*pno;j++)
222 { *cp=lsv; u=pno[j]+1;
223 trivrel = (*cp>0) ? cp[*cp]==(u-1) : 0;
224 if (trivrel==0)
225 { (*cp)++; cp[*cp]=u; id=1;
226 for (l=bno;l<=nb;l++)
227 { v=base[l]; u=image(v); if (svptr[l][u]==0) {id=0; break;}
228 addsv(u,svptr[l]); pptr[np2][v]=v; pptr[y][v]=v;
229 }
230 if (id==0)
231 { pptr[np2][npt1]=l; actgen[np2]=bno+1;
232 for (m=1;m<=npt;m++) {u=image(m); pptr[np2][m]=u; pptr[y][u]=m;}
233 printf("New generator fixing first %d base pts is:\n", l-1);
234 for (m=1;m<=*cp;m++)
235 { z=cp[m]; y=z/2; x= (z==2*y) ? y+1 : -(y+1);
236 printf("%3d",x); if (m== *cp) printf("\n"); else printf("*");
237 }
238 bno=l; goto loop;
239 }
240 }
241 }
242 }
243 np2-=2;
244 }
245 bno--;
246
247 if (bno==0)
248 { if (spno!=0)
249 { printf("Present order of the group is:\n");
250 for (i=1;i<=nb;i++)
251 { printf("%3d",lorb[i]);
252 if (i==nb) printf(" =\n"); else printf("*");
253 }
254 grporder=1; for (i=1;i<=nb;i++) grporder *= lorb[i];
255 printf("%g\n",grporder);
256 }
257 return(0);
258 }
259 else goto loop;
260 }
261
262 int
test(short ** svp,int exp)263 test (short **svp, int exp)
264 /* Test whether the current perm (in cp) lies in the group G, using the
265 Schreier Vector svp. If exp is true, print out word for element in
266 generators of G.
267 */
268 { short i,k,l;
269 for (l=1;l<=nb;l++)
270 { k=image(base[l]);
271 if (svp[l][k]==0)
272 { if (exp) printf("Permutation is not in group.\n"); return(0);}
273 addsv(k,svp[l]);
274 }
275 if (exp) for (i=cp[0];i>1;i--)
276 { k=cp[i]; l= (k%2==0) ? -(k+2)/2 : (k+1)/2;
277 printf("%2d",l); if (i>2) printf(" *"); else printf("\n");
278 }
279 return(1);
280 }
281
282 int
nc(int th,int sno,int eno)283 nc (int th, int sno, int eno)
284 /* Compute normal closure of a group K under perms from sno to eno.
285 If th=0, first copy H to C, put th=stcomm and np2 the last one.
286 In any case, K is then generated by perms from th to np2.
287 */
288 { short i,j,l,m,n,*p,*q,*r;
289 if (th==0)
290 /* Copy H and its Schreier vector into C if necessary. */
291 { p=pptr[sth]; q=pptr[stcom]; r=q;
292 while (++p<=r) *(++q)= *p;
293 np2=2*stcom-sth-2;
294 if (spacecheck()== -1) return(-1);
295 p=actgen+sth-1; q=actgen+stcom-1; r=q; while (++p<=r) *(++q)= *p;
296 if (hsvth)
297 { p=svptr2[1]; q=svptr3[1]; r=q; l=stcom-sth;
298 while (++p<=r) *(++q) = (*p<=0) ? *p : *p+l;
299 p=lorbh; q=lorbc; r=p+nb;
300 while (++p<=r) *(++q)= *p;
301 }
302 else if (gp(stcom,nb,lorbc,svptr3)== -1) return(-1);
303 th=stcom;
304 }
305 for (i=th;i<=np2;i+=2) if (actgen[i]==1)
306 for (j=sno;j<=eno;j+=2) if (actgen[j]==1)
307 { *cp=3; cp[1]=j+1; cp[2]=i; cp[3]=j;
308 if (test(svptr3,0)==0)
309 /* Add new gen to C */
310 { np2+=2; p=pptr[np2]; q=pptr[np2+1]; *cp=3;
311 if (spacecheck()== -1) return(-1);
312 for (n=1;n<=npt;n++) { m=image(n); p[n]=m; q[m]=n; }
313 actgen[np2]=1;
314 for (n=1;n<=nb;n++) if (p[base[n]]!=base[n]) break;
315 p[npt1]=n; if (gp(stcom,n,lorbc,svptr3)== -1) return(-1);
316 }
317 }
318 cthere=1;
319 return(0);
320 }
321
322 int
comm(void)323 comm (void)
324 /* Compute commutator subgroup C = [G,H] */
325 { short i,j,k,*p,*q,*r,m,n,gnext,hnext;
326 p=svptr3[1]; r=p+nb*npt;
327 while (++p<=r) *p=0; np2=stcom-2;
328 if (spacecheck()== -1) return(-1);
329 for (i=1;i<=nb;i++) {svptr3[i][base[i]]= -1; lorbc[i]=1; }
330 k= heqg ? stcom : sth;
331 /* First define C to be generated by commutators of generators */
332 for (i=0;i<k;i+=2) if (actgen[i]==1)
333 for (j=sth;j<stcom;j+=2) if (actgen[j]==1)
334 { *cp=4; cp[1]=i+1; cp[2]=j+1; cp[3]=i; cp[4]=j;
335 if (test(svptr3,0)==0)
336 { np2+=2; p=pptr[np2]; q=pptr[np2+1]; *cp=4;
337 if (spacecheck()== -1) return(-1);
338 for (n=1;n<=npt;n++) { m=image(n); p[n]=m; q[m]=n; }
339 actgen[np2]=1;
340 for (n=1;n<=nb;n++) if (p[base[n]]!=base[n]) break;
341 p[npt1]=n; if (gp(stcom,n,lorbc,svptr3)== -1) return(-1);
342 }
343 }
344 if (np2<stcom) {printf("[G,H] is trivial.\n"); cthere=0; return(0); }
345 gnext=stcom; hnext=stcom;
346 /* Now take normal closure under G and H */
347 while(1)
348 { if (gnext>np2) break;
349 n= heqg ? stcom-2 : sth-2;
350 if (nc(gnext,0,n)== -1) return(-1); gnext=np2+2;
351 if (hing || hnext>np2) break;
352 if (nc(hnext,sth,stcom-2)== -1) return(-1);
353 }
354 return(0);
355 }
356
357 int
outp(int c)358 outp (int c)
359 /* Out put a group. H if c=0, C if c=1. */
360 { short nperms,i,s,e,**sv; char sn[12];
361 printf("Input name of subgroup to be output: ");
362 scanf("%s",sn); strcpy(outf,outf0); strcat(outf,sn);
363 op=fopen(outf,"w");
364 nperms = c ? (np2+2-stcom)/2 : (stcom-sth)/2;
365 fprintf(op,"%4d%4d%4d%4d\n",npt,nperms,nb,1);
366 if (c) printbaselo(nb,base,lorbc); else printbaselo(nb,base,lorbh);
367 s= c ? stcom : sth; e= c ? np2 : stcom-2;
368 *pno=0; for (i=s;i<=e;i+=2) pno[++(*pno)]=i;
369 sv= c ? svptr3 : heqg ? svptr1 : svptr2;
370 printpsv(nb,pno,sv); fclose(op);
371 return(0);
372 }
373
374 int
intsect(short ** sv1,short ** sv2,short ** sv3,int stint)375 intsect (short **sv1, short **sv2, short **sv3, int stint)
376 /* Compute intersection of groups with Schreier vectors sv1 and sv2.
377 This uses a becktrack search thro' the sv1 group.
378 The result has S. vector sv3, and s.g. set from stint to np2.
379 It is necessary for the current perm to expand in both directions, so
380 we start it at position SCP defined above. Chaos would result if this
381 should be too small. In general it goes from cps to cpf. in the array cp.
382 */
383 { short i,m,n,k,adno,adpt,bno,*p,*q,*r;
384 np2=stint-2; p=sv3[1]; r=p+nb*npt; while (++p<=r) *p=0;
385 if (spacecheck()== -1) return(-1);
386 for (i=1;i<=nb;i++) { sv3[i][base[i]]= -1; lorbc[i]=1;}
387 scps[1]=SCP; scpf[1]=scps[1]-1;
388 for (bno=nb;bno>=1;bno--)
389 { adno=bno; cps=scps[1]; cpf=scpf[1]; scps[bno]=cps; scpf[bno]=cpf;
390 adpt=0;
391 while(1)
392 /* First advance thro' search */
393 { adpt++; while (adpt<=npt && sv1[adno][adpt]==0) adpt++;
394 if (adpt>npt)
395 { if (adno==bno) break;
396 adno--; cps=scps[adno]; cpf=scpf[adno]; adpt=sadpt[adno];
397 continue;
398 }
399 if (adno==bno && (sv2[bno][adpt]==0 || sv3[bno][adpt]!=0)) continue;
400 addsvb(adpt,sv1[adno]);
401 k=im(base[adno]);
402 if (sv2[adno][k]==0) { cps=scps[adno]; continue;}
403 addsvf(k,sv2[adno]); sadpt[adno]=adpt;
404 if (adno==nb)
405 /* We have a new generator in the intersection. */
406 { np2+=2;
407 if (spacecheck()== -1) return(-1);
408 p=pptr[np2]; q=pptr[np2+1]; p[npt1]=bno; actgen[np2]=1;
409 cps=scps[bno];
410 for (n=1;n<=npt;n++) {m=im(n); p[n]=m; q[m]=n; }
411 if (gp(stint,bno,lorbc,sv3)== -1) return(-1);
412 adno=bno; adpt=sadpt[bno]; cpf=scpf[bno]; continue;
413 }
414 adno++; scps[adno]=cps; scpf[adno]=cpf; adpt=0;
415 }
416 }
417 if (np2<stint)
418 {printf("Intersection is trivial.\n"); cthere=0; return(0); }
419 else cthere=1; return(1);
420 }
421
422 int
im(int pt)423 im (int pt)
424 /* Image under current perm used in intsect */
425 { short i;
426 for (i=cps;i<=cpf;i++) pt=pptr[cp[i]][pt];
427 return(pt);
428 }
429
430 int
addsvb(int pt,short * sv)431 addsvb (int pt, short *sv)
432 /* Similar to addsv in permfns.c, but goes backwards, using current perm
433 in intsect
434 */
435 { short pn;
436 pn=sv[pt]; while (pn!= -1)
437 { cps--; cp[cps]=pn-1; pt=pptr[pn][pt]; pn=sv[pt]; }
438 }
439
440 int
addsvf(int pt,short * sv)441 addsvf (int pt, short *sv)
442 /* Same but goes forwards */
443 { short pn;
444 pn=sv[pt]; while (pn!= -1)
445 { cpf++; cp[cpf]=pn; pt=pptr[pn][pt]; pn=sv[pt]; }
446 }
447
448 int
core(void)449 core (void)
450 /* Replace H by its core under G */
451 { short i,j,l,m,n,stint,*p,*q,*r;
452 np2=stcom-2;
453 if (spacecheck()== -1) return(-1);
454 restart:
455 for (i=0;i<sth;i+=2) if (actgen[i]==1) for (j=sth;j<stcom;j+=2)
456 { *cp=3; cp[1]=i+1; cp[2]=j; cp[3]=i;
457 if (test(svptr2,0)==0)
458 /* The conjugate of the generator of H under the generator of G does not
459 lie in H, so we must take an intersection.
460 First compute g-1 H g and then its intersection with H
461 */
462 { for (j=sth;j<stcom;j+=2)
463 { *cp=3; cp[2]=j; np2+=2; p=pptr[np2]; q=pptr[np2+1];
464 for (n=1;n<=npt;n++) { m=image(n); p[n]=m; q[m]=n; }
465 actgen[np2]=1;
466 for (n=1;n<=nb;n++) if (p[base[n]]!=base[n]) break; p[npt1]=n;
467 }
468 if (gp(stcom,nb,lorbc,svptr3)== -1) return(-1);
469 stint=np2+2;
470 if ((n=intsect(svptr2,svptr3,svptr1,stint))==-1) return(-1);
471 if (n==0)
472 /* If core is trivial, we exit after putting heqg=1 for good measure. */
473 { printf("Core is trivial. Setting H=G.\n");
474 if (gp(0,nb,lorbg,svptr1)== -1) return(-1);
475 stcom=sth; np2=sth-2; sth=0;
476 hing=1; heqg=1; cthere=0; return(0);
477 }
478 l=stint-sth; p=svptr1[1]; q=svptr2[1]; r=p+nb*npt;
479 while (++p<=r) *(++q)= (*p<=0) ? *p : *p-l;
480 for (i=1;i<=nb;i++) lorbh[i]=lorbc[i];
481 p=pptr[stint]; q=pptr[sth]; r=pptr[np2]+2*npt1;
482 while (++p<=r) *(++q)= *p;
483 np2=sth+np2-stint; stcom=np2+2;
484 for (i=sth;i<=np2;i++) actgen[i]=1; goto restart;
485 }
486 }
487 /* We have messed up svptr1 during this computation, so we recompute it */
488 cthere=0; gp(0,nb,lorbg,svptr1);
489 *cp=1; hing=1; for (i=sth;i<=np2;i+=2)
490 { cp[1]=i; if (test(svptr1,0)==0) { hing=0; break; } }
491 if (hing) printf ("H is a subgroup of G.\n");
492 else printf("H is not a subgroup of G.\n");
493 return(0);
494 }
495
496 int
rhc(void)497 rhc (void)
498 /* Replace H by C */
499 { short i,l,*p,*q,*r;
500 cthere=0;
501 if (heqg) { sth=stcom; heqg=0; }
502 l=stcom-sth; p=svptr3[1]; q=svptr2[1]; r=p+nb*npt;
503 while (++p<=r) *(++q)= (*p<=0) ? *p : *p-l;
504 for (i=1;i<=nb;i++) lorbh[i]=lorbc[i];
505 if (heqg==0)
506 { p=pptr[stcom]; q=pptr[sth]; r=pptr[np2]+2*npt1;
507 while (++p<=r) *(++q)= *p;
508 p=actgen+stcom-1; q=actgen+sth-1; r=actgen+np2+1;
509 while (++p<=r) *(++q)= *p;
510 }
511 np2=sth+np2-stcom; stcom=np2+2; hsvth=1;
512 *cp=1; hing=1; for (i=sth;i<=np2;i+=2)
513 { cp[1]=i; if (test(svptr1,0)==0) { hing=0; break; } }
514 if (hing) printf ("H is a subgroup of G.\n");
515 else printf("H is not a subgroup of G.\n");
516 }
517
518 int
rgh(int c)519 rgh (int c)
520 /* Replace G by H, and is c=1 also H by C */
521 { short i,l,*p,*q,*r;
522 l=sth; p=svptr2[1]; q=svptr1[1]; r=p+nb*npt;
523 while (++p<=r) *(++q)= (*p<=0) ? *p : *p-l;
524 for (i=1;i<=nb;i++) lorbg[i]=lorbh[i];
525 p=pptr[sth]; q=pptr[0]; r=pptr[stcom];
526 while (++p<=r) *(++q)= *p;
527 p=actgen+sth-1; q=actgen-1; r=actgen+stcom-1;
528 while (++p<=r) *(++q)= *p;
529 if (c)
530 { sth=stcom-sth; rhc(); } else
531 { stcom-=sth; np2=stcom-2; sth=0; cthere=0; hsvth=1; hing=1; heqg=1;}
532 }
533
534 int
join(void)535 join (void)
536 /* Compute C=<G,H> */
537 { short i,*p,*q,*r;
538 np2=stcom-2;
539 for (i=0;i<stcom;i+=2) if (actgen[i]==1)
540 { if (spacecheck()== -1) return(-1);
541 np2+=2; p=pptr[i]; q=pptr[np2]; r=p+2*npt1;
542 if (spacecheck()== -1) return(-1);
543 while (++p<=r) *(++q) = *p; actgen[np2]=1;
544 }
545 gp(stcom,nb,lorbc,svptr3); cthere=1;
546 return(0);
547 }
548
549 int
spacecheck(void)550 spacecheck (void)
551 { if (np2+1>=mxp)
552 { fprintf(stderr,"Out of perm space. Increase PSP (or MP).\n"); return(-1);}
553 return(0);
554 }
555