1
2 #include"def.h"
3 #include"macro.h"
4
5 /***********************************************************************/
6 /***********************************************************************/
7 /* */
8 /* Algorithmus von DIXON-WILF */
9 /* -------------------------- */
10 /* */
11 /* Dieses Programm berechnet Bahnrepresentanten der Bahnen einer Gruppe*/
12 /* G, die auf einer Menge M operiert. Es handelt sich um eine gewich- */
13 /* tete Version des Algorithmus von Dixon/Wilf. */
14 /* Die Represanten sind gleichverteilt auf den Bahnen von G auf M. */
15 /* Je nach Aufruf koennen entweder ein Beispielsatz von Bahnrepresen- */
16 /* tanten oder eine Bahnentransversale (oder Teile davon) erzeugt */
17 /* werden. */
18 /* */
19 /* Aufruf 1: */
20 /* --------- */
21 /* dixon_wilf_examples(G,weight,anz,FP); */
22 /* */
23 /* In diesem Fall werden anz Bahnrepresentanten in die Struktur FP */
24 /* geschrieben. (VECTOR von VECTOREN, die Laenge der einzelnen Rep- */
25 /* praesentanten ist gleich dem Grad der operierenden Permutations- */
26 /* gruppe. Diese muss in der Struktur G (VECTOR von PERMUTATIONEN) */
27 /* uebergeben werden. Es genuegt ein beliebiges Erzeugendensystem, */
28 /* da die komplette Gruppe daraus erzeugt wird. */
29 /* Der VECTOR weight enthaelt die Anzahl der verschiedenen Gewichte, */
30 /* also die eigentliche Information ueber die Menge, auf der operiert */
31 /* wird. */
32 /* Der ungewichtete Fall kann mit diesem Programm ebenfalls simuliert */
33 /* werden. */
34 /* */
35 /* */
36 /* Aufruf 2: */
37 /* --------- */
38 /* dixon_wilf_transversal(G,weight,anz,FP); */
39 /* */
40 /* In diesem Fall werden anz Bahnrepresentanten aus verschiedenen */
41 /* Bahnen in die Struktur FP geschrieben. */
42 /* (VECTOR von VECTOREN, die Laenge der einzelnen Rep- */
43 /* praesentanten ist gleich dem Grad der operierenden Permutations- */
44 /* gruppe. Diese muss in der Struktur G (VECTOR von PERMUTATIONEN) */
45 /* uebergeben werden. Es genuegt ein beliebiges Erzeugendensystem, */
46 /* da die komplette Gruppe daraus erzeugt wird. */
47 /* */
48 /* Der VECTOR weight enthaelt die Anzahl der verschiedenen Gewichte, */
49 /* also die eigentliche Information ueber die Menge, auf der operiert */
50 /* wird. */
51 /* Der ungewichtete Fall kann mit diesem Programm ebenfalls simuliert */
52 /* werden. */
53 /* */
54 /* Ist die eingegebene Zahl anz groesser als die Zahl der Bahnen, so */
55 /* werden |M//G| Representanten in FP zurueckgegeben. */
56 /* */
57 /* Wird anz mit 0L uebergeben, so werden ebenfalls |M//G| Representan-*/
58 /* ten berechnet. */
59 /* */
60 /*---------------------------------------------------------------------*/
61 /* Written by: Ralf Hager Oktober 1992 */
62 /*---------------------------------------------------------------------*/
63 /* */
64 /***********************************************************************/
65 /***********************************************************************/
66
67
68 #define war_schon_da(a,b) ((index_vector(a,b) == -1L ) ? 1L : 0L)
69 static INT get_edge();
70 static INT bestimme_egf();
71 static INT mult_g_fix();
72 static INT berechne_Mgi();
73 static INT MGgen();
74 static INT berechne_Mgi_z();
75 static INT bestimme_pz();
76 static INT besetze_fixpunkt();
77 static INT Mggen();
78
79 /***********************************************************************/
80 /* */
81 /* Routine: Ggen */
82 /* Ausgehend von einem Erzeugendensystem S von Permutationen */
83 /* wir die Gruppe G erzeugt und in D abgespeichert. */
84 /* */
85 /***********************************************************************/
86 /* RH 031092 */
87
Ggen(G)88 INT Ggen(G) OP G;
89 {
90 INT i;
91 INT j;
92
93 OP D = callocobject();
94 OP hperm = callocobject();
95
96 if(!einsp(S_V_I(G,0L)))
97 {
98 m_il_v(S_V_LI(G)+1L,D);
99 m_il_nv(S_P_LI(S_V_I(G,0L)),S_V_I(D,0L));
100 first_permutation(S_P_L(S_V_I(G,0L)),S_V_I(D,0L));
101 for(i=1L;i<S_V_LI(D);++i)
102 copy(S_V_I(G,i-1L),S_V_I(D,i));
103
104 /********************************************************************/
105 /* Algorithmus: */
106 /* ------------ */
107 /* fuer alle s aus Liste S */
108 /* fuer alle g aus Liste G */
109 /* falls s*g nicht in G */
110 /* fuege s*g in G ein. */
111 /********************************************************************/
112
113 for(i=0L;i<S_V_LI(D);++i)
114 {
115 for(j=0L;j<S_V_LI(G);++j)
116 {
117 mult(S_V_I(D,i),S_V_I(G,j),hperm);
118 if(war_schon_da(hperm,D) != 0L)
119 {
120 inc(D);
121 copy(hperm,S_V_I(D,S_V_LI(D)-1L));
122 }
123 }
124 }
125 copy(D,G);
126 }
127
128 freeall(D);
129 freeall(hperm);
130 return OK;
131 }
132
133 /***********************************************************************/
134 /* */
135 /* Routine: Cgen */
136 /* -------- */
137 /* Ausgehend von einer Gruppe G von Permutationen werden zu jedem */
138 /* Gruppenelement die Nummer der Konjugiertenklasse, in der es liegt */
139 /* Im Vektor C gespeichert. */
140 /* */
141 /***********************************************************************/
142 /* RH 031092 */
143
Cgen(G,C)144 INT Cgen(G,C) OP G,C;
145 {
146 INT i;
147 INT j;
148 INT k;
149 INT c;
150
151 OP besucht = callocobject();
152 OP h = callocobject();
153 OP g = callocobject();
154 OP r = callocobject();
155 OP ri = callocobject();
156 OP zw = callocobject();
157
158 m_il_nv(S_V_LI(G),C);
159 m_il_nv(S_V_LI(G),besucht);
160
161 /********************************************************************/
162 /* Algorithmus: */
163 /* ------------ */
164 /* fuer alle g aus G */
165 /* fuer alle h aus G */
166 /* fuer alle r aus G */
167 /* falls g = r h r^-1 */
168 /* h liegt in derselben Klasse wie g */
169 /********************************************************************/
170
171
172 c = 0L;
173 for(i=0L;i<S_V_LI(G);++i)
174 {
175 if(S_V_II(besucht,i)== 0L)
176 {
177 c++;
178 M_I_I(c,S_V_I(C,i));
179 M_I_I(1L,S_V_I(besucht,i));
180 copy(S_V_I(G,i),g);
181 for(j=0L;j<S_V_LI(G);++j)
182 {
183 if(S_V_II(besucht,j) == 0L)
184 {
185 copy(S_V_I(G,j),h);
186 for(k=0L;k<S_V_LI(G);++k)
187 {
188 copy(S_V_I(G,k),r);
189 invers(r,ri);
190 mult(h,ri,zw);
191 mult(r,zw,zw);
192 if(EQ(zw,g))
193 {
194 M_I_I(1L,S_V_I(besucht,j));
195 M_I_I(c,S_V_I(C,j));
196 break;
197 }
198 }
199 }
200 }
201 }
202 }
203 freeall(h);
204 freeall(g);
205 freeall(r);
206 freeall(ri);
207 freeall(zw);
208 freeall(besucht);
209 return(c);
210 }
211
212 /***********************************************************************/
213 /* */
214 /* Routine: Cdeg */
215 /* -------- */
216 /* Aus dem in Cgen erzeugten Vektor C werden durch Akkumulation die */
217 /* Ordnungen der Konjugiertenklassen bestimmt. */
218 /* */
219 /***********************************************************************/
220 /* RH 031092 */
221
Cdeg(C,stat)222 INT Cdeg(C,stat) OP C,stat;
223 {
224 INT i;
225
226 for(i=0L;i<S_V_LI(C);++i)
227 M_I_I(1L+S_V_II(stat,S_V_II(C,i)-1L),S_V_I(stat,S_V_II(C,i)-1L));
228 return OK;
229 }
230
231 /***********************************************************************/
232 /* */
233 /* Routine: make_real_cycletype */
234 /* -------- */
235 /* Aus dem in Form einer Partition abgelegten Zykeltyps einer Permuta- */
236 /* tion, wird ein Vektor erstellt in dessen i-ter Komponente die An- */
237 /* zahl der i+1L - Zykel steht. */
238 /* */
239 /***********************************************************************/
240 /* RH 031092 */
241
make_real_cycletype(c,a)242 INT make_real_cycletype(c,a) OP c,a;
243 {
244 INT i;
245 for(i=0L;i<S_PA_LI(c);++i)
246 M_I_I(S_V_II(a,S_PA_II(c,i)-1L)+1L,S_V_I(a,S_PA_II(c,i)-1L));
247 return OK;
248 }
249
250 /***********************************************************************/
251 /* */
252 /* Routine: calculate_fixed_point_number */
253 /* -------- */
254 /* Es wird ein folgender Binomialkoeffifient berechnet: */
255 /* */
256 /* */
257 /* n n-i_1 n-sum_j_=1to_m-1(i_j) */
258 /* ( )*( )* ... *( ) */
259 /* i_1 i_2 i_m */
260 /* */
261 /* */
262 /* Diese Zahl entspricht gerade der Zahl der Belegungen von n Plaetzen */
263 /* mit k verschiedenen Objekten mit insgesamt m Farben k = sum_j=1to_m */
264 /* ueber die i_j */
265 /* */
266 /***********************************************************************/
267 /* RH 031092 */
268
calculate_fixed_point_number(a,b,mg)269 INT calculate_fixed_point_number(a,b,mg) OP a,b,mg;
270 {
271 INT i;
272 INT k;
273
274 OP zw = callocobject();
275 OP erg = callocobject();
276 OP x = callocobject();
277 OP y = callocobject();
278 OP sum = callocobject();
279
280
281 M_I_I(1L,erg);
282 for(i=0L;i<S_V_LI(a);++i)
283 {
284 M_I_I(0L,sum);
285 for(k=0L;k<S_V_LI(b);++k) add(sum,S_V_I(S_V_I(b,k),i),sum);
286 if(S_I_I(sum) > S_V_II(a,i))
287 {
288 M_I_I(0L,erg);
289 break;
290 }
291 M_I_I(1L,zw);
292 copy(S_V_I(a,i),x);
293 for(k=0L;k<S_V_LI(b);++k)
294 {
295 if(S_V_II(S_V_I(b,k),i) > 0L)
296 {
297 binom(x,S_V_I(S_V_I(b,k),i),zw);
298 sub(x,S_V_I(S_V_I(b,k),i),x);
299 mult(zw,erg,erg);
300 }
301 }
302 }
303 copy(erg,mg);
304
305 freeall(erg);
306 freeall(zw);
307 freeall(x);
308 freeall(y);
309 freeall(sum);
310 return OK;
311 }
312
313
314 /***********************************************************************/
315 /* */
316 /* Routine: build_propab_vector */
317 /* -------- */
318 /* */
319 /* Im Vektor propab werden die Wahrscheinlichkeiten fuer die Konju- */
320 /* tenklassen der Gruppe G gemaess folgender Verteilung bestimmt: */
321 /* */
322 /* */
323 /* |C_i| * |M_gi| */
324 /* P(C_i) = --------------- */
325 /* |G| * |M//G| */
326 /* */
327 /* */
328 /* In propab[i] steht dabei stehts sum_j=1L_to_i(P(C_j) */
329 /* */
330 /***********************************************************************/
331 /* RH 031092 */
332
build_propab_vector(propab,Cdeg,G,orb,Mg)333 INT build_propab_vector(propab,Cdeg,G,orb,Mg) OP propab,Cdeg,G,orb,Mg;
334 {
335 OP zaehler = callocobject();
336 OP nenner = callocobject();
337 OP zw = callocobject();
338 OP sum = callocobject();
339
340 INT i;
341
342 M_I_I(0L,sum);
343 mult(S_V_L(G),orb,nenner);
344
345 for(i=0L;i<S_V_LI(propab);++i)
346 {
347 mult(S_V_I(Cdeg,i),S_V_I(Mg,i),zaehler);
348 div(zaehler,nenner,zw);
349 add(zw,sum,sum);
350 copy(sum,S_V_I(propab,i));
351 }
352
353 freeall(zaehler);
354 freeall(nenner);
355 freeall(zw);
356 freeall(sum);
357 return OK;
358 }
359
360 /***********************************************************************/
361 /* */
362 /* Routine: bestimme_konjugiertenklasse */
363 /* -------- */
364 /* */
365 /* Mittels einer Zufallszahl wird die Konjugiertenklasse bestimmt zu */
366 /* der ein Fixpunkt konstruiert werden soll. */
367 /* */
368 /***********************************************************************/
369 /* RH 031092 */
370
bestimme_konjugiertenklasse(propab,ind,G,Orb)371 INT bestimme_konjugiertenklasse(propab,ind,G,Orb) OP propab;
372 INT *ind; OP G; OP Orb;
373 {
374 INT i;
375
376 OP oben = callocobject();
377 OP unten = callocobject();
378 OP z = callocobject();
379
380 M_I_I(0L,unten);
381 mult(Orb,S_V_L(G),z);
382 M_I_I(S_I_I(z),oben);
383
384 random_integer(z,unten,oben);
385 div(z,oben,z);
386 for(i=0L;i<S_V_LI(propab);++i)
387 {
388 if(LE(z,S_V_I(propab,i)))
389 {
390 *ind = i;
391 break;
392 }
393 }
394
395 freeall(oben);
396 freeall(unten);
397 freeall(z);
398 return OK;
399 }
400
401
402 /***********************************************************************/
403 /* */
404 /* Routine: bestimme_fixpunkt */
405 /* -------- */
406 /* */
407 /* Zu einem Gruppenelement wird gleichverteilt ein Fixpunkt konstru- */
408 /* iert. Dabei wird zwischen der Identitaet und den anderen Konjugier- */
409 /* tenklassen unterschieden, da fuer die Identitaet die Situation ein- */
410 /* facher ist und diese auch bei weitem am haeufigsten aufgerufen wird.*/
411 /* */
412 /***********************************************************************/
413 /* RH 031092 */
414
415 #ifdef PERMTRUE
bestimme_fixpunkt(G,C,Cdegrees,ind,weight,FP,Mg)416 INT bestimme_fixpunkt(G,C,Cdegrees,ind,weight,FP,Mg)
417 OP G; OP C; OP Cdegrees; INT ind;
418 OP weight; OP FP; OP Mg;
419 {
420 INT i;
421 INT j;
422 INT k;
423 INT besetzt;
424 INT zaehler;
425 OP z = callocobject();
426 OP oben = callocobject();
427 OP unten = callocobject();
428 OP g = callocobject();
429 OP a = callocobject();
430 OP sum = callocobject();
431 OP pz = callocobject();
432 OP part_g = callocobject();
433 OP ergzyk = callocobject();
434 OP multizyk = callocobject();
435 OP multipart = callocobject();
436 OP BEENDEN = callocobject();
437
438
439 if(ind == 0L)
440 {
441 M_I_I(S_P_LI(S_V_I(G,0L)),oben);
442 M_I_I(0L,unten);
443 for(k=0L;k<S_P_LI(S_V_I(G,0L));++k) M_I_I(0L,S_V_I(FP,k));
444
445 for(i=0L;i<S_V_LI(weight);++i)
446 {
447 if(S_V_II(weight,i)>0L)
448 {
449 for(j=0L;j<S_V_II(weight,i);++j)
450 {
451 zaehler = 0;
452 besetzt = 1L;
453 while(besetzt)
454 {
455 random_integer(z,unten,oben);
456 for(k=0L;k<S_V_LI(FP);++k)
457 {
458 if(zaehler == S_I_I(z) &&
459 S_V_II(FP,k) == 0L)
460 {
461 M_I_I(i+1L,S_V_I(FP,k));
462 M_I_I(S_I_I(oben)-1L,oben);
463 besetzt = 0L;
464 break;
465 }
466 else
467 if(S_V_II(FP,k) == 0L)
468 zaehler++;
469 }
470 }
471 }
472 }
473 }
474 }
475 else
476 {
477 if(S_V_II(Mg,ind) != 0L)
478 {
479 M_I_I(1L,unten);
480 M_I_I(S_V_II(Cdegrees,ind),oben);
481 random_integer(z,unten,oben);
482
483 zaehler = 0L;
484 for(i=0L;i<S_V_LI(G);++i)
485 {
486 if(S_V_II(C,i) == ind+1L) zaehler++;
487 if(zaehler == S_I_I(z))
488 {
489 copy(S_V_I(G,i),g);
490 break;
491 }
492 }
493 zykeltyp(g,part_g);
494 m_il_nv(S_P_LI(g),a);
495 make_real_cycletype(part_g,a);
496 m_il_nv(2L,pz);
497 m_il_nv(S_P_LI(g),S_V_I(pz,0L));
498 m_il_nv(S_P_LI(g),S_V_I(pz,1L));
499 bestimme_pz(a,g,pz);
500
501 M_I_I(1L,unten);
502 M_I_I(S_V_II(Mg,ind),oben);
503 random_integer(z,unten,oben);
504
505 m_il_nv(S_V_LI(weight),multipart);
506 m_il_nv(S_V_LI(weight),multizyk);
507 for(i=0L;i<S_V_LI(weight);++i)
508 m_il_nv(S_P_LI(S_V_I(G,0L)),S_V_I(multizyk,i));
509 M_I_I(0L,sum);
510 M_I_I(0L,BEENDEN);
511
512 berechne_Mgi_z(z,a,multipart,multizyk,
513 weight,sum,0L,ergzyk,BEENDEN);
514
515 besetze_fixpunkt(a,ergzyk,pz,FP);
516 }
517 else
518 {
519 #ifdef UNDEF
520 fprintf(stderr,"Diese Konjugiertenklasse liefert keine Fixpunkte !!!\n");
521 /* Darf eigentlich nicht ausgegeben werden !!! */
522 #endif
523 }
524 }
525
526 freeall(z);
527 freeall(oben);
528 freeall(unten);
529 freeall(g);
530 freeall(a);
531 freeall(pz);
532 freeall(sum);
533 freeall(part_g);
534 freeall(multizyk);
535 freeall(ergzyk);
536 freeall(multipart);
537 freeall(BEENDEN);
538 return OK;
539 }
540 #endif /* PERMTRUE */
541
542
543 /***********************************************************************/
544 /* */
545 /* Routine: dixon_wilf_examples */
546 /* -------- */
547 /* */
548 /* Steuerprogramm fuer den Algorithmus von Dixon Wilf. Beschreibung */
549 /* siehe Modulanfang. */
550 /* */
551 /***********************************************************************/
552 /* RH 031092 */
553
dixon_wilf_examples(G,weight,anz,FP)554 INT dixon_wilf_examples(G,weight,anz,FP)
555 OP G; OP weight; OP anz; OP FP;
556 {
557 INT Canz;
558 INT i;
559 INT j;
560 INT ind;
561
562 OP Cdegrees = callocobject();
563 OP C = callocobject();
564 OP Mg = callocobject();
565 OP MG = callocobject();
566 OP propab = callocobject();
567 OP fix = callocobject();
568
569 freeself(FP);
570
571 Ggen(G);
572 Canz = Cgen(G,C);
573 m_il_nv(Canz,Cdegrees);
574 Cdeg(C,Cdegrees);
575
576 m_il_nv(Canz,Mg);
577 Mggen(G,C,Cdegrees,weight,Mg);
578
579 MGgen(Mg,G,Cdegrees,MG);
580
581 m_il_nv(S_V_LI(Cdegrees),propab);
582 build_propab_vector(propab,Cdegrees,G,MG,Mg);
583
584 m_il_nv(S_P_LI(S_V_I(G,0L)),fix);
585 m_il_nv(S_I_I(anz),FP);
586
587 for(i=0L;i<S_I_I(anz);++i)
588 {
589 for(j=0;j<S_P_LI(S_V_I(G,0L));++j) M_I_I(0L,S_V_I(fix,j));
590 bestimme_konjugiertenklasse(propab,&ind,G,MG);
591 bestimme_fixpunkt(G,C,Cdegrees,ind,weight,fix,Mg);
592 copy(fix,S_V_I(FP,i));
593 }
594
595 freeall(Mg);
596 freeall(MG);
597 freeall(C);
598 freeall(propab);
599 freeall(Cdegrees);
600 freeall(fix);
601 return OK;
602 }
603
604
605 /***********************************************************************/
606 /* */
607 /* Routine: dixon_wilf_transversal */
608 /* -------- */
609 /* */
610 /* Steuerprogramm fuer den Algorithmus von Dixon Wilf. Beschreibung */
611 /* siehe Modulanfang. */
612 /* */
613 /***********************************************************************/
614 /* RH 031092 */
615
dixon_wilf_transversal(G,weight,anz,FP)616 INT dixon_wilf_transversal(G,weight,anz,FP)
617 OP G; OP weight; OP anz; OP FP;
618 {
619 INT Canz;
620 INT j;
621 INT k;
622 INT ind;
623 INT anz_fp;
624 INT count;
625
626 OP Cdegrees = callocobject();
627 OP C = callocobject();
628 OP Mg = callocobject();
629 OP MG = callocobject();
630 OP propab = callocobject();
631 OP fix = callocobject();
632
633 freeself(FP);
634
635 m_il_nv(0L,FP);
636
637 Ggen(G);
638 Canz = Cgen(G,C);
639 m_il_nv(Canz,Cdegrees);
640 Cdeg(C,Cdegrees);
641
642 m_il_nv(Canz,Mg);
643 Mggen(G,C,Cdegrees,weight,Mg);
644
645 MGgen(Mg,G,Cdegrees,MG);
646
647 m_il_nv(S_V_LI(Cdegrees),propab);
648 build_propab_vector(propab,Cdegrees,G,MG,Mg);
649
650 m_il_nv(S_P_LI(S_V_I(G,0L)),fix);
651 if(S_I_I(anz) == 0L || S_I_I(anz) > S_I_I(MG))
652 anz_fp = S_I_I(MG);
653 else
654 anz_fp = S_I_I(anz);
655
656
657 k = 0L;
658 count = 0L;
659 while(k < anz_fp)
660 {
661 for(j=0;j<S_V_LI(fix);++j) M_I_I(0L,S_V_I(fix,j));
662 bestimme_konjugiertenklasse(propab,&ind,G,MG);
663 bestimme_fixpunkt(G,C,Cdegrees,ind,weight,fix,Mg);
664 if(new_orbit(G,fix,FP))
665 {
666 inc(FP);
667 copy(fix,S_V_I(FP,S_V_LI(FP)-1L));
668 k++;
669 }
670 count++;
671 if(count %100 == 0L)fprintf(stderr,"Versuch nr: %d Gef.: %d\r",count,k);
672 }
673
674 freeall(Mg);
675 freeall(MG);
676 freeall(C);
677 freeall(propab);
678 freeall(Cdegrees);
679 freeall(fix);
680 return OK;
681 }
682
683
684 /***********************************************************************/
685 /* */
686 /* Routine: MGgen */
687 /* -------- */
688 /* */
689 /* Mittels des Lemmas von Cauchy-Frobenius wird die Anzahl der Bahnen */
690 /* |M//G| berechnet. */
691 /* */
692 /***********************************************************************/
693 /* RH 031092 */
694
MGgen(Mg,G,Cdeg,MG)695 static INT MGgen(Mg,G,Cdeg,MG)
696 OP Mg; OP G; OP Cdeg; OP MG;
697 {
698 INT i;
699
700 OP summand = callocobject();
701
702 /* Lemma von Cauchy-Frobenius orb = 1/|G| * (summe ueber Mg[i]) */
703
704 M_I_I(0L,MG);
705 for(i=0L;i<S_V_LI(Mg);++i)
706 {
707 mult(S_V_I(Cdeg,i),S_V_I(Mg,i),summand);
708 add(summand,MG,MG);
709 }
710 div(MG,S_V_L(G),MG);
711 freeall(summand);
712 return OK;
713 }
714
715
716 /***********************************************************************/
717 /* */
718 /* Routine: Mggen */
719 /* -------- */
720 /* */
721 /* Fuer die einzelnen Konjugiertenklassen werden die entsprechenden */
722 /* Fixpunktanzahlen als Summenvon Binomialkoeffizienten berechnet. */
723 /* */
724 /* */
725 /* Dabei werden Multipartitionen des Gewichtsvektor weight bestimmt */
726 /* und dann die moeglichen Belegungen auf der Partition des ausgewaehl-*/
727 /* ten Gruppenelements g_i berechnet. */
728 /* */
729 /* */
730 /***********************************************************************/
731 /* RH 031092 */
732
Mggen(G,C,Cdegrees,weight,Mg)733 static INT Mggen(G,C,Cdegrees,weight,Mg)
734 OP G; OP C; OP Cdegrees; OP weight; OP Mg;
735 {
736 INT i;
737 INT j;
738 INT k;
739
740 OP a = callocobject();
741 OP cycle_a = callocobject();
742 OP multipart = callocobject();
743 OP multizyk = callocobject();
744 OP hpart = callocobject();
745
746 m_il_nv(S_P_LI(S_V_I(G,0L)),a);
747 m_il_nv(S_V_LI(weight),multipart);
748 m_il_nv(S_V_LI(weight),multizyk);
749 for(i=0L;i<S_V_LI(weight);++i)
750 m_il_nv(S_P_LI(S_V_I(G,0L)),S_V_I(multizyk,i));
751
752 for(i=1L;i<=S_V_LI(Cdegrees);++i)
753 {
754 for(j=0L;j<S_V_LI(G);++j)
755 {
756 if(S_V_II(C,j) == i)
757 {
758 for(k=0L;k<S_V_LI(a);++k) M_I_I(0L,S_V_I(a,k));
759 zykeltyp(S_V_I(G,j),cycle_a);
760 make_real_cycletype(cycle_a,a);
761 berechne_Mgi(a,multipart,multizyk,weight,S_V_I(Mg,i-1L),0L);
762 break;
763 }
764 }
765 }
766
767 freeall(a);
768 freeall(cycle_a);
769 freeall(multipart);
770 freeall(multizyk);
771 freeall(hpart);
772 return OK;
773 }
774
775
776 /***********************************************************************/
777 /* */
778 /* Routine: berechne_Mgi */
779 /* -------- */
780 /* */
781 /* Unterroutine zu Mggen die die Multipartitionen berechnet. */
782 /* */
783 /***********************************************************************/
784 /* RH 031092 */
785
berechne_Mgi(a,multipart,multizyk,weight,Mgi,ind)786 static INT berechne_Mgi(a,multipart,multizyk,weight,Mgi,ind)
787 OP a,multipart; OP multizyk; OP weight; OP Mgi;
788 INT ind;
789 {
790 INT k;
791 OP hpart = callocobject();
792 OP hzyk = callocobject();
793 OP FP = callocobject();
794
795 if(ind == S_V_LI(weight))
796 {
797 M_I_I(0L,FP);
798 calculate_fixed_point_number(a,multizyk,FP);
799 if(S_I_I(FP) > 0L)
800 add(FP,Mgi,Mgi);
801 }
802 else
803 {
804 if(S_V_II(weight,ind) > 0L)
805 {
806 first_partition(S_V_I(weight,ind),
807 S_V_I(multipart,ind));
808 do
809 {
810 for(k=0L;k<S_V_LI(a);++k)
811 M_I_I(0L,S_V_I(S_V_I(multizyk,ind),k));
812 make_real_cycletype(S_V_I(multipart,ind),
813 S_V_I(multizyk,ind));
814 copy(S_V_I(multipart,ind),hpart);
815 copy(S_V_I(multizyk,ind),hzyk);
816 berechne_Mgi(a,multipart,multizyk,weight,Mgi,ind+1L);
817 copy(hpart,S_V_I(multipart,ind));
818 copy(hzyk,S_V_I(multizyk,ind));
819 }
820 while(next(S_V_I(multipart,ind),S_V_I(multipart,ind)));
821 }
822 else
823 {
824 berechne_Mgi(a,multipart,multizyk,weight,Mgi,ind+1L);
825 }
826 }
827 freeall(hpart);
828 freeall(hzyk);
829 freeall(FP);
830 return OK;
831 }
832
833
834 /***********************************************************************/
835 /* */
836 /* Routine: new_orbit */
837 /* -------- */
838 /* */
839 /* Indem die Gruppe G auf den Vektor FP losgelassen und dann mit */
840 /* fix vergleichen wird, wird festgestellt, ob ein neuer Bahnreprae- */
841 /* sentant vorliegt. */
842 /* */
843 /***********************************************************************/
844 /* RH 031092 */
845
new_orbit(G,fix,FP)846 INT new_orbit(G,fix,FP) OP G; OP fix; OP FP;
847 {
848 INT i;
849 INT j;
850 INT erg = 1L;
851 OP hfix = callocobject();
852
853 m_il_nv(S_V_LI(fix),hfix);
854
855 if (S_V_LI(FP) == 0L)
856 {
857 erg = 1L;
858 }
859 else
860 for(i=0L;i<S_V_LI(G);++i)
861 {
862 mult_g_fix(S_V_I(G,i),fix,hfix);
863 for(j=0L;j<S_V_LI(FP);++j)
864 {
865 if(EQ(hfix,S_V_I(FP,j)))
866 {
867 erg = 0L;
868 break;
869 }
870 }
871 if(erg == 0L) break;
872 }
873
874 freeall(hfix);
875
876 return(erg);
877 }
878
879
880 /***********************************************************************/
881 /* */
882 /* Routine: bestimme_pz */
883 /* -------- */
884 /* */
885 /* Zur Permutation g mit Zykeltyp a wird folgender zweizeiliger Vektor */
886 /* bestimmt: (Er dient spaeter bei der Besetzung der Fixpunkte) */
887 /* */
888 /* pz[0][i] = j i+1L liegt in Zykel der Laenge j */
889 /* pz[1][i] = k i+1L liegt im k-ten Zykel */
890 /* */
891 /***********************************************************************/
892 /* RH 031092 */
893
bestimme_pz(a,g,pz)894 static INT bestimme_pz(a,g,pz) OP a,g,pz;
895 {
896 INT weiter;
897 INT anz;
898 INT length;
899 INT beginn;
900 INT i;
901
902 OP anz_length = callocobject();
903 OP besucht = callocobject();
904
905 anz = length = 0L;
906 weiter = 1L;
907 beginn = 1L;
908
909 m_il_nv(S_V_LI(a),besucht);
910 m_il_nv(S_V_LI(a),anz_length);
911
912 M_I_I(1L,S_V_I(besucht,0L));
913
914 while(anz < S_V_LI(a))
915 {
916 length = 0L;
917 weiter = beginn;
918 do
919 {
920 length++;
921 weiter = S_P_II(g,weiter-1L);
922 M_I_I(1L,S_V_I(besucht,weiter-1L));
923 }
924 while(weiter != beginn);
925
926 M_I_I(1L+S_V_II(anz_length,length),
927 S_V_I(anz_length,length));
928 M_I_I(length,S_V_I(S_V_I(pz,0L),beginn-1L));
929 M_I_I(S_V_II(anz_length,length),
930 S_V_I(S_V_I(pz,1L),beginn-1L));
931
932 weiter = beginn;
933 do
934 {
935 weiter = S_P_II(g,weiter-1L);
936 M_I_I(length,S_V_I(S_V_I(pz,0L),weiter-1L));
937 M_I_I(S_V_II(anz_length,length),
938 S_V_I(S_V_I(pz,1L),weiter-1L));
939 }
940 while(weiter != beginn);
941
942 for(i=0L;i<S_V_LI(a);++i)
943 {
944 if(S_V_II(besucht,i) == 0L)
945 {
946 beginn = i+1L;
947 break;
948 }
949 }
950 anz+= length;
951 }
952
953 freeall(anz_length);
954 freeall(besucht);
955 return OK;
956 }
957
958
959 /***********************************************************************/
960 /* */
961 /* Routine: berechne_Mgi_z */
962 /* -------- */
963 /* */
964 /* Zu einer Zufallszahl z, die zwischen 1L und der Anzahl der Fixpunkte*/
965 /* der ausgewaehlten Konjugiertenklasse liegt wird eine Multipartition */
966 /* bestimmt, in der der z-te Fixpunkt enthalten ist. */
967 /* */
968 /* Verlaeuft analog zur Routine berechne_Mgi. */
969 /* */
970 /* */
971 /***********************************************************************/
972 /* RH 031092 */
973
berechne_Mgi_z(z,a,multipart,multizyk,weight,sum,ind,erg,BEENDEN)974 static INT berechne_Mgi_z(z,a,multipart,multizyk,weight,sum,ind,erg,BEENDEN)
975 OP z; OP a; OP multipart; OP multizyk; OP weight;
976 OP sum; INT ind; OP erg; OP BEENDEN;
977 {
978 INT k;
979 OP hpart = callocobject();
980 OP hzyk = callocobject();
981 OP FP = callocobject();
982
983 if(ind == S_V_LI(weight))
984 {
985 M_I_I(0L,FP);
986 calculate_fixed_point_number(a,multizyk,FP);
987 add(FP,sum,sum);
988 if(S_I_I(FP) != 0L && S_I_I(BEENDEN) == 0L)
989 {
990 if(S_I_I(sum)+S_I_I(FP) > S_I_I(z))
991 {
992 copy(multizyk, erg);
993 M_I_I(1L,BEENDEN);
994 }
995 }
996 }
997 else
998 {
999 if(S_I_I(sum) < S_I_I(z))
1000 {
1001 if(S_V_II(weight,ind) > 0L)
1002 {
1003 first_partition(S_V_I(weight,ind),
1004 S_V_I(multipart,ind));
1005 do
1006 {
1007 for(k=0L;k<S_V_LI(a);++k)
1008 M_I_I(0L,S_V_I(S_V_I(multizyk,ind),k));
1009 make_real_cycletype(S_V_I(multipart,ind),
1010 S_V_I(multizyk,ind));
1011 copy(S_V_I(multipart,ind),hpart);
1012 copy(S_V_I(multizyk,ind),hzyk);
1013 berechne_Mgi_z(z,a,multipart,multizyk,weight,sum,
1014 ind+1L,erg,BEENDEN);
1015 copy(hpart,S_V_I(multipart,ind));
1016 copy(hzyk,S_V_I(multizyk,ind));
1017 }
1018 while(next(S_V_I(multipart,ind),S_V_I(multipart,ind)));
1019 }
1020 else
1021 {
1022 berechne_Mgi_z(z,a,multipart,multizyk,
1023 weight,sum,ind+1L,erg,BEENDEN);
1024 }
1025 }
1026 }
1027 freeall(hpart);
1028 freeall(hzyk);
1029 freeall(FP);
1030 return OK;
1031 }
1032
1033 /***********************************************************************/
1034 /* */
1035 /* Routine: besetze_fixpunkt */
1036 /* -------- */
1037 /* */
1038 /* Im Fall der Auswahl einer nicht-trivialen Konjugiertenklasse wird */
1039 /* hier der Fixpunkt konstruiert, indem mittels Zufallszahlen aus der */
1040 /* Multipartition die passende Belegung konstruiert wird. */
1041 /* */
1042 /***********************************************************************/
1043 /* RH 031092 */
1044
besetze_fixpunkt(a,ergzyk,pz,FP)1045 static INT besetze_fixpunkt(a,ergzyk,pz,FP) OP a,ergzyk,pz,FP;
1046 {
1047 INT i;
1048 INT j;
1049 INT k;
1050 INT l;
1051 INT besetzt; INT zaehler;
1052
1053 OP z = callocobject();
1054 OP unten = callocobject();
1055 OP oben = callocobject();
1056 OP besucht = callocobject();
1057
1058 m_il_nv(S_V_LI(a),besucht);
1059
1060 M_I_I(1L,unten);
1061 for(i=0L;i<S_V_LI(a);++i)
1062 {
1063 if(S_V_II(a,i) > 0L)
1064 {
1065 M_I_I(S_V_II(a,i),oben);
1066 for(j=0L;j<S_V_LI(ergzyk);++j)
1067 {
1068 if(S_V_II(S_V_I(ergzyk,j),i) > 0L)
1069 {
1070 k = 0L;
1071 while(k < S_V_II(S_V_I(ergzyk,j),i))
1072 {
1073 besetzt = 1L;
1074 zaehler = 0L;
1075 while(besetzt)
1076 {
1077 random_integer(z,unten,oben);
1078 for(l=0L;l<S_V_LI(a);++l)
1079 {
1080 if(S_V_II(S_V_I(pz,0L),l) == i + 1L &&
1081 S_V_II(S_V_I(pz,1L),l) == S_I_I(z))
1082 if( S_V_II(besucht,l) == 0L)
1083 {
1084 M_I_I(j+1L,S_V_I(FP,l));
1085 M_I_I(1L,S_V_I(besucht,l));
1086 besetzt = 0L;
1087 M_I_I(S_I_I(oben)-1L,oben);
1088 }
1089 else
1090 {
1091 M_I_I(S_I_I(z)+1L,z);
1092 l = 0L;
1093 }
1094 }
1095 k++;
1096 }
1097 }
1098 }
1099 }
1100 }
1101 }
1102
1103 freeall(z);
1104 freeall(unten);
1105 freeall(oben);
1106 freeall(besucht);
1107 return OK;
1108 }
1109
1110 /***********************************************************************/
1111 /* */
1112 /* Routine: mult_g_fixpunkt */
1113 /* -------- */
1114 /* */
1115 /* Die Permutation g wird auf fix angewendet und das Ergebnis in hfix */
1116 /* gespeichert. */
1117 /* */
1118 /***********************************************************************/
1119 /* RH 031092 */
1120
mult_g_fix(g,fix,hfix)1121 static INT mult_g_fix(g,fix,hfix) OP g,fix,hfix;
1122 {
1123 INT i;
1124
1125 invers(g,g);
1126 for(i=0L;i<S_P_LI(g);++i)
1127 M_I_I(S_V_II(fix,S_P_II(g,i)-1L),S_V_I(hfix,i));
1128 invers(g,g);
1129 return OK;
1130 }
1131
bestimme_egf(fix,egf)1132 static INT bestimme_egf(fix,egf) OP fix; OP egf;
1133 {
1134 INT i,e1,e2;
1135
1136 for(i=0L;i<S_V_LI(fix);++i)
1137 {
1138 if(S_V_II(fix,i) != 0L)
1139 {
1140 get_edge(S_V_LI(egf),i+1L,&e1,&e2);
1141 M_I_I(S_V_II(egf,e1-1L)+1L,S_V_I(egf,e1-1L));
1142 M_I_I(S_V_II(egf,e2-1L)+1L,S_V_I(egf,e2-1L));
1143 }
1144 }
1145 return OK;
1146 }
1147
get_edge(n,i,e1,e2)1148 static INT get_edge(n,i,e1,e2) INT n,i,*e1,*e2;
1149 {
1150 INT w;
1151
1152 w = n-1L;
1153
1154 *e1 = 1L;
1155 *e2 = 1L;
1156
1157 if(i-w<=0L)
1158 {
1159 *e1 = 1L;
1160 *e2 = (*e1)+i;;
1161 }
1162 else
1163 {
1164 while(i - w > 0L)
1165 {
1166 i-= w;
1167 (*e1)++;
1168 w--;
1169 }
1170 (*e2) = (*e1)+i;
1171 }
1172 return OK;
1173 }
1174
1175 /***********************************************************************/
1176 /***********************************************************************/
1177 /* */
1178 /* Konstruktion von Bahnrepraesentatnen vorgegebener Laenge einer */
1179 /* Gruppe G, die auf m^n operiert. */
1180 /* */
1181 /*---------------------------------------------------------------------*/
1182 /* Written by: Ralf Hager November 1992 */
1183 /*---------------------------------------------------------------------*/
1184 /* */
1185 /***********************************************************************/
1186 /***********************************************************************/
1187
1188
1189
1190 /***********************************************************************/
1191 /* */
1192 /* Die Erzeuger der Gruppe G, die auf dem File stehen muessen werden */
1193 /* als Vektor von Permutationen gespeichert. */
1194 /* */
1195 /* Es wird keine Pruefung vorgenommen, ob die Eingaben sinnvoll sind */
1196 /* z.B. len | |G|, usw. */
1197 /* */
1198 /* Auch hier, wie bei allen Anwendungen von Dixon-Wilf sind nur kleine */
1199 /* Gruppen sinnvoll, da die Konjugiertenkl. berechnet werden muessen */
1200 /* */
1201 /* Wird beim Aufruf des Programms get_orb_rep der letzte Parameter */
1202 /* mit 0L besetzt, so wird nur die Anzahl der Bahnrepraesentanten */
1203 /* berechnet, bei 1L werden sie konstruiert. Beidesmal steht das Ergeb-*/
1204 /* nis in L. */
1205 /* Die Anzahlberechnung empfiehlt sich vorab, denn bei mehr als ca. */
1206 /* 5000 zu konstruierenden Fixpunkten treten eventuell Speicherplatz- */
1207 /* probleme auf. */
1208 /* */
1209 /* ------------------------------------------------------------------- */
1210 /* */
1211 /* Der Vorteil bei diesem Programm besteht darin, dass nur fuer einige */
1212 /* Gewichte die Fixpunkte berechnet werden, alle uebrigen dann durch */
1213 /* Einfaerben gewonnen werden. */
1214 /* Dadurch werden z.B. fuer G = C_7 , auf 7^7 nur ca. 11400 Versuche */
1215 /* durchgefuehrt, es gibt aber 117648 Lyndon-Woerter. */
1216 /* */
1217 /* Durch das noch nicht optimal programmierte Einfaerben waechst der */
1218 /* Aufwand mit wachsendem m besonders stark. */
1219 /* */
1220 /* ------------------------------------------------------------------- */
1221 /* */
1222 /***********************************************************************/
1223
1224
1225
get_orb_rep(G,m,n,L,len,konstr)1226 INT get_orb_rep(G,m,n,L,len,konstr)
1227 OP G; OP m; OP n; OP L; OP len; INT konstr;
1228 {
1229 INT i;
1230 INT j;
1231 INT k;
1232
1233 INT c_fp = 0L;
1234 INT c_lyn = 0L;
1235 INT c_v = 0L;
1236 INT count = 0L;
1237 INT Canz = 0L;
1238 INT ind = 0L;
1239 INT anz_fp = 0L;
1240
1241 INT hfix_in_ww();
1242 INT Cgen();
1243
1244 OP weight = callocobject();
1245 OP anz = callocobject();
1246 OP FP = callocobject();
1247 OP part = callocobject();
1248 OP perm = callocobject();
1249 OP fix = callocobject();
1250 OP hfix = callocobject();
1251 OP Cdegrees = callocobject();
1252 OP C = callocobject();
1253 OP Mg = callocobject();
1254 OP MG = callocobject();
1255 OP propab = callocobject();
1256 OP perm_vec = callocobject();
1257 OP p = callocobject();
1258 OP b = callocobject();
1259 OP hweight = callocobject();
1260 OP weight_watcher = callocobject();
1261
1262 if(S_I_I(n) == 1L)
1263 {
1264 if(konstr == 0L)
1265 M_I_I(S_I_I(m),L);
1266 else
1267 {
1268 m_il_nv(S_I_I(m),L);
1269 for(i=0L;i<S_I_I(m);++i)
1270 M_I_I(i,S_V_I(L,i));
1271 }
1272 goto ende; /* AK 281093 */
1273 }
1274
1275 m_il_p(S_I_I(m),p);
1276 m_il_nv(S_I_I(m),b);
1277 m_il_nv(S_I_I(n),hweight);
1278 M_I_I(0L,anz);
1279
1280 if(konstr == 1L)
1281 m_il_nv(0L,L);
1282 c_lyn= 0L;
1283
1284
1285 m_il_nv(0L,FP);
1286
1287 Ggen(G);
1288 fprintf(stderr,"Gruppe erzeugt Ordnung %" PRIdPTR "\n" ,S_V_LI(G));
1289
1290 if(S_I_I(len) == 0L)
1291 M_I_I(S_V_LI(G),len);
1292
1293 Canz = Cgen(G,C);
1294 fprintf(stderr, "Konjugiertenklassen erzeugt Anzahl %" PRIINT "\n" ,Canz);
1295 m_il_nv(Canz,Cdegrees);
1296 Cdeg(C,Cdegrees);
1297
1298 first_partition(n,part);
1299 next(part,part);
1300 do
1301 {
1302 if(S_PA_LI(part) <= S_I_I(m))
1303 {
1304 m_il_nv(0L,FP);
1305 m_il_nv(S_I_I(n),weight);
1306
1307 for(j=1L;j<S_PA_LI(part);++j)
1308 M_I_I(S_PA_II(part,j),S_V_I(weight,j-1L));
1309
1310 for(j=0L;j<S_PA_LI(part);++j)
1311 M_I_I(S_PA_II(part,j),S_V_I(hweight,j));
1312
1313 m_il_nv(Canz,Mg);
1314 Mggen(G,C,Cdegrees,weight,Mg);
1315
1316 MGgen(Mg,G,Cdegrees,MG);
1317 printf( "Anzahl Bahnrepraesentanten: %" PRIdPTR "\n" ,S_I_I(MG));
1318
1319 m_il_nv(S_V_LI(Cdegrees),propab);
1320 build_propab_vector(propab,Cdegrees,G,MG,Mg);
1321
1322 m_il_nv(S_P_LI(S_V_I(G,0L)),fix);
1323 if(S_I_I(anz) == 0L || S_I_I(anz) > S_I_I(MG))
1324 anz_fp = S_I_I(MG);
1325 else
1326 anz_fp = S_I_I(anz);
1327
1328 k = 0L;
1329 count = 0L;
1330 while(k < anz_fp)
1331 {
1332 for(j=0;j<S_V_LI(fix);++j) M_I_I(0L,S_V_I(fix,j));
1333 bestimme_konjugiertenklasse(propab,&ind,G,MG);
1334 bestimme_fixpunkt(G,C,Cdegrees,ind,weight,fix,Mg);
1335 if(new_orbit(G,fix,FP))
1336 {
1337 inc(FP);
1338 copy(fix,S_V_I(FP,S_V_LI(FP)-1L));
1339 k++;
1340 }
1341 count++;
1342 if(count %100 == 0L)
1343 fprintf(stderr,"Versuch nr: %d Gef.: %d\r",count,k);
1344 }
1345 fprintf(stderr,"Anzahl der gemachten Versuche: %d\n",count);
1346
1347 c_fp+= S_V_LI(FP);
1348 c_v+= count;
1349 lyndon_orb(G,FP,len);
1350
1351
1352 if(S_V_LI(FP)>0L)
1353 {
1354 m_il_nv(S_I_I(m),b);
1355 m_il_nv(0L,weight_watcher);
1356 m_il_nv(0L,perm_vec);
1357 copy(S_V_I(FP,0L),fix);
1358 SYM_sort(fix);
1359
1360 get_perm(hweight,p,b,S_I_I(n),S_I_I(m),0L,
1361 perm_vec,weight_watcher,fix);
1362
1363 if(konstr == 1L)
1364 for(i=0L;i<S_V_LI(perm_vec);++i)
1365 {
1366 for(j=0L;j<S_V_LI(FP);++j)
1367 {
1368 mult_perm_fix(S_V_I(perm_vec,i),
1369 S_V_I(FP,j),hfix);
1370 inc(L);
1371 copy(hfix,S_V_I(L,c_lyn));
1372 c_lyn++;
1373 }
1374 }
1375 else
1376 {
1377 M_I_I(S_V_LI(perm_vec)*S_V_LI(FP)+S_I_I(L),L);
1378 c_lyn+= S_V_LI(perm_vec)*S_V_LI(FP);
1379 }
1380 }
1381 printf("Fixpunkte %d Gef. Bahnrepr.: %d Versuche %d\n",
1382 c_fp,c_lyn,c_v);
1383 }
1384 } while(next(part,part));
1385
1386 ende:
1387 freeall(part);
1388 freeall(anz);
1389 freeall(FP);
1390 freeall(perm);
1391 freeall(fix);
1392 freeall(hfix);
1393 freeall(weight_watcher);
1394 freeall(Mg);
1395 freeall(MG);
1396 freeall(C);
1397 freeall(propab);
1398 freeall(Cdegrees);
1399 freeall(hweight);
1400 freeall(perm_vec);
1401 freeall(p);
1402 freeall(b);
1403 return OK;
1404 }
1405
lyndon_orb(G,FP,len)1406 INT lyndon_orb(G,FP,len) OP G; OP FP; OP len;
1407 {
1408 INT i;
1409 INT orblen();
1410 OP lyn = callocobject();
1411
1412 m_il_nv(1L,lyn);
1413 for(i=0L;i<S_V_LI(FP);++i)
1414 if(orblen(G,S_V_I(FP,i)) == S_I_I(len))
1415 {
1416 copy(S_V_I(FP,i),S_V_I(lyn,S_V_LI(lyn)-1L));
1417 inc(lyn);
1418 }
1419
1420 dec(lyn);
1421 copy(lyn,FP);
1422
1423 freeall(lyn);
1424 return OK;
1425 }
1426
orblen(G,fix)1427 INT orblen(G,fix) OP G; OP fix;
1428 {
1429 INT i;
1430 INT j;
1431 INT neu = 1L;
1432 INT erg = 0L;
1433 OP orb = callocobject();
1434 OP hfix = callocobject();
1435
1436 m_il_nv(1L,orb);
1437 copy(fix,S_V_I(orb,0L));
1438
1439 m_il_nv(S_V_LI(fix),hfix);
1440
1441 for(i=0L;i<S_V_LI(G);++i)
1442 {
1443 neu = 1L;
1444 mult_g_fix(S_V_I(G,i),fix,hfix);
1445 for(j=0L;j<S_V_LI(orb);++j)
1446 {
1447 if(EQ(hfix,S_V_I(orb,j)))
1448 {
1449 neu = 0L;
1450 break;
1451 }
1452 }
1453 if(neu)
1454 {
1455 inc(orb);
1456 copy(hfix,S_V_I(orb,S_V_LI(orb)-1L));
1457 }
1458 }
1459 erg = S_V_LI(orb);
1460
1461 freeall(orb);
1462 freeall(hfix);
1463
1464 return(erg);
1465 }
1466
mult_perm_fix(perm,fix,hfix)1467 INT mult_perm_fix(perm,fix,hfix) OP perm,fix,hfix;
1468 {
1469 INT i;
1470 OP hilf = callocobject();
1471
1472 m_il_nv(S_V_LI(fix),hilf);
1473 for(i=0L;i<S_V_LI(fix);++i)
1474 M_I_I(S_P_II(perm,S_V_II(fix,i))-1L,S_V_I(hilf,i));
1475
1476 copy(hilf,hfix);
1477 freeall(hilf);
1478 return OK;
1479 }
1480
hfix_in_ww(fix,ww)1481 INT hfix_in_ww(fix,ww) OP fix,ww;
1482 {
1483 INT i;
1484 INT erg = 0L;
1485
1486 if(S_V_LI(ww) > 0L)
1487 for(i=0L;i<S_V_LI(ww);++i)
1488 if(EQ(S_V_I(ww,i),fix))
1489 {
1490 erg = 1L;
1491 break;
1492 }
1493 return(erg);
1494 }
1495
get_perm(w,p,b,n,m,ind,perm_vec,ww,fix)1496 INT get_perm(w,p,b,n,m,ind,perm_vec,ww,fix)
1497 OP w,p,b; INT n,m,ind; OP perm_vec,ww,fix;
1498 {
1499 INT i;
1500 OP hfix = callocobject();
1501
1502 if(ind == m)
1503 {
1504 mult_perm_fix(p,fix,hfix);
1505 SYM_sort(hfix);
1506 if(!hfix_in_ww(hfix,ww))
1507 {
1508 inc(ww);
1509 copy(hfix,S_V_I(ww,
1510 S_V_LI(ww)-1L));
1511 inc(perm_vec);
1512 copy(p,S_V_I(perm_vec,S_V_LI(perm_vec)-1L));
1513 }
1514 }
1515 else
1516 {
1517 for(i=0L;i<m;++i)
1518 {
1519 if(S_V_II(b,i) == 0L)
1520 {
1521 if(i != ind)
1522 {
1523 if(S_V_II(w,i) != S_V_II(w,ind))
1524 {
1525 M_I_I(ind+1L,S_P_I(p,i));
1526 M_I_I(1L,S_V_I(b,i));
1527 get_perm(w,p,b,n,m,ind+1L,perm_vec,ww,fix);
1528 M_I_I(0L,S_V_I(b,i));
1529 }
1530 }
1531 else
1532 {
1533 M_I_I(ind+1L,S_P_I(p,i));
1534 M_I_I(1L,S_V_I(b,i));
1535 get_perm(w,p,b,n,m,ind+1L,perm_vec,ww,fix);
1536 M_I_I(0L,S_V_I(b,i));
1537 }
1538 }
1539 }
1540 }
1541 freeall(hfix);
1542 return OK;
1543 }
1544
1545