1 /*  SYMMETRICA zykelind.c */
2 
3 #include "def.h"
4 #include "macro.h"
5 
6 
7 static INT zykeltyp_on_pairs_reduced();
8 static INT zykeltyp_on_2sets();
9 static INT zykeltyp_on_ksubsets();
10 static INT zykeltyp_on_ktuples();
11 
12 static INT zykelind_index_verschieben();
13 
14 static INT zykelind_operation_for_exp();
15 static INT zykeltyp_operation_for_exp();
16 
17 static INT zykeltyp_poly_part();
18 static INT zykeltyp_hyperbegleitmatrix_poly();
19 static INT exponenten_bestimmen();
20 static INT charakteristik_bestimmen();
21 static INT zykeltyp_poly_part_aff();
22 static INT zykeltyp_hyperbegleitmatrix_poly_afferg();
23 
24 static INT zykelind_aff1Zp();
25 static INT zykelind_aff1Z2();
26 
27 static INT min_pot();
28 static INT zykelind_dir_prod_pglkq();
29 static INT zykelind_dir_prod_pglkq_apply();
30 static INT zykelind_hoch_dir_prod_pglkq();
31 static INT mod_mult();
32 static INT subexponenten_bestimmen();
33 static INT zyklische_gruppe();
34 static INT zykeltyp_poly_part_pglkq();
35 static INT zykeltyp_hyperbegleitmatrix_poly_pglkq();
36 static INT zykelind_aus_subzykelind();
37 static INT monom_to_vek();
38 static INT vek_to_monom();
39 
40 static INT sum_vector11();
41 static INT sum_vector1();
42 static INT zykelind_red();
43 static INT zykelind_red_apply();
44 static INT debruijn_formel();
45 
46 static INT eval_polynom_maxgrad();
47 static INT mult_po_po_maxgrad();
48 static INT hoch_po_maxgrad();
49 
50 static INT zykelind_test1();
51 static INT comp_vector1();
52 static INT ordnung();
53 static INT mu();
54 static INT vektor_mult_apply();
55 static INT vektor_prod();
56 static INT vektor_kgv_prod_durch_kgv();
57 static INT fmultinom();
58 static INT fmultinom_ext();
59 static INT erster_kandidat();
60 static INT next_kandidat();
61 static INT next_kandidat2();
62 static INT first_unordered_part_into_atmost_k_parts();
63 static INT next_unordered_part_into_atmost_k_parts();
64 static INT first_part_into_atmost_k_parts();
65 static INT next_part_into_atmost_k_parts();
66 
67 static INT redf_f1();
68 static INT redf_f2();
69 static INT redf_f3();
70 static INT redf_f1h();
71 static INT redf_f2h();
72 static INT redf_f3h();
73 static INT redf_formel();
74 
75 
76 #ifdef POLYTRUE
zykelind_dir_prod(a,b,c)77 INT zykelind_dir_prod(a,b,c)
78 /* Berechnet aus den Zykelindizes a und b einen
79    weiteren Zykelindex c. Es operiere G auf X und H
80    auf Y dann operiert  G\times H auf X\times Y. Der
81    Zykelindex c ist der Zykelindex der Operation von
82    G\times H in obiger Situation, falls a der
83    Zykelindex von der Aktion von G auf X und b der
84    Zykelindex der Aktion von H auf Y ist. */
85     OP a,b,c;
86 {
87     OP hilfk,hilfmonom,monom1,monom2,monom3;
88     INT i1,i2,ex1,ex2;
89     INT erg=OK;
90     CTO(POLYNOM,"zykelind_dir_prod(1)",a);
91     CTO(POLYNOM,"zykelind_dir_prod(2)",b);
92     hilfk=callocobject();
93     hilfmonom=callocobject();
94     monom3=callocobject();
95     M_I_I(0L,hilfk);
96     erg+=m_scalar_polynom(hilfk,c);
97     monom1=a;
98     while (monom1!=NULL)
99     {
100       monom2=b;
101       while (monom2!=NULL)
102       {
103         erg+=mult(S_PO_K(monom1),S_PO_K(monom2),hilfk);
104         erg+=m_scalar_polynom(hilfk,monom3);
105         for (i1=0L; i1<S_V_LI(S_PO_S(monom1)) ; ++i1)
106         {
107           ex1=S_V_II(S_PO_S(monom1),i1);
108           if (ex1 != 0L)
109           {
110         for (i2=0L; i2<S_V_LI(S_PO_S(monom2)); ++i2)
111         {
112           ex2=S_V_II(S_PO_S(monom2),i2);
113           if (ex2 != 0L)
114           {
115             erg+=m_iindex_iexponent_monom(((i1+1L)*(i2+1L)/ggt_i(i1+1L,i2+1L))-1L,ex1*ex2*ggt_i(i1+1L,i2+1L),hilfmonom);
116             erg+=mult_apply(hilfmonom,monom3);
117           }
118         }
119           }
120         }
121         monom2=S_PO_N(monom2);
122         erg+=add_apply(monom3,c);
123       }
124       monom1=S_PO_N(monom1);
125     }
126     FREEALL(hilfk);
127     FREEALL(hilfmonom);
128     FREEALL(monom3);
129     ENDR("zykelind_dir_prod");
130 }
131 
zykelind_dir_prod_apply(a,b)132 INT zykelind_dir_prod_apply(a,b) OP a,b;
133 {
134     OP hilf;
135     INT erg=OK;
136     CTO(POLYNOM,"zykelind_dir_prod_apply(1)",a);
137     CTO(POLYNOM,"zykelind_dir_prod_apply(2)",b);
138     hilf=callocobject();
139     erg+=zykelind_dir_prod(a,b,hilf);
140     erg+=copy(hilf,b);
141     erg+=freeall(hilf);
142     ENDR("zykelind_dir_prod_apply");
143 }
144 
zykelind_dir_summ(a,b,c)145 INT zykelind_dir_summ(a,b,c)
146 /* Berechnet aus den Zykelindizes a und b einen
147    weiteren Zykelindex c. Es operiere G auf X und H
148    auf Y, wobei X und Y keine gemeinsamen Elemente
149    besitzen, dann operiert  G\times H auf X\cup Y.
150    Der Zykelindex c ist der Zykelindex der Operation
151    von G\times H in obiger Situation, falls a der
152    Zykelindex von der Aktion von G auf X und b der
153    Zykelindex der Aktion von H auf Y ist. */
154     OP a,b,c;
155 {
156     INT erg=OK;
157     CTO(POLYNOM,"zykelind_dir_summ(1)",a);
158     CTO(POLYNOM,"zykelind_dir_summ(2)",b);
159     erg+=mult(a,b,c);
160     ENDR("zykelind_dir_summ");
161 }
162 
zykelind_dir_summ_apply(a,b)163 INT zykelind_dir_summ_apply(a,b)
164     OP a,b;
165 {
166     OP hilf;
167     INT erg=OK;
168     CTO(POLYNOM,"zykelind_dir_summ_apply(1)",a);
169     CTO(POLYNOM,"zykelind_dir_summ_apply(2)",b);
170     MULT_APPLY(a,b);
171     ENDR("zykelind_dir_summ_apply");
172 }
173 
zykelind_hoch_dir_summ(a,c,b)174 INT zykelind_hoch_dir_summ(a,c,b) OP a,b,c;
175 /* Berechnet den Zykelindex b als c-fache direkte Summe des Zykelindex
176    a.  */
177 {
178     INT erg=OK;
179     CTO(POLYNOM,"zykelind_hoch_dir_summ(1)",a);
180     CTO(INTEGER,"zykelind_hoch_dir_summ(2)",c);
181     SYMCHECK(S_I_I(c)<0,"zykelind_hoch_dir_summ: exponent<0");
182     erg+=hoch(a,c,b);
183     ENDR("zykelind_hoch_dir_summ");
184 }
185 
zykelind_hoch_dir_prod(a,c,b)186 INT zykelind_hoch_dir_prod(a,c,b) OP a,b,c;
187 /* Berechnet den Zykelindex b als c-faches direktes Produkt
188    des Zykelindex a.  */
189 {
190     INT erg=OK;
191     CTO(POLYNOM,"zykelind_hoch_dir_prod(1)",a);
192     CTO(INTEGER,"zykelind_hoch_dir_prod(2)",c);
193     SYMCHECK(S_I_I(c)<0,"zykelind_hoch_dir_prod(2) negativ");
194     FREESELF(b);
195     if (nullp(c))
196          return M_I_I(1L,b);
197     else if (einsp(c))
198          return copy(a,b);
199     else    {
200             OP n = callocobject();
201             OP d = callocobject();
202             erg+=copy(c,n);
203             erg+=copy(a,b);
204             erg+=dec(n);
205             while (not nullp(n)) {
206                 erg+=zykelind_dir_prod(a,b,d);
207                 erg+=dec(n);
208                 erg+=copy(d,b);
209                 }
210             FREEALL(d);
211             FREEALL(n);
212         };
213     ENDR("zykelind_hoch_dir_prod");
214 }
215 
eval_polynom_dir_prod(a,v,c)216 INT eval_polynom_dir_prod(a,v,c) OP a,v,c;
217 {
218     INT i;
219     INT erg=OK;
220     OP monom,hmonom,hmonom1;
221     CTO(POLYNOM,"eval_polynom_dir_prod(1)",a);
222     hmonom=callocobject();
223     hmonom1=callocobject();
224     monom=a;
225     erg+=m_i_i(0l,c);
226     while (monom!=NULL)
227     {
228       erg+=m_iindex_monom(0L,hmonom1);
229       for (i=0L;i<S_V_LI(S_PO_S(monom));++i)
230       {
231         if (!nullp(S_PO_SI(monom,i)))
232         {
233           erg+=zykelind_hoch_dir_prod(S_V_I(v,i),S_PO_SI(monom,i),hmonom);
234           erg+=zykelind_dir_prod_apply(hmonom,hmonom1);
235         }
236       }
237       erg+=mult_apply(S_PO_K(monom),hmonom1);
238       erg+=add_apply(hmonom1,c);
239       monom=S_PO_N(monom);
240     }
241     erg+=freeall(hmonom);
242     erg+=freeall(hmonom1);
243     ENDR("eval_polynom_dir_prod");
244 }
245 
zykeltyp_on_pairs_reduced(a,b)246 static INT zykeltyp_on_pairs_reduced(a,b) OP a,b;
247 /* Berechnet den Zykeltyp einer Permutation, auf der Menge aller
248    geordneter Paare (i,j) mit i ungleich j.
249    a ist ein Monom (der Zykeltyp der Permutation auf der Menge der
250    Punkte i,j,...)
251    b ist ein Monom (der Zykeltyp, der durch obige Permutation
252    mit Zykeltyp a auf der Menge der Paare (i,j) mit i ungleich j
253    induziert wird.) */
254 {
255     INT i1,i2,ex1,ex2;
256     INT erg=OK;
257     OP hilfmonom;
258     if (S_O_K(a)!=POLYNOM) return error("zykeltyp_on_pairs_reduced(a,b) a not POLYNOM");
259     if (not EMPTYP(b)) erg+=freeself(b);
260     hilfmonom=callocobject();
261         erg+=m_scalar_polynom(S_PO_K(a),b);
262         for (i1=0L; i1<S_V_LI(S_PO_S(a))-1L ; ++i1)
263         {
264           ex1=S_V_II(S_PO_S(a),i1);
265           if (ex1 != 0L)
266           {
267         for (i2=i1+1L; i2<S_V_LI(S_PO_S(a)); ++i2)
268         {
269           ex2=S_V_II(S_PO_S(a),i2);
270           if (ex2 != 0L)
271           {
272             erg+=m_iindex_iexponent_monom(((i1+1L)*(i2+1L)/ggt_i(i1+1L,i2+1L))-1L,2*ex1*ex2*ggt_i(i1+1L,i2+1L),hilfmonom);
273             erg+=mult_apply(hilfmonom,b);
274           }
275         }
276           erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)*ex1-1L),hilfmonom);
277           erg+=mult_apply(hilfmonom,b);
278           }
279         }
280           i1=S_V_LI(S_PO_S(a))-1L;
281           ex1=S_V_II(S_PO_S(a),i1);
282           if (ex1 != 0L)
283           {
284         erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)*ex1-1L),hilfmonom);
285         erg+=mult_apply(hilfmonom,b);
286           }
287     erg+=freeall(hilfmonom);
288     if (erg != OK) error(" in computation of zykeltyp_on_pairs_reduced(a,b) ");
289     return(erg);
290 }
291 
zykelind_on_pairs_reduced(a,b)292 INT zykelind_on_pairs_reduced(a,b)
293 /* Berechnet aus dem Zykelindex a den Zykelindex b
294    der auf der Menge der geordneten Paare (i,j) mit i
295    ungleich j induzierten Gruppenaktion, die durch die
296    zu a gehoerende Gruppenaktion definiert wird. */
297     OP a,b;
298 {
299     OP hilfk,monom1,monom3;
300     INT erg=OK;
301     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_pairs_reduced(a,b) a not POLYNOM");
302     if (not EMPTYP(b)) erg+=freeself(b);
303     hilfk=callocobject();
304     monom3=callocobject();
305     M_I_I(0L,hilfk);
306     erg+=m_scalar_polynom(hilfk,b);
307     monom1=a;
308     while (monom1!=NULL)
309     {
310       erg+=zykeltyp_on_pairs_reduced(monom1,monom3);
311       erg+=add_apply(monom3,b);
312       monom1=S_PO_N(monom1);
313     }
314     erg+=freeall(hilfk); erg+=freeall(monom3);
315     if (erg != OK) error(" in computation of zykelind_on_pairs_reduced(a,b) ");
316     return(erg);
317 }
318 
zykelind_on_pairs(a,b)319 INT zykelind_on_pairs(a,b)
320 /* Berechnet aus dem Zykelindex a den Zykelindex b
321    der auf der Menge der geordneten Paare (i,j) [ auch Paare
322    der Form (i,i) ] induzierten Gruppenaktion, die durch die
323    zu a gehoerende Gruppenaktion definiert wird. */
324     OP a,b;
325 {
326     OP hilfk,hilfmonom,monom1,monom3;
327     INT erg=OK;
328     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_pairs(a,b) a not POLYNOM");
329     if (not EMPTYP(b)) erg+=freeself(b);
330     hilfk=callocobject();
331     hilfmonom=callocobject();
332     monom3=callocobject();
333     M_I_I(0L,hilfk);
334     erg+=m_scalar_polynom(hilfk,b);
335     monom1=a;
336     while (monom1!=NULL)
337     {
338       erg+=zykeltyp_on_pairs_reduced(monom1,monom3);
339       erg+=m_skn_po(s_po_s(monom1),cons_eins,NULL,hilfmonom);
340       erg+=mult_apply(hilfmonom,monom3);
341       erg+=add(b,monom3,b);
342       monom1=S_PO_N(monom1);
343     }
344     erg+=freeall(hilfk); erg+=freeall(hilfmonom); erg+=freeall(monom3);
345     if (erg != OK) error(" in computation of zykelind_on_pairs(a,b) ");
346     return(erg);
347 }
348 
zykelind_on_pairs_disjunkt(a,bb)349 INT zykelind_on_pairs_disjunkt(a,bb)  OP a,bb;
350 /* Berechnet aus dem Zykelindex a den Zykelindex bb
351    der auf der Menge der geordneten Paare (i,j) [ auch Paare
352    der Form (i,i) ] induzierten Gruppenaktion, die durch die
353    zu a gehoerende Gruppenaktion definiert wird. Dabei werden fuer
354    Kanten und Schlingen verschiedene Unbestimmte verwendet.
355    s_mz_v(bb) ist ein Vektor Objekt, das die Stelle angibt, an der die
356    zwei Familien von Unbestimmten beginnen. Das heisst:
357    s_v_ii(s_mz_v(bb),0L) entspricht dem Index der Unbestimmten x_1 und
358    s_v_ii(s_mz_v(bb),1L) entspricht dem Index der Unbestimmten y_1,
359    wobei die
360    Familie der Unbestimmten x_i zu den Kanten und die Familie der y_i
361    zu den Schlingen gehoeren.  */
362 {
363     OP hilfk,hilfmonom,monom1,monom3,monom4,vekt;
364     OP b,c;
365     INT i1,i2,ex1,ex2;
366     INT erg=OK;
367     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_pairs_disjunkt(a,b) a not POLYNOM");
368     if (not EMPTYP(bb)) erg+=freeself(bb);
369     hilfk=callocobject();
370     hilfmonom=callocobject();
371     monom3=callocobject();
372     monom4=callocobject();
373     b=callocobject();
374     c=callocobject();
375     vekt=callocobject();
376     M_I_I(0L,hilfk);
377     erg+=m_scalar_polynom(hilfk,b);
378     erg+=numberofvariables(a,hilfk);
379     erg+=m_il_v(2L,c);
380     M_I_I(0L,S_V_I(c,0L));
381     erg+=copy(hilfk,S_V_I(c,1L));
382     monom1=a;
383     while (monom1!=NULL)
384     {
385           erg+=zykeltyp_on_pairs_reduced(monom1,monom3);
386           erg+=copy(S_PO_S(monom1),vekt);
387           while (S_V_LI(vekt)<S_I_I(hilfk))
388           {
389          erg+=inc(vekt);
390          M_I_I(0L,S_V_I(vekt,S_V_LI(vekt)-1L));
391           }
392           erg+=m_skn_po(vekt,cons_eins,NULL,hilfmonom);
393           /*if (S_O_K(S_PO_S(hilfmonom))==INTEGERVECTOR) C_O_K(S_PO_S(hilfmonom),VECTOR);*/
394           erg+=mult_disjunkt_polynom_polynom(hilfmonom,monom3,monom4);
395           /*if (S_O_K(S_PO_S(monom4))==INTEGERVECTOR) C_O_K(S_PO_S(monom4),VECTOR);*/
396           erg+=add(b,monom4,b);
397           monom1=S_PO_N(monom1);
398     }
399     erg+=freeall(hilfk); erg+=freeall(hilfmonom); erg+=freeall(monom3);
400     erg+=freeall(monom4); erg+=freeall(vekt);
401     m_v_po_mz(c,b,bb);
402     erg+=freeall(b); erg+=freeall(c);
403     if (erg != OK) error(" in computation of zykelind_on_pairs_disjunkt(a,b) ");
404     return(erg);
405 }
406 
zykeltyp_on_2sets(a,b)407 static INT zykeltyp_on_2sets(a,b) OP a,b;
408 /* Berechnet den Zykeltyp einer Gruppenaktion, auf der Menge aller
409    2 elementigen Teilmengen {i,j}.
410    a ist ein Monom (der Zykeltyp der Permutation auf der Menge der
411    Punkte i,j,...)
412    b ist ein Monom (der Zykeltyp der durch obige Permutation
413    mit Zykeltyp a auf der Menge der 2-elementigen Mengen
414    induziert wird.) */
415 {
416     INT i1,i2,ex1,ex2;
417     OP hilfmonom,hilf,hilf1;
418     INT erg=OK;
419     if (S_O_K(a)!=POLYNOM) return error("zykeltyp_on_2sets(a,b) a not POLYNOM");
420     if (not EMPTYP(b)) erg+=freeself(b);
421     hilf=callocobject();
422     hilf1=callocobject();
423     hilfmonom=callocobject();
424     erg+=m_scalar_polynom(S_PO_K(a),b);
425     for (i1=0L; i1<S_V_LI(S_PO_S(a))-1L ; ++i1)
426     {
427       ex1=S_V_II(S_PO_S(a),i1);
428       if (ex1 != 0L)
429       {
430         for (i2=i1+1L; i2<S_V_LI(S_PO_S(a)); ++i2)
431         {
432           ex2=S_V_II(S_PO_S(a),i2);
433           if (ex2 != 0L)
434           {
435         erg+=m_iindex_iexponent_monom(((i1+1L)*(i2+1L)/ggt_i(i1+1L,i2+1L))-1L,ex1*ex2*ggt_i(i1+1L,i2+1L),hilfmonom);
436         erg+=mult_apply(hilfmonom,b);
437           }
438         }
439         if (ex1>=2L)
440         {
441           M_I_I(ex1,hilf);
442           erg+=binom(hilf,cons_zwei,hilf1);
443           erg+=m_iindex_iexponent_monom(i1,(i1+1L),hilfmonom);
444           erg+=hoch(hilfmonom,hilf1,hilfmonom);
445           erg+=mult_apply(hilfmonom,b);
446         }
447         if (i1 % 2L == 0L)
448         erg+=m_iindex_iexponent_monom(i1,ex1*i1/2L,hilfmonom);
449         else
450         {
451           erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)/2L-1L),hilfmonom);
452           erg+=m_iindex_iexponent_monom((i1+1L)/2L-1L,ex1,hilf1);
453           erg+=mult_apply(hilf1,hilfmonom);
454         }
455         erg+=mult_apply(hilfmonom,b);
456       }
457     }
458     i1=S_V_LI(S_PO_S(a))-1L;
459     ex1=S_V_II(S_PO_S(a),i1);
460     if (ex1 != 0L)
461     {
462       if (ex1>=2L)
463       {
464         M_I_I(ex1,hilf);
465         erg+=binom(hilf,cons_zwei,hilf1);
466         erg+=m_iindex_iexponent_monom(i1,(i1+1L),hilfmonom);
467         erg+=hoch(hilfmonom,hilf1,hilfmonom);
468         erg+=mult_apply(hilfmonom,b);
469       }
470       if (i1 % 2L == 0L)
471       erg+=m_iindex_iexponent_monom(i1,ex1*i1/2L,hilfmonom);
472       else
473       {
474         erg+=m_iindex_iexponent_monom(i1,ex1*((i1+1L)/2L-1L),hilfmonom);
475         erg+=m_iindex_iexponent_monom((i1+1L)/2L-1L,ex1,hilf1);
476         erg+=mult_apply(hilf1,hilfmonom);
477       }
478       erg+=mult_apply(hilfmonom,b);
479     }
480     erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(hilfmonom);
481     if (erg != OK) error(" in computation of zykeltyp_on_2sets(a,b) ");
482     return(erg);
483 }
484 
zykelind_on_2sets(a,b)485 INT zykelind_on_2sets(a,b)  OP a,b;
486 /* Berechnet aus dem Zykelindex a den Zykelindex b
487    der auf der Menge aller 2-elementigen Teilmengen
488    induzierten Gruppenaktion, die durch die
489    zu a gehoerende Gruppenaktion definiert wird. */
490 {
491     OP hilfk,monom1,monom3;
492     INT erg=OK;
493     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_2sets(a,b) a not POLYNOM");
494     if (not EMPTYP(b)) erg+=freeself(b);
495     hilfk=callocobject();
496     monom3=callocobject();
497     M_I_I(0L,hilfk);
498     erg+=m_scalar_polynom(hilfk,b);
499     monom1=a;
500     while (monom1!=NULL)
501     {
502         erg+=zykeltyp_on_2sets(monom1,monom3);
503         erg+=add_apply(monom3,b);
504         monom1=S_PO_N(monom1);
505     }
506     erg+=freeall(hilfk); erg+=freeall(monom3);
507     if (erg != OK) error(" in computation of zykelind_on_2sets(a,b) ");
508     return(erg);
509 }
510 
zykelind_superp_lin_dir_graphs(a,bb)511 INT zykelind_superp_lin_dir_graphs(a,bb) OP a,bb;
512 /* Berechnet den Zyklenzeiger der Gruppenaktion von S_n auf der Menge
513    aller Paare (i,j) mit i ungleich j (Kanten eines gerichteten
514    Graphen) und auf der Menge aller 2-elementigen Teilmengen von
515    {1,2,...,n} (Kanten eines linearen Graphen).
516    Die entsprechenden Zykelverzeichnisse werden dabei
517    mit verschiedenen Familien von Unbestimmten versehen.
518    a ist ein Integer Objekt, das den Wert von n (Anzahl der Knoten
519    der Graphen) angibt. bb ist der errechnete Zyklenzeiger, also
520    ein 2-dimensionaler Zykelindex. c=s_mz_v(bb) ist ein Vektor Objekt.
521    Die (zwei) Eintragungen
522    von c definieren die Stellen in dem Polynomobjekt an denen eine
523    neue Familie von Unbestimmten beginnt. (Somit ist der erste Wert
524    von c gleich 0. Den zweiten Wert kann man in diesem Fall stets
525    gleich (a ueber 2) setzen.)  */
526 {
527     OP b,c,d,cc,hilfmonom,monom1,monom2,monom3,monom4,vekt;
528     INT i1,i2,ex1,ex2;
529     INT erg=OK;
530     if (S_O_K(a)!=INTEGER) return error("zykelind_superp_lin_dir_graphs(a,b) a not INTEGER");
531     if (not EMPTYP(bb)) erg+=freeself(bb);
532     d=callocobject();
533     cc=callocobject();
534     b=callocobject();
535     c=callocobject();
536     hilfmonom=callocobject();
537     monom2=callocobject();
538     monom3=callocobject();
539     monom4=callocobject();
540     vekt=callocobject();
541     erg+=zykelind_Sn(a,d);
542     erg+=m_scalar_polynom(cons_null,b);
543     erg+=m_il_v(2L,c);
544     M_I_I(0L,S_V_I(c,0L));
545     erg+=binom(a,cons_zwei,cc);
546     erg+=copy(cc,S_V_I(c,1L));
547     monom1=d;
548     while (monom1!=NULL)
549     {
550       erg+=zykeltyp_on_pairs_reduced(monom1,monom3);
551       erg+=zykeltyp_on_2sets(monom1,monom2);
552       erg+=copy(S_PO_S(monom2),vekt);
553       while (S_V_LI(vekt)<S_I_I(cc))
554       {
555          erg+=inc(vekt);
556          M_I_I(0L,S_V_I(vekt,S_V_LI(vekt)-1L));
557       }
558       erg+=m_skn_po(vekt,cons_eins,NULL,hilfmonom);
559       erg+=mult_disjunkt_polynom_polynom(hilfmonom,monom3,monom4);
560       erg+=add_apply(monom4,b);
561       monom1=S_PO_N(monom1);
562     }
563     erg+=freeall(hilfmonom); erg+=freeall(monom2); erg+=freeall(monom3);
564     erg+=freeall(monom4); erg+=freeall(vekt); erg+=freeall(d);
565     erg+=freeall(cc);
566     m_v_po_mz(c,b,bb);
567     erg+=freeall(b); erg+=freeall(c);
568     if (erg != OK) error(" in computation of zykelind_superp_lin_dir_graphs(a,b) ");
569     return(erg);
570 }
571 
zykelind_on_pairs_oriented(a,b)572 INT zykelind_on_pairs_oriented(a,b)  OP a,b;
573 /* Berechnet aus dem Zykelindex a den Zykelindex b
574    der auf der Menge der geordneten Paare (i,j) mit i
575    ungleich j induzierten Gruppenaktion, die durch die
576    zu a gehoerende Gruppenaktion definiert wird.
577    Falls das Paar (i,j) auftritt, darf das Paar (j,i)
578    jedoch nicht vorkommen. */
579 {
580     OP hilfk,monom1,monom3;
581     INT i1;
582     INT erg=OK;
583     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_pairs_oriented(a,b) a not POLYNOM");
584     if (not EMPTYP(b)) erg+=freeself(b);
585     hilfk=callocobject();
586     monom3=callocobject();
587     M_I_I(0L,hilfk);
588     erg+=m_scalar_polynom(hilfk,b);
589     monom1=a;
590     while (monom1!=NULL)
591     {
592       erg+=zykeltyp_on_2sets(monom1,monom3);
593       for (i1=0L;(2L*i1+1L<S_V_LI(S_PO_S(monom1))) && (i1<S_V_LI(S_PO_S(monom3)));++i1)
594       C_I_I(S_V_I(S_PO_S(monom3),i1),S_V_II(S_PO_S(monom3),i1)-S_V_II(S_PO_S(monom1),2L*i1+1L));
595           erg+=add_apply(monom3,b);
596       monom1=S_PO_N(monom1);
597     }
598     erg+=freeall(hilfk);
599     erg+=freeall(monom3);
600     if (erg != OK) error(" in computation of zykelind_on_pairs_oriented(a,b) ");
601     return(erg);
602 }
603 
zykelind_on_power_set(a,b)604 INT zykelind_on_power_set(a,b) OP a,b;
605 /* Berechnet den Zykelindex der auf der Potenzmenge induzierten
606    Gruppenaktion. a ist der Zykelindex der urspruenglichen
607    Gruppenaktion. b ist der induzierte Zykelindex. */
608 {
609     OP hilfk,hilf1,monom1,monom2,monom3,teiler,hilf,zwei,verz;
610     INT i,j,n;
611     INT erg=OK;
612     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_power_set(a,b) a not POLYNOM");
613     if (not EMPTYP(b)) erg+=freeself(b);
614     hilfk=callocobject();
615     teiler=callocobject();
616     verz=callocobject();
617     zwei=callocobject();
618     hilf1=callocobject();
619     hilf=callocobject();
620     monom2=callocobject();
621     monom3=callocobject();
622     M_I_I(0L,hilfk);
623     erg+=m_scalar_polynom(hilfk,b);
624     erg+=numberofvariables(a,hilfk);
625     erg+=m_l_v(hilfk,zwei);
626     for (i=0L;i<S_V_LI(zwei);++i) M_I_I(2L,S_V_I(zwei,i));
627     monom1=a;
628     while (monom1!=NULL)
629     {
630       erg+=m_scalar_polynom(S_PO_K(monom1),monom3);
631       erg+=ordnung(monom1,hilfk);
632       erg+=alle_teiler(hilfk,teiler);
633       erg+=m_il_v(S_V_LI(teiler),verz);
634       /* verz enthaelt gewisse Informationen ueber jeden
635       Teiler der in teiler aufgelistet ist. */
636       for (i=0L;i<S_V_LI(teiler);++i)
637       {
638         erg+=zykeltyp_pi_hoch(S_PO_S(monom1),S_V_I(teiler,i),monom2);
639         erg+=eval_polynom(monom2,zwei,hilf1);
640         erg+=copy(hilf1,S_V_I(verz,i));
641       }
642       for (i=0L;i<S_V_LI(teiler);++i)
643       {
644         M_I_I(0L,hilfk);
645         for (j=0L;j<=i;++j)
646         {
647           erg+=quores(S_V_I(teiler,i),S_V_I(teiler,j),hilf,hilf1);
648           if (nullp(hilf1))
649           {
650         M_I_I(mu(hilf),hilf1);
651         erg+=mult(hilf1,S_V_I(verz,j),hilf1);
652         erg+=add(hilfk,hilf1,hilfk);
653           }
654         }
655         erg+=ganzdiv(hilfk,S_V_I(teiler,i),hilfk);
656         erg+=m_iindex_iexponent_monom(s_v_ii(teiler,i)-1L,s_i_i(hilfk),monom2); /* HF 130696 */
657         erg+=mult(monom2,monom3,monom3);
658       }
659       erg+=add(b,monom3,b);
660       monom1=S_PO_N(monom1);
661     }
662     erg+=freeall(hilfk);
663     erg+=freeall(hilf);
664     erg+=freeall(hilf1);
665     erg+=freeall(zwei);
666     erg+=freeall(verz);
667     erg+=freeall(teiler);
668     erg+=freeall(monom2);
669     erg+=freeall(monom3);
670     if (erg != OK) error(" in computation of zykelind_on_power_set(a,b) ");
671     return(erg);
672 }
673 
zykeltyp_on_ksubsets(a,c,b)674 static INT zykeltyp_on_ksubsets(a,c,b)
675 /* a ist der Zykeltyp einer Permutation. (ein Polynom Opbjekt)
676 c ist ein Integer Objekt, das den Wert von k enthaelt.
677 b ist der Zykeltyp einer Permutation auf k-elementigen Mengen, die
678 durch Permutationen vom Typ a induziert wird. */
679     OP a,b,c;
680 {
681     OP hilfk,hilf,hilf1,teiler,verz,varanz,monom2;
682     INT i,j;
683     INT erg=OK;
684     if (S_O_K(a)!=POLYNOM) return error("zykeltyp_on_ksubsets(a,c,b) a not POLYNOM");
685     if (S_O_K(c)!=INTEGER) return error("zykeltyp_on_ksubsets(a,c,b) c not INTEGER");
686     if (S_I_I(c)<0L) return error("zykeltyp_on_ksubsets(a,c,b) c<0");
687     if (not EMPTYP(b)) erg+=freeself(b);
688     hilfk=callocobject();
689     teiler=callocobject();
690     verz=callocobject();
691     varanz=callocobject();
692     hilf1=callocobject();
693     hilf=callocobject();
694     monom2=callocobject();
695     erg+=m_scalar_polynom(S_PO_K(a),b);
696     erg+=ordnung(a,hilfk);
697     erg+=alle_teiler(hilfk,teiler);
698     erg+=m_il_v(S_V_LI(teiler),verz);
699     /* verz enthaelt gewisse Informationen ueber jeden
700        Teiler der in teiler aufgelistet ist. */
701     for (i=0L;i<S_V_LI(teiler);++i)
702     {
703       erg+=zykeltyp_pi_hoch(S_PO_S(a),S_V_I(teiler,i),monom2);
704       erg+=numberofvariables(monom2,varanz);
705       erg+=polya_sub(monom2,varanz,hilf1);
706       erg+=coeff_of_in(c,hilf1,hilf);
707       erg+=copy(hilf,S_V_I(verz,i));
708     }
709     for (i=0L;i<S_V_LI(teiler);++i)
710     {
711       erg+=m_i_i(0L,hilfk);
712       for (j=0L;j<=i;++j)
713       {
714         erg+=quores(S_V_I(teiler,i),S_V_I(teiler,j),hilf,hilf1);
715         if (nullp(hilf1))
716         {
717           erg+=m_i_i(mu(hilf),hilf1);
718           erg+=mult_apply(S_V_I(verz,j),hilf1);
719           erg+=add_apply(hilf1,hilfk);
720         }
721       }
722       erg+=ganzdiv(hilfk,S_V_I(teiler,i),hilfk);
723       erg+=m_iindex_iexponent_monom(s_v_ii(teiler,i)-1L,cons_eins,monom2); /*HF 130696 */
724       copy(hilfk,S_PO_SI(monom2,S_V_II(teiler,i)-1L));
725       erg+=mult_apply(monom2,b);
726     }
727     erg+=freeall(hilfk);
728     erg+=freeall(hilf);
729     erg+=freeall(hilf1);
730     erg+=freeall(varanz);
731     erg+=freeall(verz);
732     erg+=freeall(teiler);
733     erg+=freeall(monom2);
734     if (erg != OK) error(" in computation of zykeltyp_on_ksubsets(a,c,b) ");
735     return(erg);
736 }
737 
zykelind_on_ksubsets(a,c,b)738 INT zykelind_on_ksubsets(a,c,b) OP a,b,c;
739 /* a ist ein Zykelindex. Die dazu gehoerende Gruppenaktion induziert
740    eine Gruppenaktion auf der Menge aller k-elementigen Teilmengen.
741    Der Parameter k wird im Integer Objekt c uebergeben. b ist der
742    induzierte Zykelindex. */
743 {
744     OP hilfk,monom1,monom3;
745     INT erg=OK;
746     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_ksubsets(a,c,b) a not POLYNOM");
747     if (S_O_K(c)!=INTEGER) return error("zykelind_on_ksubsets(a,c,b) c not INTEGER");
748     if (S_I_I(c)<0L) return error("zykelind_on_ksubsets(a,c,b) c<0");
749     if (not EMPTYP(b)) erg+=freeself(b);
750     monom3=callocobject();
751     erg+=m_scalar_polynom(cons_null,b);
752     monom1=a;
753     while (monom1!=NULL)
754       {
755         erg+=zykeltyp_on_ksubsets(monom1,c,monom3);
756         erg+=add_apply(monom3,b);
757         monom1=S_PO_N(monom1);
758     }
759     erg+=freeall(monom3);
760     if (erg != OK) error(" in computation of zykelind_on_ksubsets(a,c,b) ");
761     return(erg);
762 }
763 
zykeltyp_on_ktuples(a,c,b)764 static INT zykeltyp_on_ktuples(a,c,b) OP a,b,c;
765 {
766     OP hilfk,hilfmonom,vekt,exponenten,hilf,hilf1,hilf2;
767     INT i1,i2;
768     INT erg=OK;
769     if (S_O_K(a)!=POLYNOM) return error("zykeltyp_on_ktuples(a,c,b) a not POLYNOM");
770     if (S_O_K(c)!=INTEGER) return error("zykeltyp_on_ktuples(a,c,b) c not INTEGER");
771     if (S_I_I(c)<0L) return error("zykeltyp_on_ktuples(a,c,b) c<0");
772     if (not EMPTYP(b)) erg+=freeself(b);
773     hilfk=callocobject();
774     hilf=callocobject();
775     hilf1=callocobject();
776     hilf2=callocobject();
777     vekt=callocobject();
778     exponenten=callocobject();
779     hilfmonom=callocobject();
780     erg+=m_l_v(c,exponenten);
781         erg+=m_scalar_polynom(S_PO_K(a),b);
782         erg+=copy(S_V_L(S_PO_S(a)),hilfk);
783         while(nullp(S_V_I(S_PO_S(a),S_I_I(hilfk)-1L)))
784          erg+=dec(hilfk);
785         erg+=dec(hilfk);
786         erg+=erster_kandidat(S_I_I(c),vekt);
787         do
788         {
789           for (i1=0L;i1<S_V_LI(vekt);++i1)
790           {
791         if (!nullp(S_V_I(S_PO_S(a),S_V_II(vekt,i1))))
792         erg+=copy(S_V_I(S_PO_S(a),S_V_II(vekt,i1)),S_V_I(exponenten,i1));
793         else
794         {
795           for (i2=i1+1L;i2<S_V_LI(vekt);++i2)
796              erg+=copy(hilfk,S_V_I(vekt,i2));
797           goto label;
798         }
799           }
800           erg+=vektor_prod(exponenten,hilf);
801           erg+=vektor_kgv_prod_durch_kgv(vekt,hilf1,hilf2);
802           erg+=m_iindex_iexponent_monom(s_i_i(hilf1)-1L,1L,hilfmonom);
803           erg+=mult(hilf,hilf2,S_PO_SI(hilfmonom,s_i_i(hilf1)-1L));
804           erg+=mult_apply(hilfmonom,b);
805           label: i1=next_kandidat(S_I_I(hilfk),vekt);
806         } while(i1==1L);
807     /*if (S_O_K(S_PO_S(b))==INTEGERVECTOR) C_O_K(S_PO_S(b),VECTOR);*/
808     erg+=freeall(hilfk);
809     erg+=freeall(hilf);
810     erg+=freeall(hilf1);
811     erg+=freeall(hilf2);
812     erg+=freeall(vekt);
813     erg+=freeall(exponenten);
814     erg+=freeall(hilfmonom);
815     if (erg != OK) error(" in computation of zykeltyp_on_ktuples(a,c,b) ");
816     return(erg);
817 }
818 
zykelind_on_ktuples(a,c,b)819 INT zykelind_on_ktuples(a,c,b)
820 /* Berechnet aus dem Zykelindex a den Zykelindex b
821    der auf der Menge aller c-Tupel induzierten Gruppenaktion,
822    die durch die zu a gehoerende Gruppenaktion definiert wird. */
823     OP a,b,c;
824 {
825     OP monom1,monom3;
826     INT erg=OK;
827     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_ktuples(a,c,b) a not POLYNOM");
828     if (S_O_K(c)!=INTEGER) return error("zykelind_on_ktuples(a,c,b) c not INTEGER");
829     if (S_I_I(c)<0L) return error("zykelind_on_ktuples(a,c,b) c<0");
830     if (not EMPTYP(b)) erg+=freeself(b);
831     if (einsp(c)) return(copy(a,b));
832     monom3=callocobject();
833     erg+=m_scalar_polynom(cons_null,b);
834     monom1=a;
835     while (monom1!=NULL)
836     {
837         erg+=zykeltyp_on_ktuples(monom1,c,monom3);
838         /*if (S_O_K(S_PO_S(monom3))==INTEGERVECTOR) C_O_K(S_PO_S(monom3),VECTOR);*/
839         erg+=add(b,monom3,b);
840       monom1=S_PO_N(monom1);
841     }
842     erg+=freeall(monom3);
843     if (erg != OK) error(" in computation of zykelind_on_ktuples(a,c,b) ");
844     return(erg);
845 }
846 
zykelind_on_ktuples_injective(a,c,b)847 INT zykelind_on_ktuples_injective(a,c,b) OP a,b,c;
848 {
849     OP monom1,monom2,monom3,monom4,hilfk,stirling,koeff;
850     INT i;
851     INT erg=OK;
852     if (S_O_K(a)!=POLYNOM) return error("zykelind_on_ktuples_injective(a,c,b) a not POLYNOM");
853     if (S_O_K(c)!=INTEGER) return error("zykelind_on_ktuples_injective(a,c,b) c not INTEGER");
854     if (S_I_I(c)<0L) return error("zykelind_on_ktuples_injective(a,c,b) c<0");
855     if (not EMPTYP(b)) erg+=freeself(b);
856     hilfk=callocobject();
857     koeff=callocobject();
858     monom2=callocobject();
859     monom3=callocobject();
860     monom4=callocobject();
861     stirling=callocobject();
862     erg+=stirling_first_tafel(c,stirling);
863     M_I_I(0L,hilfk);
864     erg+=m_scalar_polynom(hilfk,b);
865     monom1=a;
866     while (monom1!=NULL)
867       {
868         erg+=m_skn_po(S_PO_S(monom1),S_PO_K(monom1),NULL,monom2);
869         erg+=vektor_mult_apply(S_PO_S(monom2),S_M_IJ(stirling,S_I_I(c),1L));
870         for (i=2L;i<=S_I_I(c);++i)
871         {
872           M_I_I(i,hilfk);
873           erg+=zykeltyp_on_ktuples(monom1,hilfk,monom3);
874           erg+=vektor_mult_apply(S_PO_S(monom3),S_M_IJ(stirling,S_I_I(c),i));
875           erg+=add_apply_vector(S_PO_S(monom3),S_PO_S(monom2));
876         }
877         /*if (S_O_K(S_PO_S(monom2))==INTEGERVECTOR) C_O_K(S_PO_S(monom2),VECTOR);*/
878         erg+=add(b,monom2,b);
879         monom1=S_PO_N(monom1);
880     }
881     erg+=freeall(stirling);
882     erg+=freeall(hilfk);
883     erg+=freeall(koeff);
884     erg+=freeall(monom2);
885     erg+=freeall(monom3);
886     erg+=freeall(monom4);
887     if (erg != OK) error(" in computation of zykelind_on_ktuples_injective(a,c,b) ");
888     return(erg);
889 }
890 
zykelind_test()891 INT zykelind_test()
892 /* Test fuer die in diesem File auftretenden Prozeduren. */
893 {
894     OP a,b,c,d,e;
895     INT erg=OK;
896     a=callocobject();
897     b=callocobject();
898     c=callocobject();
899     d=callocobject();
900     e=callocobject();
901     printeingabe("Geben Sie eine Integer Zahl n an (etwa 1<=n<=5).");
902     printeingabe("Aus dem Zyklenzeiger von S_n werden weitere Zyklenzeiger bestimmt.");
903     scan(INTEGER,a);
904     erg+=zykelind_Sn(a,b);
905     printf("Zyklenzeiger von S_n\n");
906     erg+=println(b);
907     erg+=zykelind_on_2sets(b,c);
908     printf("Zyklenzeiger auf 2-Mengen\n");
909     erg+=println(c);
910     erg+=zykelind_on_pairs(b,d);
911     printf("Zyklenzeiger auf Paaren\n");
912     erg+=println(d);
913     erg+=zykelind_dir_prod(c,d,e);
914     printf("Direktes Produkt dieser 2 Zyklenzeiger\n");
915     erg+=println(e);
916     erg+=zykelind_dir_summ(c,d,e);
917     printf("Direkte Summe dieser 2 Zyklenzeiger\n");
918     erg+=println(e);
919     zykelind_Cn(a,d);
920     erg+=zykelind_kranz(b,d,e);
921     printf("Kranzprodukt von S_n mit C_n\n");
922     erg+=println(e);
923     erg+=zykelind_on_power_set(b,c);
924     printf("Zyklenzeiger auf der Potenzmenge\n");
925     erg+=println(c);
926     printeingabe("Geben Sie eine weitere Integer Zahl k an. ");
927     printeingabe("Es werden nun Zyklenzeiger von k-Tupeln und k-Mengen bestimmt.");
928     scan(INTEGER,c);
929     erg+=zykelind_on_ktuples(b,c,d);
930     printf("Zyklenzeiger auf k-Tupeln\n");
931     erg+=println(d);
932     erg+=zykelind_on_ktuples_injective(b,c,d);
933     printf("Zyklenzeiger auf injektiven k-Tupeln\n");
934     erg+=println(d);
935     erg+=zykelind_on_ksubsets(b,c,d);
936     printf("Zyklenzeiger auf k-Mengen\n");
937     erg+=println(d);
938     erg+=zykelind_hoch_dir_summ(b,c,d);
939     printf("Zyklenzeiger direkte Summe hoch k\n");
940     erg+=println(d);
941     erg+=zykelind_hoch_dir_prod(b,c,d);
942     printf("Zyklenzeiger direktes Produkt hoch k\n");
943     erg+=println(d);
944     erg+=zykelind_on_pairs_reduced(b,c);
945     printf("Zyklenzeiger auf injektiven Paaren\n");
946     erg+=println(c);
947     erg+=zykelind_on_pairs_oriented(b,c);
948     printf("Zyklenzeiger auf orientierten Paaren\n");
949     erg+=println(c);
950     printf("Spezielle Form der Polyasubstitution\n");
951     erg+=numberofvariables(c,d);
952     erg+=polya1_sub(c,d,e);
953     erg+=println(e);
954     erg+=zykelind_on_pairs_disjunkt(b,c);
955     printf("Zyklenzeiger auf Paaren mit getrennten Familien von Unbestimmten\n");
956     erg+=println(s_mz_po(c));
957     printf("Die Familien beginnen bei den Indizes:\n");
958     erg+=println(s_mz_v(c));
959     erg+=zykelind_superp_lin_dir_graphs(a,c);
960     printf("Zyklenzeiger fuer Superpositionen von einem linearen\n");
961     printf("und einem gerichteten Graphen\n");
962     erg+=println(s_mz_po(c));
963     printf("Die Familien beginnen bei den Indizes:\n");
964     erg+=println(s_mz_v(c));
965     erg+=zykelind_inc(b);
966     printf("Einbettung in S_{n+1}\n");
967     erg+=println(b);
968     M_I_I(2L,a);
969     erg+=zykelind_Sn(a,b);
970     printf("Zyklenzeiger der S2\n");
971     erg+=println(b);
972     M_I_I(4L,a);
973     erg+=zykelind_Sn(a,c);
974     printf("Zyklenzeiger der S4\n");
975     erg+=println(c);
976     erg+=zykelind_dir_summ(b,c,d);
977     printf("Zyklenzeiger von S2 x S4\n");
978     erg+=println(d);
979     erg+=m_il_v(2L,e);
980     erg+=copy(d,s_v_i(e,1L));
981     M_I_I(6L,a);
982     erg+=zykelind_Dn(a,b);
983     printf("Zyklenzeiger der D6\n");
984     erg+=println(b);
985     erg+=numberofvariables(b,a);
986     polya_sub(b,a,c);
987     printf("Polya-Substitution\n");
988     println(c);
989     erg+=copy(b,s_v_i(e,0L));
990     erg+=redf_cup(e,d);
991     printf("Redfield Cup\n");
992     erg+=println(d);
993     erg+=redf_cap(e,d);
994     printf("Redfield Cap\n");
995     erg+=println(d);
996     printf("Dies ist der Koeffizient von x^2 bei obiger Polya-Substitution\n");
997     erg+=zykelind_tetraeder(c);
998     printf("Zyklenzeiger der Drehgruppe des Tetraeders\n");
999     erg+=println(c);
1000     erg+=zykelind_tetraeder_extended(c);
1001     printf("Zyklenzeiger der Symmetriegruppe des Tetraeders\n");
1002     erg+=println(c);
1003     erg+=zykelind_cube(a);
1004     erg+=polya_multi_sub(a,c);
1005     printf("Moegliche Faerbungen der Ecken, Kanten und Flaechen eines Wuerfels\n");
1006     printf("mit jeweils 2 Farben bezueglich der Drehsymmetrie des Wuerfels.\n");
1007     erg+=println(c);
1008     erg+=m_il_v(3L,c);
1009     M_I_I(8L,s_v_i(c,0L));
1010     M_I_I(12L,s_v_i(c,1L));
1011     M_I_I(6L,s_v_i(c,2L));
1012     erg+=polya_multi_const_sub(a,c,d);
1013     printf("Anzahl der moeglichen Faerbungen der Ecken, Kanten und Flaechen eines\n ");
1014     printf("Wuerfels mit 8, 12, bzw. 6 Farben bezueglich der Drehsymmetrie \n");
1015     printf("des Wuerfels.\n");
1016     erg+=println(d);
1017     erg+=zykelind_cube_extended(c);
1018     printf("Zyklenzeiger der Symmetriegruppe des Wuerfels\n");
1019     erg+=println(c);
1020     erg+=zykelind_dodecahedron_extended(c);
1021     printf("Zyklenzeiger der Symmetriegruppe des Dodecaeders\n");
1022     erg+=println(c);
1023     erg+=zykelind_tetraeder_vertices(c);
1024     printf("Zyklenzeiger der Drehgruppe des Tetraeders auf den Ecken\n");
1025     erg+=println(c);
1026     erg+=zykelind_tetraeder_edges(c);
1027     printf("Zyklenzeiger der Drehgruppe des Tetraeders auf den Kanten\n");
1028     erg+=println(c);
1029     erg+=zykelind_tetraeder_faces(c);
1030     printf("Zyklenzeiger der Drehgruppe des Tetraeders auf den Flaechen\n");
1031     erg+=println(c);
1032     erg+=zykelind_tetraeder_vertices_extended(c);
1033     printf("Zyklenzeiger der Symmetriegruppe des Tetraeders auf den Ecken\n");
1034     erg+=println(c);
1035     erg+=zykelind_tetraeder_edges_extended(c);
1036     printf("Zyklenzeiger der Symmetriegruppe des Tetraeders auf den Kanten\n");
1037     erg+=println(c);
1038     erg+=zykelind_tetraeder_faces_extended(c);
1039     printf("Zyklenzeiger der Symmetriegruppe des Tetraeders auf den Flaechen\n");
1040     erg+=println(c);
1041     M_I_I(4L,b);
1042     erg+=polya_const_sub(c,b,d);
1043     printf("Anzahl der verschiedenen Faerbungen der Flaechen eines Tetraeders\n");
1044     printf("mit 4 Farben bezueglich der gesamten Symmetriegruppe des Tetraeders.\n");
1045     erg+=println(d);
1046     erg+=zykelind_test1();
1047     erg+=freeall(a);
1048     erg+=freeall(b);
1049     erg+=freeall(c);
1050     erg+=freeall(d);
1051     erg+=freeall(e);
1052     if (erg != OK) error(" in computation of zykelind_test() ");
1053     return(erg);
1054 }
1055 
zykelind_inc(a)1056 INT zykelind_inc(a) OP a;
1057 /* Natuerliche Einbettung von einer Gruppenaktion von einer Untergruppe
1058    von S_n in S_{n+1}.  */
1059 {
1060     OP hilfmonom;
1061     INT erg=OK;
1062     if (S_O_K(a)!=POLYNOM) return error("zykelind_inc(a) a not POLYNOM");
1063     hilfmonom=callocobject();
1064     erg+=m_iindex_iexponent_monom(0L,1L,hilfmonom);
1065     erg+=mult(a,hilfmonom,a);
1066     erg+=freeall(hilfmonom);
1067     ENDR("zykelind_inc");
1068 }
1069 
zykelind_dec(a,b)1070 INT zykelind_dec(a,b) OP a,b;
1071 {
1072     OP hilfm,hilf,hilf1;
1073     INT erg=OK;
1074     hilf=callocobject();
1075     hilf1=callocobject();
1076     M_I_I(0L,hilf);
1077     erg+=m_scalar_polynom(hilf,b);
1078     hilfm=a;
1079     while (hilfm!=NULL)
1080     {
1081       /*if (S_O_K(S_PO_S(hilfm))==INTEGERVECTOR) C_O_K(S_PO_S(hilfm),VECTOR);*/
1082       erg+=copy(S_PO_S(hilfm),hilf);
1083       erg+=dec(S_V_I(hilf,0L));
1084       erg+=m_skn_po(hilf,S_PO_K(hilfm),NULL,hilf1);
1085       erg+=add_apply(hilf1,b);
1086       hilfm=S_PO_N(hilfm);
1087     }
1088     erg+=freeall(hilf1);
1089     erg+=freeall(hilf);
1090     if (erg!=OK) error("in computation of zykelind_dec(a,b) ");
1091     return(erg);
1092 }
1093 
zykelind_dec_apply(a)1094 INT zykelind_dec_apply(a) OP a;
1095 {
1096     OP hilf;
1097     INT erg=OK;
1098     hilf=callocobject();
1099     erg+=zykelind_dec(a,hilf);
1100     erg+=copy(hilf,a);
1101     erg+=freeall(hilf);
1102     if (erg!=OK) error("in computation of zykelind_dec_apply(a) ");
1103     return(erg);
1104 }
1105 
1106 /* ***************************************************************
1107 
1108 Computation of the cycle index of the composition and plethysm
1109 of two permutation groups.
1110 
1111 ****************************************************************** */
1112 
zykelind_index_verschieben(a,b,c)1113 static INT zykelind_index_verschieben(a,b,c) OP a,b,c;
1114 /* a ist urspruenglicher Zykelindex;
1115    c ist der neue Zykelindex: es wird dabei x_i aus a ersetzt
1116    durch x_{bi}. b ist ein integer Objekt.  */
1117 {
1118     OP hilfk,hilfmonom,monom1,monom3;
1119     INT i1,ib,ex1;
1120     INT erg=OK;
1121     if (S_O_K(a)!=POLYNOM) return error("zykelind_index_verschieben(a,b,c) a not POLYNOM");
1122     if (S_O_K(b)!=INTEGER) return error("zykelind_index_verschieben(a,b,c) b not INTEGER");
1123     if (not EMPTYP(c)) erg+=freeself(c);
1124     hilfk=callocobject();
1125     hilfmonom=callocobject();
1126     monom3=callocobject();
1127     M_I_I(0L,hilfk);
1128     erg+=m_scalar_polynom(hilfk,c);
1129     ib=S_I_I(b);
1130     monom1=a;
1131     while (monom1!=NULL)
1132     {
1133       erg+=m_scalar_polynom(S_PO_K(monom1),monom3);
1134       for (i1=0L; i1<S_V_LI(S_PO_S(monom1)) ; ++i1)
1135       {
1136         ex1=S_V_II(S_PO_S(monom1),i1);
1137         if (ex1 != 0L)
1138         {
1139           erg+=m_iindex_iexponent_monom((i1+1L)*ib-1L,ex1,hilfmonom);
1140           erg+=mult_apply(hilfmonom,monom3);
1141         }
1142       }
1143       erg+=add_apply(monom3,c);
1144       monom1=S_PO_N(monom1);
1145     }
1146     erg+=freeall(hilfk);
1147     erg+=freeall(hilfmonom);
1148     erg+=freeall(monom3);
1149     if (erg != OK) error(" in computation of zykelind_index_verschieben(a,b,c) ");
1150     return(erg);
1151 }
1152 
zykelind_kranz(a,b,c)1153 INT zykelind_kranz(a,b,c) OP a,b,c;
1154 /* Berechnet den Zyklenzeiger der Gruppenaktion des Kranzproduktes
1155    zweier Gruppen. a ist der erste Zyklenzeiger. In diesem ersetzt
1156    man x_i durch den Zyklenzeiger der zweiten Gruppenaktion, dessen
1157    Unbestimmte y_j durch y_{ij} zu ersetzen sind. Das Ergebnis dieser
1158    Substitutionen ist der neue Zyklenzeiger c. */
1159 /* HF */
1160 /* AK 251198 V2.0 */
1161 {
1162     OP varanz,substitut,hilf,hilfpoly;
1163     INT i;
1164     INT erg=OK;
1165     CTO(POLYNOM,"zykelind_kranz",a);
1166     CTO(POLYNOM,"zykelind_kranz",b);
1167 
1168 
1169 
1170     varanz=callocobject();
1171     substitut=callocobject();
1172     hilf=callocobject();
1173     hilfpoly=callocobject();
1174     numberofvariables(a,varanz);
1175     erg+=m_l_v(varanz,substitut);
1176     for (i=0L;i<S_I_I(varanz);++i)
1177     {
1178       M_I_I(i+1L,hilf);
1179       erg+=zykelind_index_verschieben(b,hilf,hilfpoly);
1180       erg+=copy(hilfpoly,S_V_I(substitut,i));
1181     }
1182     erg+=eval_polynom(a,substitut,c);
1183     erg+=freeall(varanz);
1184     erg+=freeall(substitut);
1185     erg+=freeall(hilf);
1186     erg+=freeall(hilfpoly);
1187     ENDR("zykelind_kranz");
1188 }
1189 
zykelind_plethysm(a,b,c)1190 INT zykelind_plethysm(a,b,c) OP a,b,c;
1191 {
1192     return zykelind_kranz(b,a,c);
1193 }
1194 
1195 /* ***************************************************************
1196 
1197 Computation of the cycle index of the exponentiation.
1198 
1199 ****************************************************************** */
1200 
zykelind_exponentiation(a,b,c)1201 INT zykelind_exponentiation(a,b,c) OP a,b,c;
1202 {
1203     INT i;
1204     OP hilf=callocobject();
1205     OP hilf1=callocobject();
1206     OP v=callocobject();
1207     INT erg=OK;
1208     erg+=numberofvariables(a,hilf);
1209     erg+=m_l_v(hilf,v);
1210     erg+=m_i_i(1L,hilf1);
1211     for (i=0L;i<S_I_I(hilf);++i)
1212     {
1213       erg+=zykelind_operation_for_exp(hilf1,b,S_V_I(v,i));
1214       erg+=inc(hilf1);
1215     }
1216     erg+=eval_polynom_dir_prod(a,v,c);
1217     erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(v);
1218     ENDR("zykelind_exponentiation");
1219 }
1220 
zykelind_operation_for_exp(a,b,c)1221 static INT zykelind_operation_for_exp(a,b,c) OP a,b,c;
1222 {
1223     INT erg=OK;
1224     OP monom;
1225     OP hilfmonom=callocobject();
1226     OP hilf=callocobject();
1227     monom=b;
1228     erg+=m_i_i(0L,c);
1229     while (monom!=NULL)
1230     {
1231       erg+=zykeltyp_operation_for_exp(a,S_PO_S(monom),hilf);
1232       erg+=m_skn_po(hilf,S_PO_K(monom),NULL,hilfmonom);
1233       erg+=add_apply(hilfmonom,c);
1234       monom=S_PO_N(monom);
1235     }
1236     erg+=freeall(hilfmonom); erg+=freeall(hilf);
1237     if (erg!=OK) EDC("zykelind_operation_for_exp");
1238     return erg;
1239 }
1240 
zykeltyp_operation_for_exp(a,b,c)1241 static INT zykeltyp_operation_for_exp(a,b,c) OP a,b,c;
1242 {
1243     INT i,j,k,l;
1244     INT erg=OK;
1245     OP pow=callocobject();
1246     OP hilf=callocobject();
1247     OP hilf1=callocobject();
1248     OP hilf2=callocobject();
1249     OP hilf3=callocobject();
1250     OP hilf4=callocobject();
1251     OP hilf5=callocobject();
1252     OP teiler=callocobject();
1253     OP teiler1=callocobject();
1254     erg+=sum_vector1(b,hilf);
1255     erg+=hoch(hilf,a,pow);
1256     erg+=m_l_nv(pow,c);
1257     erg+=m_i_i(1L,hilf);
1258     for (i=0L;i<s_i_i(pow);++i)
1259     {
1260       erg+=alle_teiler(hilf,teiler);
1261       for (j=0L;j<S_V_LI(teiler);++j)
1262       {
1263        erg+=ganzdiv(hilf,S_V_I(teiler,j),hilf1);
1264        k=mu(hilf1);
1265        if (k!=0L)
1266        {
1267          erg+=ggt(a,S_V_I(teiler,j),hilf2);
1268          erg+=ganzdiv(S_V_I(teiler,j),hilf2,hilf3);
1269          erg+=alle_teiler(hilf3,teiler1);
1270          erg+=m_i_i(0L,hilf5);
1271          for (l=0L;l<S_V_LI(teiler1);++l)
1272          {
1273            if (le(S_V_I(teiler1,l),S_V_L(b)))
1274            {
1275          erg+=mult(S_V_I(teiler1,l),S_V_I(b,S_V_II(teiler1,l)-1L),hilf4);
1276          erg+=add_apply(hilf4,hilf5);
1277            }
1278          }
1279          erg+=hoch(hilf5,hilf2,hilf5);
1280          if (k>0L) erg+=add_apply(hilf5,S_V_I(c,i));
1281         else erg+=sub(S_V_I(c,i),hilf5,S_V_I(c,i));
1282        }
1283       }
1284       erg+=ganzdiv(S_V_I(c,i),hilf,S_V_I(c,i));
1285       erg+=inc(hilf);
1286     }
1287     erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(hilf2);
1288     erg+=freeall(hilf3); erg+=freeall(hilf4); erg+=freeall(hilf5);
1289     erg+=freeall(pow); erg+=freeall(teiler); erg+=freeall(teiler1);
1290     if (erg!=OK) EDC("zykeltyp_operation_for_exp");
1291     return erg;
1292 }
1293 
1294 /* **************************************************************
1295 
1296 The cycle indices of centralizers of permutations and
1297 stabilizers of partitions.
1298 
1299 ****************************************************************** */
1300 
zykelind_centralizer(typ,res)1301 INT zykelind_centralizer(typ,res) OP typ,res;
1302 /* Berechnet den Zyklenzeiger des Stabilisators einer Permutation,
1303 vom Zykeltyp typ.*/
1304 {
1305     INT erg=OK;
1306     OP typv,typvv;
1307     OP a=callocobject();
1308     OP b=callocobject();
1309     OP c=callocobject();
1310     OP d=callocobject();
1311     INT i;
1312     INT j=0L;
1313     erg+=m_scalar_polynom(cons_eins,res);
1314     if (S_O_K(typ)==PERMUTATION)
1315     {
1316       typv=callocobject();
1317       erg+=zykeltyp(typ,typv);
1318       t_VECTOR_EXPONENT(typv,typv);
1319       typvv=S_PA_S(typv);
1320       j=1L;
1321     }
1322     else if (S_O_K(typ)==PARTITION)
1323     {
1324       if (S_PA_K(typ)==VECTOR)
1325       {
1326         typv=callocobject();
1327         t_VECTOR_EXPONENT(typ,typv);
1328         typvv=S_PA_S(typv);
1329         j=1L;
1330       }
1331       else typvv=S_PA_S(typ);
1332     }
1333     else if ((S_O_K(typ)==VECTOR) || (S_O_K(typ)==INTEGERVECTOR)) typvv=typ;
1334     else if (S_O_K(typ)==POLYNOM) typvv=S_PO_S(typ);
1335     else error("zykelind_centralizer(a,b) a wrong objectkind");
1336     for (i=0,M_I_I(1L,d);i<S_V_LI(typvv);++i,inc(d))
1337     {
1338       if (!nullp(S_V_I(typvv,i)))
1339       {
1340         erg+=zykelind_Cn(d,a);
1341         erg+=zykelind_Sn(S_V_I(typvv,i),b);
1342         erg+=zykelind_kranz(b,a,c);
1343         erg+=zykelind_dir_summ_apply(c,res);
1344       }
1345     }
1346     erg+=freeall(a);erg+=freeall(b);erg+=freeall(c);erg+=freeall(d);
1347     if (j==1L) erg+=freeall(typv);
1348     if (erg!=OK) return error("in computation of zykelind_centralizer(a,b)");
1349     return(erg);
1350 }
1351 
zykelind_stabilizer_part(a,b)1352 INT zykelind_stabilizer_part(a,b) OP a,b;
1353 /* a ist ein PARTITION Objekt vom Typ EXPONENT
1354    b ist der Zyklenzeiger des Stabilisators von a
1355 */
1356 {
1357     if ((S_O_K(a)!=PARTITION) || (S_PA_K(a)!=EXPONENT))
1358     return error("zykelind_stabilizer_part(a,b) a is not a PARTITION of type EXPONENT");
1359     else
1360     {
1361     INT ret=OK;
1362     INT i;
1363     OP hilf=callocobject();
1364     OP hilf1=callocobject();
1365     OP hilf2=callocobject();
1366     OP hilf3=callocobject();
1367     m_i_i(1L,b);
1368     for (i=0L,M_I_I(1L,hilf);i<S_PA_LI(a);inc(hilf),++i)
1369     {
1370       if (!nullp(S_PA_I(a,i)))
1371       {
1372         ret+=zykelind_Sn(S_PA_I(a,i),hilf1);
1373         ret+=zykelind_Sn(hilf,hilf2);
1374         ret+=zykelind_kranz(hilf1,hilf2,hilf3);
1375         ret+=zykelind_dir_summ_apply(hilf3,b);
1376       }
1377     }
1378     ret+=freeall(hilf); ret+=freeall(hilf1);
1379     ret+=freeall(hilf2); ret+=freeall(hilf3);
1380     if (ret!=OK) return error("in computation of zykelind_stabilizer_part(a,b)");
1381     return(ret);
1382     }
1383 }
1384 
1385 /* ****************************************************************
1386 
1387 Some methods for computing the cycle indices of linear and affine
1388 groups. Furthermore to compute the orders of these groups, the
1389 number of irreducible polynomials of given degree over finite
1390 fields. etc.
1391 
1392 ******************************************************************* */
1393 
ordnung_glkq(k,q,ord)1394 INT ordnung_glkq(k,q,ord) OP k,q,ord;
1395 /* Berechnet ord als die Ordnung der Gruppe GL(k,Fq)  */
1396 {
1397     OP hilf,hilf1,hilf2;
1398     INT i;
1399     INT erg=OK;
1400     CTO(INTEGER,"ordnung_glkq(1)",k);
1401     SYMCHECK(S_I_I(k)<1,"ordnung_glkq:k<1");
1402     CTO(INTEGER,"ordnung_glkq(2)",q);
1403     CE3(k,q,ord,ordnung_glkq);
1404     FREESELF(ord);
1405     M_I_I(1L,ord);
1406 
1407     hilf=callocobject();
1408     hilf1=callocobject();
1409     hilf2=callocobject();
1410     erg+=hoch(q,k,hilf);
1411     for (i=0L;i<S_I_I(k);++i)
1412     {
1413       erg+=m_i_i(i,hilf1);
1414       erg+=hoch(q,hilf1,hilf2);
1415       erg+=sub(hilf,hilf2,hilf1);
1416       MULT_APPLY(hilf1,ord);
1417     }
1418     FREEALL3(hilf,hilf1,hilf2);
1419     ENDR("ordnung_glkq");
1420 }
1421 
ordnung_affkq(k,q,ord)1422 INT ordnung_affkq(k,q,ord) OP k,q,ord;
1423 /* Berechnet ord als die Ordnung der Gruppe Aff(k,Fq)  */
1424 {
1425     OP hilf;
1426     INT i;
1427     INT erg=OK;
1428     if (S_O_K(k)!=INTEGER) return error("ordnung_affkq(k,q,ord) k not INTEGER");
1429     if (S_I_I(k)<1L) return error("ordnung_affkq(k,q,ord)  k<1");
1430     if (S_O_K(q)!=INTEGER) return error("ordnung_affkq(k,q,ord) q not INTEGER");
1431     if (!emptyp(ord)) freeself(ord);
1432     hilf=callocobject();
1433     erg+=ordnung_glkq(k,q,ord);
1434     erg+=hoch(q,k,hilf);
1435     erg+=mult_apply(hilf,ord);
1436     erg+=freeall(hilf);
1437     if (erg!=OK) error("  in computation of ordnung_affkq(k,q,ord)");
1438     return(erg);
1439 }
1440 
kung_formel(d,lambda,q,anz)1441 INT kung_formel(d,lambda,q,anz) OP d,lambda,q,anz;
1442 /* Berechnet anz nach einer Formel von J.P.Kung als die Anzahl der
1443 Matrizen in GL(cd,Fq) die mit einer Matrix, die aus lambda(1)
1444 Begleitmatrizen eines irreduziblen Polynoms p, lambda(2)
1445 Hyperbegleitmarizen von p^2 usw. besteht.
1446 Dabei ist d der Grad des Polynoms p, lambda eine Partition von c (das
1447 ist die hoechste Potenz von p, die das charakteristische Polynom einer
1448 Matrix teilt, von der D(p,lambda) ein Block ist), q die Maechtigkeit
1449 des Koerpers und anz das Ergebnis.  */
1450 {
1451     INT i,j;
1452     INT erg=OK;
1453     OP hilf,hilf1,hilf2,mu;
1454     if (S_O_K(d)!=INTEGER) return error("kung_formel(d,lambda,q,anz) d not INTEGER");
1455     if (S_I_I(d)<1L) return error("kung_formel(d,lambda,q,anz)  d<1");
1456     if (S_O_K(lambda)!=PARTITION) return error("kung_formel(d,lambda,q,anz) lambda not PARTITION");
1457     if (S_O_K(q)!=INTEGER) return error("kung_formel(d,lambda,q,anz) q not INTEGER");
1458     if (!emptyp(anz)) freeself(anz);
1459     hilf=callocobject();
1460     hilf1=callocobject();
1461     hilf2=callocobject();
1462     mu=callocobject();
1463     if (S_PA_K(lambda)==VECTOR) t_VECTOR_EXPONENT(lambda,lambda);
1464     M_I_I(0L,mu);
1465     M_I_I(1L,anz);
1466     for (i=0;i<S_PA_LI(lambda);++i)
1467     {
1468       for (j=i;j<S_PA_LI(lambda);++j)
1469       {
1470         erg+=add_apply(S_PA_I(lambda,j),mu);
1471       }
1472       erg+=mult(d,mu,hilf);
1473       erg+=hoch(q,hilf,hilf);
1474       for (j=1L;j<=S_PA_II(lambda,i);++j)
1475       {
1476         erg+=m_i_i(j,hilf1);
1477         erg+=sub(mu,hilf1,hilf2);
1478         erg+=mult_apply(d,hilf2);
1479         erg+=hoch(q,hilf2,hilf2);
1480         erg+=sub(hilf,hilf2,hilf1);
1481         erg+=mult_apply(hilf1,anz);
1482       }
1483     }
1484     erg+=freeall(hilf);
1485     erg+=freeall(hilf1);
1486     erg+=freeall(hilf2);
1487     erg+=freeall(mu);
1488     if (erg!=OK) error(" in computation of kung_formel(d,lambda,q,anz)");
1489     return(erg);
1490 }
1491 
zykeltyp_poly_part(d,exp,mu,p,q,ergeb)1492 static INT zykeltyp_poly_part(d,exp,mu,p,q,ergeb) OP d,exp,mu,p,q,ergeb;
1493 /* Berechnet den Zykeltyp einer Blockdiagonalmatrix besthend aus
1494 Begleit und Hyperbegleitmatrizen eines irreduziblen normierten Polynoms
1495 vom Grad d, Exponenten (=Periode bzw. Ordnung) exp; Die Gestalt dieser
1496 Matrix wird durch die Prtition mu festgelegt, p ist die Charakteristik
1497 des Koerpers, q dessen Maechtigkeit, und ergeb ist der berechnete
1498 Zykeltyp.  */
1499 {
1500     INT i;
1501     INT erg=OK;
1502     OP hilf,hilf1;
1503     hilf=callocobject();
1504     hilf1=callocobject();
1505     erg+=m_iindex_monom(0L,ergeb);
1506     for (i=0L;i<S_PA_LI(mu);++i)
1507     {
1508       if (S_PA_II(mu,i)!=0L)
1509       {
1510         erg+=zykeltyp_hyperbegleitmatrix_poly(d,exp,i+1L,p,q,hilf);
1511         erg+=zykelind_hoch_dir_prod(hilf,S_PA_I(mu,i),hilf1);
1512         erg+=zykelind_dir_prod_apply(hilf1,ergeb);
1513       }
1514     }
1515     erg+=kung_formel(d,mu,q,hilf);
1516     erg+=invers_apply(hilf);
1517     erg+=m_scalar_polynom(hilf,hilf1);
1518     erg+=mult_apply(hilf1,ergeb);
1519     erg+=freeall(hilf);
1520     erg+=freeall(hilf1);
1521     if (erg!=OK) error("in computation of zykeltyp_poly_part(d,exp,mu,p,q,ergeb) ");
1522     return(erg);
1523 }
1524 
zykeltyp_hyperbegleitmatrix_poly(d,exp,i,p,q,ergeb)1525 static INT zykeltyp_hyperbegleitmatrix_poly(d,exp,i,p,q,ergeb) OP d,exp,p,q,ergeb; INT i;
1526 /* Bestimmt den Zykeltyp der Hyperbegleitmatrix von p(x)^i, einem
1527 irreduziblen normierten Polynom vom Grad d mit Exponenten exp, ueber
1528 einem Koerper von Charakteristik p und Maechtigkeit q. Das Ergebnis ist
1529 ergeb*/
1530 {
1531     OP e,hilf,hilf1,hilf2,hilfpoly;
1532     INT j,k;
1533     INT erg=OK;
1534     e=callocobject();
1535     hilf=callocobject();
1536     hilf1=callocobject();
1537     hilf2=callocobject();
1538     hilfpoly=callocobject();
1539     erg+=m_il_v(i,e);
1540     erg+=copy(exp,S_V_I(e,0L));
1541     k=1L;
1542     for (j=1L;j<i;++j)
1543     {
1544       erg+=copy(S_V_I(e,j-1L),S_V_I(e,j));
1545       if (k<j+1L)
1546       {
1547         k=k*s_i_i(p);
1548         erg+=mult_apply(p,S_V_I(e,j));
1549       }
1550     }
1551     erg+=m_iindex_monom(0L,ergeb);
1552     erg+=hoch(q,d,hilf);
1553     erg+=copy(hilf,hilf1);
1554     erg+=dec(hilf1);
1555     erg+=ganzdiv(hilf1,exp,hilf2);
1556     erg+=m_iindex_iexponent_monom(s_i_i(exp)-1L,s_i_i(hilf2),hilfpoly); /* HF130696 */
1557     erg+=mult_apply(hilfpoly,ergeb);
1558     for (j=1L;j<i;++j)
1559     {
1560       erg+=mult_apply(hilf,hilf1);
1561       erg+=ganzdiv(hilf1,S_V_I(e,j),hilf2);
1562       erg+=m_iindex_iexponent_monom(s_v_ii(e,j)-1L,s_i_i(hilf2),hilfpoly); /* HF130696 */
1563       erg+=mult_apply(hilfpoly,ergeb);
1564     }
1565     erg+=freeall(e);
1566     erg+=freeall(hilf);
1567     erg+=freeall(hilf1);
1568     erg+=freeall(hilf2);
1569     erg+=freeall(hilfpoly);
1570     if (erg!=OK) error("in computation of zykeltyp_hyperbegleitmatrix_poly(d,exp,i,p,q,ergeb) ");
1571     return(erg);
1572 }
1573 
number_of_irred_poly_of_degree(d,q,ergeb)1574 INT number_of_irred_poly_of_degree(d,q,ergeb) OP d,q,ergeb;
1575 /* Berechnet die Anzahl der normierten, irreduziblen Polynome
1576 vom Grad d uber dem Koerper F_q:  */
1577 {
1578     OP hilf,hilf1;
1579     INT i,j;
1580     INT erg=OK;
1581     hilf=callocobject();
1582     hilf1=callocobject();
1583     if (!emptyp(ergeb)) erg+=freeself(ergeb);
1584     M_I_I(0L,ergeb);
1585     erg+=alle_teiler(d,hilf);
1586     for (i=0L;i<S_V_LI(hilf);++i)
1587     {
1588       erg+=ganzdiv(d,S_V_I(hilf,i),hilf1);
1589       erg+=hoch(q,hilf1,hilf1);
1590       j=mu(S_V_I(hilf,i));
1591       if (j>0L) erg+=add_apply(hilf1,ergeb);
1592       else
1593       if (j<0L) erg+=sub(ergeb,hilf1,ergeb);
1594     }
1595     erg+=ganzdiv(ergeb,d,ergeb);
1596     erg+=freeall(hilf);
1597     erg+=freeall(hilf1);
1598     if (erg!=OK) error("in computation of number_of_irred_poly_of_degree(d,q,ergeb) ");
1599     return(erg);
1600 }
1601 
exponenten_bestimmen(d,q,a,b)1602 static INT exponenten_bestimmen(d,q,a,b) OP d,q,a,b;
1603 {
1604     INT i,j,k,l;
1605     OP hilf,hilfv,dd,c,e,f,g,h,speicher;
1606     OP ax_e;
1607     INT erg=OK;
1608     hilf=callocobject();
1609     hilfv=callocobject();
1610     dd=callocobject();
1611     c=callocobject();
1612     e=callocobject();
1613     f=callocobject();
1614     g=callocobject();
1615     h=callocobject();
1616     speicher=callocobject();
1617     erg+=init(BINTREE,speicher);
1618     erg+=m_l_v(d,a);
1619     erg+=m_l_v(d,b);
1620     for (i=0L;i<S_I_I(d);++i)
1621     {
1622       M_I_I(i+1L,dd);
1623       erg+=m_il_v(0L,hilf);
1624       erg+=m_il_v(0L,hilfv);
1625       l=0L;
1626       erg+=hoch(q,dd,c);
1627       erg+=dec(c);
1628       erg+=alle_teiler(c,e);
1629       for (j=0L;j<S_V_LI(e);++j)
1630       {
1631         if (einsp(dd) && einsp(S_V_I(e,j)))
1632         {
1633           erg+=inc(hilf);erg+=inc(hilfv);
1634           erg+=copy(S_V_I(e,j),S_V_I(hilfv,l));
1635           M_I_I(1L,S_V_I(hilf,l));
1636           l=l+1L;
1637           /*printf("Exponent = %d , Vielfachheit = %d\n",s_v_ii(e,j),1L);*/
1638         ax_e = callocobject(); erg+=copy(S_V_I(e,j),ax_e);
1639           insert(ax_e,speicher,NULL,NULL);
1640         }
1641         else
1642         {
1643           erg+=euler_phi(S_V_I(e,j),f);
1644           erg+=quores(f,dd,g,h);
1645           if (nullp(h))
1646           {
1647         ax_e = callocobject(); erg+=copy(S_V_I(e,j),ax_e);
1648         if (insert(ax_e,speicher,NULL,NULL)==INSERTOK)
1649         {
1650           erg+=inc(hilf);erg+=inc(hilfv);
1651           erg+=copy(S_V_I(e,j),S_V_I(hilfv,l));
1652           erg+=copy(g,S_V_I(hilf,l));
1653           ++l;
1654           /*printf("Exponent = %d , Vielfachheit = %d\n",s_v_ii(e,j),s_i_i(g));*/
1655         }
1656           }
1657         }
1658       }
1659       /* e=callocobject(); AK 260594 */
1660       erg+=copy(hilfv,S_V_I(a,i));
1661       erg+=copy(hilf,S_V_I(b,i));
1662     }
1663     erg+=freeall(e);
1664     erg+=freeall(hilf);
1665     erg+=freeall(hilfv);
1666     erg+=freeall(dd);
1667     erg+=freeall(c);
1668     erg+=freeall(f);
1669     erg+=freeall(g);
1670     erg+=freeall(h);
1671     erg+=freeall(speicher);
1672     if (erg!=OK) error("in computation of exponenten_bestimmen(d,q,a,b)");
1673     return(erg);
1674 }
1675 
zykelind_glkq(k,q,ergeb)1676 INT zykelind_glkq(k,q,ergeb) OP k,q,ergeb;
1677 {
1678     OP p,null,c,c1,c2,c3,d,hilf,hilf1,zs1,zs2,zs3,zs4,zs5,zs6,v1,v2;
1679     INT i,j,l;
1680     INT erg=OK;
1681     p=callocobject();
1682     c=callocobject();
1683     c1=callocobject();
1684     c2=callocobject();
1685     c3=callocobject();
1686     d=callocobject();
1687     hilf=callocobject();
1688     hilf1=callocobject();
1689     zs1=callocobject();
1690     zs2=callocobject();
1691     zs3=callocobject();
1692     zs4=callocobject();
1693     zs5=callocobject();
1694     zs6=callocobject();
1695     null=callocobject();
1696     v1=callocobject();
1697     v2=callocobject();
1698     if (charakteristik_bestimmen(q,p)!=OK) return error("in computation of zykelind_glkq(k,q,ergeb)");
1699     erg+=exponenten_bestimmen(k,q,v1,v2);
1700     M_I_I(0L,null);
1701     erg+=m_scalar_polynom(null,ergeb);
1702     first_part_EXPONENT(k,c);
1703     do
1704     {  /*2*/
1705       erg+=m_iindex_monom(0L,zs1);
1706       for (i=0L;i<S_PA_LI(c);++i)
1707       {  /*3*/
1708         if (S_PA_II(c,i)>0L)
1709         {  /*4*/
1710           M_I_I(i+1L,d);
1711           erg+=m_scalar_polynom(null,zs2);
1712           first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1);
1713           do
1714           { /*5*/
1715         erg+=m_iindex_monom(0L,zs3);
1716         for (j=0L;j<S_V_LI(c1);++j)
1717         { /*6*/
1718           if (S_V_II(c1,j)!=0L)
1719           { /*7*/
1720             erg+=m_scalar_polynom(null,zs4);
1721             first_part_into_atmost_k_parts(S_V_I(c1,j),S_V_I(S_V_I(v2,i),j),c2);
1722             do
1723             { /*8*/
1724               erg+=m_iindex_monom(0L,zs5);
1725               for (l=0L;l<S_V_LI(c2);++l)
1726               {  /*9*/
1727             if (S_V_II(c2,l)!=0L)
1728             {  /*10*/
1729               erg+=m_scalar_polynom(null,zs6);
1730               first_part_EXPONENT(S_V_I(c2,l),c3);
1731               do
1732               {  /*11*/
1733                 erg+=zykeltyp_poly_part(d,S_V_I(S_V_I(v1,i),j),c3,p,q,hilf);
1734                 erg+=add_apply(hilf,zs6);
1735               } while (next(c3,c3)); /*11*/
1736               erg+=zykelind_dir_prod_apply(zs6,zs5);
1737             }  /*10*/
1738               }  /*9*/
1739               erg+=fmultinom_ext(S_V_I(S_V_I(v2,i),j),c2,hilf);
1740               erg+=m_scalar_polynom(hilf,hilf1);
1741               erg+=mult_apply(hilf1,zs5);
1742               erg+=add_apply(zs5,zs4);
1743               l=next_part_into_atmost_k_parts(c2);
1744             } while(l==1L); /*8*/
1745             erg+=zykelind_dir_prod_apply(zs4,zs3);
1746           }  /*7*/
1747         }  /*6*/
1748           erg+=add_apply(zs3,zs2);
1749           j=next_unordered_part_into_atmost_k_parts(c1);
1750           } while(j==1L); /*5*/
1751         erg+=zykelind_dir_prod_apply(zs2,zs1);
1752         }  /*4*/
1753       }  /*3*/
1754       erg+=add_apply(zs1,ergeb);
1755     }  /*2*/
1756     while (next(c,c));
1757     erg+=freeall(p);
1758     erg+=freeall(c);
1759     erg+=freeall(c1);
1760     erg+=freeall(c2);
1761     erg+=freeall(c3);
1762     erg+=freeall(d);
1763     erg+=freeall(hilf);
1764     erg+=freeall(hilf1);
1765     erg+=freeall(zs1);
1766     erg+=freeall(zs2);
1767     erg+=freeall(zs3);
1768     erg+=freeall(zs4);
1769     erg+=freeall(zs5);
1770     erg+=freeall(zs6);
1771     erg+=freeall(null);
1772     erg+=freeall(v1);
1773     erg+=freeall(v2);
1774     ENDR("zykelind_glkq");
1775 }
1776 
charakteristik_bestimmen(q,p)1777 static INT charakteristik_bestimmen(q,p) OP q,p;
1778 {
1779     INT erg=OK;
1780     OP hilf=callocobject();
1781     if (S_O_K(q)!=INTEGER) return error("charakteristik_bestimmen(q,p)  q not INTEGER");
1782     if (S_I_I(q)<2L) return error("charakteristik_bestimmen(q,p)  q<2");
1783     if (!emptyp(p)) erg+=freeself(p);
1784         erg+=integer_factor(q,hilf);/* monopoly Faktorisierung von q */
1785         if (s_l_n(hilf)!=NULL)
1786         {
1787           freeall(hilf);
1788           return error("q is not a power of a prime");
1789         }
1790         erg+=copy(S_PO_S(hilf),p);
1791         erg+=freeall(hilf);
1792         if (erg!=OK) error("in computation of charakteristik_bestimmen(q,p)");
1793         return erg;
1794 }
1795 
zykelind_affkq(k,q,ergeb)1796 INT zykelind_affkq(k,q,ergeb) OP k,q,ergeb;
1797 {
1798     OP p,null,c,c1,c2,c3,d,hilf,hilf1,zs1,zs2,zs3,zs4,zs5,zs6,v1,v2;
1799     INT i,j,l;
1800     INT erg=OK;
1801     p=callocobject();
1802     c=callocobject();
1803     c1=callocobject();
1804     c2=callocobject();
1805     c3=callocobject();
1806     d=callocobject();
1807     hilf=callocobject();
1808     hilf1=callocobject();
1809     zs1=callocobject();
1810     zs2=callocobject();
1811     zs3=callocobject();
1812     zs4=callocobject();
1813     zs5=callocobject();
1814     zs6=callocobject();
1815     null=callocobject();
1816     v1=callocobject();
1817     v2=callocobject();
1818     if (charakteristik_bestimmen(q,p)!=OK) return error("in computation of zykelind_affkq(k,q,ergeb)");
1819     erg+=exponenten_bestimmen(k,q,v1,v2);
1820     M_I_I(0L,null);
1821     erg+=m_scalar_polynom(null,ergeb);
1822     first_part_EXPONENT(k,c);
1823     do
1824     {  /*2*/
1825       erg+=m_iindex_monom(0L,zs1);
1826       for (i=0L;i<S_PA_LI(c);++i)
1827       {  /*3*/
1828         if (S_PA_II(c,i)>0L)
1829         {  /*4*/
1830           M_I_I(i+1L,d);
1831           erg+=m_scalar_polynom(null,zs2);
1832           first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1);
1833           do
1834           { /*5*/
1835         erg+=m_iindex_monom(0L,zs3);
1836         for (j=0L;j<S_V_LI(c1);++j)
1837         { /*6*/
1838           if (S_V_II(c1,j)!=0L)
1839           { /*7*/
1840             erg+=m_scalar_polynom(null,zs4);
1841             first_part_into_atmost_k_parts(S_V_I(c1,j),S_V_I(S_V_I(v2,i),j),c2);
1842             do
1843             { /*8*/
1844               erg+=m_iindex_monom(0L,zs5);
1845               for (l=0L;l<S_V_LI(c2);++l)
1846               {  /*9*/
1847             if (S_V_II(c2,l)!=0L)
1848             {  /*10*/
1849               erg+=m_scalar_polynom(null,zs6);
1850               first_part_EXPONENT(S_V_I(c2,l),c3);
1851               do
1852               {  /*11*/
1853                 erg+=zykeltyp_poly_part_aff(d,S_V_I(S_V_I(v1,i),j),c3,p,q,hilf);
1854                 erg+=add_apply(hilf,zs6);
1855               } while (next(c3,c3)); /*11*/
1856               erg+=zykelind_dir_prod_apply(zs6,zs5);
1857             }  /*10*/
1858               }  /*9*/
1859               erg+=fmultinom_ext(s_v_i(s_v_i(v2,i),j),c2,hilf);
1860               erg+=m_scalar_polynom(hilf,hilf1);
1861               erg+=mult_apply(hilf1,zs5);
1862               erg+=add_apply(zs5,zs4);
1863               l=next_part_into_atmost_k_parts(c2);
1864             } while(l==1L); /*8*/
1865             erg+=zykelind_dir_prod_apply(zs4,zs3);
1866           }  /*7*/
1867         }  /*6*/
1868           erg+=add_apply(zs3,zs2);
1869           j=next_unordered_part_into_atmost_k_parts(c1);
1870           } while(j==1L); /*5*/
1871         erg+=zykelind_dir_prod_apply(zs2,zs1);
1872         }  /*4*/
1873       }  /*3*/
1874       erg+=add_apply(zs1,ergeb);
1875     }  /*2*/
1876     while (next(c,c));
1877     erg+=hoch(q,k,hilf);
1878     erg+=invers_apply(hilf);
1879     erg+=mult_apply(hilf,ergeb);
1880     erg+=freeall(p); erg+=freeall(c); erg+=freeall(c1); erg+=freeall(c2);
1881     erg+=freeall(c3); erg+=freeall(d); erg+=freeall(hilf); erg+=freeall(hilf1);
1882     erg+=freeall(zs1); erg+=freeall(zs2); erg+=freeall(zs3); erg+=freeall(zs4);
1883     erg+=freeall(zs5); erg+=freeall(zs6); erg+=freeall(null); erg+=freeall(v1);
1884     erg+=freeall(v2);
1885     if (erg!=OK) error("in compuation of zykelind_affkq(k,q,ergeb) ");
1886     return(erg);
1887 }
1888 
zykeltyp_poly_part_aff(d,exp,mu,p,q,ergeb)1889 static INT zykeltyp_poly_part_aff(d,exp,mu,p,q,ergeb) OP d,exp,mu,p,q,ergeb;
1890 /* Berechnet den Zykeltyp einer Blockdiagonalmatrix besthend aus
1891 Begleit und Hyperbegleitmatrizen eines irreduziblen normierten Polynoms
1892 vom Grad d, Exponenten (=Periode bzw. Ordnung) exp; Die Gestalt dieser
1893 Matrix wird durch die Prtition mu festgelegt, p ist die Charakteristik
1894 des Koerpers, q dessen Maechtigkeit, und ergeb ist der berechnete
1895 Zykeltyp.  */
1896 {
1897     INT i;
1898     INT erg=OK;
1899     OP hilf,hilf1;
1900     hilf=callocobject();
1901     hilf1=callocobject();
1902     erg+=m_iindex_monom(0L,ergeb);
1903     if ((!einsp(d)) || ((S_I_I(q)!=2L) && (S_I_I(exp)!=1L)))
1904     {
1905       for (i=0L;i<S_PA_LI(mu);++i)
1906       {
1907         if (S_PA_II(mu,i)!=0L)
1908         {
1909           erg+=zykeltyp_hyperbegleitmatrix_poly(d,exp,i+1L,p,q,hilf);
1910           erg+=m_i_i(i+1L,hilf1);
1911           erg+=mult_apply(d,hilf1);
1912           erg+=hoch(q,hilf1,hilf1);
1913           erg+=mult_apply(hilf1,hilf);
1914           erg+=zykelind_hoch_dir_prod(hilf,S_PA_I(mu,i),hilf1);
1915           erg+=zykelind_dir_prod_apply(hilf1,ergeb);
1916         }
1917       }
1918     }
1919     else
1920     {
1921       for (i=0L;i<S_PA_LI(mu);++i)
1922       {
1923         if (S_PA_II(mu,i)!=0L)
1924         {
1925           erg+=zykeltyp_hyperbegleitmatrix_poly(d,exp,i+1L,p,q,hilf);
1926           erg+=m_i_i(i,hilf1);
1927           erg+=hoch(q,hilf1,hilf1);
1928           erg+=mult_apply(hilf1,hilf);
1929           erg+=zykeltyp_hyperbegleitmatrix_poly_afferg(exp,i+2L,p,q,hilf1);
1930           erg+=add_apply(hilf1,hilf);
1931           erg+=zykelind_hoch_dir_prod(hilf,S_PA_I(mu,i),hilf1);
1932           erg+=zykelind_dir_prod_apply(hilf1,ergeb);
1933         }
1934       }
1935     }
1936     erg+=kung_formel(d,mu,q,hilf);
1937     erg+=invers_apply(hilf);
1938     erg+=m_scalar_polynom(hilf,hilf1);
1939     erg+=mult_apply(hilf1,ergeb);
1940     erg+=freeall(hilf);
1941     erg+=freeall(hilf1);
1942     if (erg!=OK) error(" In computation of zykeltyp_poly_part_aff(d,exp,mu,p,q,ergeb) ");
1943     return(erg);
1944 }
1945 
zykeltyp_hyperbegleitmatrix_poly_afferg(exp,i,p,q,ergeb)1946 static INT zykeltyp_hyperbegleitmatrix_poly_afferg(exp,i,p,q,ergeb) OP exp,p,q,ergeb; INT i;
1947 /* Bestimmt den Zykeltyp der Hyperbegleitmatrix von p(x)^i, einem
1948 irreduziblen normierten Polynom vom Grad d mit Exponenten exp, ueber
1949 einem Koerper von Charakteristik p und Maechtigkeit q. Das Ergebnis ist
1950 ergeb*/
1951 {
1952     OP e,hilf,hilf1,hilf2;
1953     INT j,k;
1954     INT erg=OK;
1955     e=callocobject();
1956     hilf=callocobject();
1957     hilf1=callocobject();
1958     hilf2=callocobject();
1959     M_I_I(1L,e);
1960     M_I_I(i,hilf);
1961     while (gt(hilf,e))
1962     {
1963       erg+=mult_apply(p,e);
1964     }
1965     erg+=dec(hilf);
1966     erg+=hoch(q,hilf,hilf1);
1967     erg+=ganzdiv(hilf1,e,hilf2);
1968     erg+=m_iindex_iexponent_monom(s_i_i(e)-1L,s_i_i(hilf2),ergeb); /* HF130696 */
1969     erg+=dec(hilf);
1970     erg+=hoch(q,hilf,hilf1);
1971     erg+=copy(q,hilf);
1972     erg+=dec(hilf);
1973     erg+=mult_apply(hilf,hilf1);
1974     erg+=mult_apply(hilf1,ergeb);
1975     erg+=freeall(e);
1976     erg+=freeall(hilf);
1977     erg+=freeall(hilf1);
1978     erg+=freeall(hilf2);
1979     if (erg!=OK) error("in computation of zykeltyp_hyperbegleitmatrix_poly_afferg(exp,i,p,q,ergeb) ");
1980     return(erg);
1981 }
1982 
1983 /* *************************************************************
1984 
1985 The cycle indices of the natural actions of the general linear
1986 and affine groups over Z modulo kZ.
1987 
1988 **************************************************************** */
1989 
zykelind_glkzn(k,n,cy_ind)1990 INT zykelind_glkzn(k,n,cy_ind) OP k,n,cy_ind;
1991 /* Berechnet fuer quadratfreies n>=1 INTEGER objekt den Zyklenzeiger
1992 der Gruppe aller regulaeren $k\times k$ Matrizen (k ein INTEGER objekt)
1993 ueber Z_n=(Z modulo n) als Permutationsgruppe von Z_n^k  */
1994 {
1995     INT erg=OK;
1996     OP hilf=callocobject();
1997     OP hilfpoly=callocobject();
1998     OP q=callocobject();
1999     if (S_O_K(k)!=INTEGER) return error("zykelind_glkzn(k,n,cy_ind)  k not INTEGER");
2000     if (S_I_I(k)<1L) return error("zykelind_glkzn(k,n,cy_ind)  k<1");
2001     if (S_O_K(n)!=INTEGER) return error("zykelind_glkzn(k,n,cy_ind)  n not INTEGER");
2002     if (S_I_I(n)<1L) return error("zykelind_glkzn(k,n,cy_ind)  n<1");
2003     if (!emptyp(cy_ind)) erg+=freeself(cy_ind);
2004     erg+=m_iindex_monom(0L,cy_ind);
2005     erg+=integer_factor(n,hilf);/* monopoly Faktorisierung von q */
2006     erg+=copy(hilf,q);
2007     while(hilf!=NULL)
2008     {
2009       if (!einsp(S_PO_K(hilf))) return error(" zykelind_glkzn(k,n,cy_ind)  n not square free");
2010       hilf=s_l_n(hilf);
2011     }
2012     hilf=callocobject();
2013     erg+=copy(q,hilf);
2014     while(hilf!=NULL)
2015     {
2016       erg+=copy(S_PO_S(hilf),q);
2017       erg+=zykelind_glkq(k,q,hilfpoly);
2018       erg+=zykelind_dir_prod_apply(hilfpoly,cy_ind);
2019       hilf=s_l_n(hilf);
2020     }
2021     /*erg+=freeall(hilf);*/
2022     erg+=freeall(hilfpoly);
2023     erg+=freeall(q);
2024     if (erg!=OK) error("in computation of zykelind_glkzn(k,n,cy_ind)");
2025     return(erg);
2026 }
2027 
zykelind_affkzn(k,n,cy_ind)2028 INT zykelind_affkzn(k,n,cy_ind)
2029     OP k,n,cy_ind;
2030 /* Berechnet fuer quadratfreies n>=1 INTEGER objekt den Zyklenzeiger
2031 der Gruppe aller affinen Abbildungen Z_n^k -> Z_n^k  mit
2032 Z_n=(Z modulo n) als Permutationsgruppe von Z_n^k  */
2033 {
2034     INT erg=OK;
2035     OP hilf=callocobject();
2036     OP hilfpoly=callocobject();
2037     OP q=callocobject();
2038     if (S_O_K(k)!=INTEGER) return error("zykelind_affkzn(k,n,cy_ind)  k not INTEGER");
2039     if (S_I_I(k)<1L) return error("zykelind_affkzn(k,n,cy_ind)  k<1");
2040     if (S_O_K(n)!=INTEGER) return error("zykelind_affkzn(k,n,cy_ind)  n not INTEGER");
2041     if (S_I_I(n)<1L) return error("zykelind_affkzn(k,n,cy_ind)  n<1");
2042     if (!emptyp(cy_ind)) erg+=freeself(cy_ind);
2043     if (einsp(k)) return zykelind_aff1Zn(n,cy_ind);
2044     erg+=m_iindex_monom(0L,cy_ind);
2045     erg+=integer_factor(n,hilf);/* monopoly Faktorisierung von q */
2046     erg+=copy(hilf,q);
2047     while(hilf!=NULL)
2048     {
2049       if (!einsp(S_PO_K(hilf))) return error(" zykelind_affkzn(k,n,cy_ind)  n not square free");
2050       hilf=s_l_n(hilf);
2051     }
2052     hilf=callocobject();
2053     erg+=copy(q,hilf);
2054     while(hilf!=NULL)
2055     {
2056       erg+=copy(S_PO_S(hilf),q);
2057       erg+=zykelind_affkq(k,q,hilfpoly);
2058       erg+=zykelind_dir_prod_apply(hilfpoly,cy_ind);
2059       hilf=s_l_n(hilf);
2060     }
2061     /*erg+=freeall(hilf);*/
2062     erg+=freeall(hilfpoly);
2063     erg+=freeall(q);
2064     ENDR("internal function zykelind_affkzn");
2065 }
2066 
zykelind_aff1Zp(p,a,r)2067 static INT zykelind_aff1Zp(p,a,r)
2068     OP p,a,r;
2069 /* p sei eine Primzahl ungleich 2
2070 r ist der Zyklenzeiger von der Gruppe aller affinen Abbildungen von
2071 Z_{p^a}.
2072 */
2073 {
2074     if (eq(p,cons_zwei)) return zykelind_aff1Z2(a,r);
2075     else
2076     {
2077     INT erg=OK;
2078     INT i,j,k;
2079     OP hilf1=callocobject();
2080     OP hilf2=callocobject();
2081     OP hilf3=callocobject();
2082     OP hilf4=callocobject();
2083     OP hilf5=callocobject();
2084     OP hmonom=callocobject();
2085     OP hmonom1=callocobject();
2086     OP teiler=callocobject();
2087     OP pp=callocobject();
2088     erg+=m_i_i(0L,r);
2089     erg+=copy(p,pp);
2090     erg+=dec(pp);
2091     erg+=alle_teiler(pp,teiler);
2092     erg+=m_i_i(0L,hilf1);
2093     for (i=0L;i<S_I_I(a);++i)
2094     {
2095       for (j=0L;j<S_V_LI(teiler);++j)
2096       {
2097         if (einsp(S_V_I(teiler,j)))
2098         {
2099           erg+=hoch(p,hilf1,hilf2);
2100           erg+=euler_phi(hilf2,hilf3);
2101           erg+=mult_apply(hilf3,hilf2);
2102           erg+=sub(a,hilf1,hilf3);
2103           erg+=dec(hilf3);
2104           erg+=hoch(p,hilf3,hilf4);
2105           erg+=m_iindex_iexponent_monom(0L,s_i_i(hilf4),hmonom);
2106           erg+=mult_apply(hilf2,hmonom);
2107           erg+=mult_apply(pp,hilf4);
2108           for (k=0L;k<=i;++k)
2109           {
2110         erg+=m_i_i(k,hilf2);
2111         erg+=hoch(p,hilf2,hilf3);
2112         erg+=m_iindex_iexponent_monom(s_i_i(hilf3)-1L,s_i_i(hilf4),hmonom1);
2113         erg+=mult_apply(hmonom1,hmonom);
2114           }
2115         }
2116         else
2117         {
2118           erg+=hoch(p,a,hilf2);
2119           erg+=hoch(p,hilf1,hilf3);
2120           erg+=mult_apply(S_V_I(teiler,j),hilf3);
2121           erg+=euler_phi(hilf3,hilf4);
2122           erg+=mult_apply(hilf4,hilf2);
2123           erg+=m_iindex_iexponent_monom(0L,1L,hmonom);
2124           erg+=mult_apply(hilf2,hmonom);
2125           erg+=sub(a,hilf1,hilf3);
2126           erg+=dec(hilf3);
2127           erg+=hoch(p,hilf3,hilf4);
2128           erg+=dec(hilf4);
2129           erg+=ganzdiv(hilf4,S_V_I(teiler,j),hilf2);
2130           erg+=m_iindex_iexponent_monom(S_V_II(teiler,j)-1L,s_i_i(hilf2),hmonom1);
2131           erg+=mult_apply(hmonom1,hmonom);
2132           erg+=inc(hilf4);
2133           erg+=mult_apply(pp,hilf4);
2134           erg+=ganzdiv(hilf4,S_V_I(teiler,j),hilf4);
2135           for (k=0L;k<=i;++k)
2136           {
2137         erg+=m_i_i(k,hilf2);
2138         erg+=hoch(p,hilf2,hilf3);
2139         erg+=mult_apply(S_V_I(teiler,j),hilf3);
2140         erg+=m_iindex_iexponent_monom(s_i_i(hilf3)-1L,s_i_i(hilf4),hmonom1);
2141         erg+=mult_apply(hmonom1,hmonom);
2142           }
2143         }
2144         erg+=add_apply(hmonom,r);
2145       }
2146       erg+=mult(cons_zwei,hilf1,hilf2);
2147       erg+=hoch(p,hilf2,hilf3);
2148       erg+=mult_apply(pp,hilf3);
2149       erg+=inc(hilf1);
2150       erg+=hoch(p,hilf1,hilf2);
2151       erg+=sub(a,hilf1,hilf4);
2152       erg+=hoch(p,hilf4,hilf5);
2153       erg+=m_iindex_iexponent_monom(s_i_i(hilf2)-1L,s_i_i(hilf5),hmonom);
2154       erg+=mult_apply(hilf3,hmonom);
2155       erg+=add_apply(hmonom,r);
2156     }
2157     erg+=mult(a,cons_zwei,hilf1);
2158     erg+=dec(hilf1);
2159     erg+=hoch(p,hilf1,hilf2);
2160     erg+=mult_apply(pp,hilf2);
2161     erg+=div(r,hilf2,r);
2162     erg+=freeall(hilf1); erg+=freeall(hilf2); erg+=freeall(hilf3);
2163     erg+=freeall(hilf4); erg+=freeall(hilf5); erg+=freeall(hmonom);
2164     erg+=freeall(hmonom1); erg+=freeall(teiler); erg+=freeall(pp);
2165     ENDR("internal function zykelind_aff1Zp");
2166     }
2167 }
2168 
zykelind_aff1Z2(a,r)2169 static INT zykelind_aff1Z2(a,r)
2170     OP a,r;
2171 {
2172     INT erg=OK;
2173     OP hmonom=callocobject();
2174     if (eq(a,cons_eins))
2175     {
2176       erg+=m_iindex_iexponent_monom(0L,2L,r);
2177       erg+=m_iindex_iexponent_monom(1L,1L,hmonom);
2178       erg+=add_apply(hmonom,r);
2179       erg+=div(r,cons_zwei,r);
2180     }
2181     else if (eq(a,cons_zwei))
2182     {
2183       OP v=callocobject();
2184       erg+=m_iindex_iexponent_monom(0L,4L,r);
2185       erg+=m_il_v(2L,v);
2186       erg+=m_i_i(2L,S_V_I(v,0L));
2187       erg+=m_i_i(1L,S_V_I(v,1L));
2188       erg+=m_skn_po(v,cons_zwei,NULL,hmonom);
2189       erg+=add_apply(hmonom,r);
2190       erg+=m_iindex_iexponent_monom(1L,2L,hmonom);
2191       erg+=m_i_i(3L,S_PO_K(hmonom));
2192       erg+=add_apply(hmonom,r);
2193       erg+=m_iindex_iexponent_monom(3L,1L,hmonom);
2194       erg+=m_i_i(2L,S_PO_K(hmonom));
2195       erg+=add_apply(hmonom,r);
2196       erg+=m_i_i(8L,hmonom);
2197       erg+=div(r,hmonom,r);
2198       erg+=freeall(v);
2199     }
2200     else
2201     {
2202     INT i,j;
2203     OP hilf1=callocobject();
2204     OP hilf2=callocobject();
2205     OP hilf3=callocobject();
2206     OP hilf4=callocobject();
2207     OP hilf5=callocobject();
2208     OP hmonom1=callocobject();
2209     OP hmonom2=callocobject();
2210     OP aa=callocobject();
2211     erg+=copy(a,aa);
2212     erg+=dec(aa);
2213     erg+=hoch(cons_zwei,a,hilf1);
2214     erg+=m_iindex_iexponent_monom(s_i_i(hilf1)-1L,1L,r);
2215     erg+=mult(cons_zwei,aa,hilf1);
2216     erg+=dec(hilf1);
2217     erg+=hoch(cons_zwei,hilf1,S_PO_K(r));
2218     erg+=hoch(cons_zwei,aa,aa);
2219     erg+=m_i_i(0L,hilf1);
2220     for (i=0L;i<S_I_I(a)-1L;++i)
2221     {
2222       erg+=hoch(cons_zwei,hilf1,hilf2);
2223       erg+=euler_phi(hilf2,hilf3);
2224       erg+=sub(a,hilf1,hilf4);
2225       erg+=hoch(cons_zwei,hilf4,hilf5);
2226       erg+=m_iindex_iexponent_monom(0L,s_i_i(hilf5),hmonom);
2227       erg+=mult_apply(hilf2,hmonom);
2228       erg+=dec(hilf4);
2229       erg+=hoch(cons_zwei,hilf4,hilf5);
2230       erg+=m_iindex_iexponent_monom(0L,2L,hmonom1);
2231       erg+=m_iindex_iexponent_monom(1L,s_i_i(hilf5)-1L,hmonom2);
2232       erg+=mult_apply(hmonom2,hmonom1);
2233       erg+=mult_apply(aa,hmonom1);
2234       erg+=add_apply(hmonom1,hmonom);
2235       erg+=mult_apply(hilf3,hmonom);
2236       for (j=1L;j<=i;++j)
2237       {
2238         erg+=m_i_i(j,hilf2);
2239         erg+=hoch(cons_zwei,hilf2,hilf3);
2240         erg+=m_iindex_iexponent_monom(s_i_i(hilf3)-1L,s_i_i(hilf5),hmonom1);
2241         erg+=mult_apply(hmonom1,hmonom);
2242       }
2243       erg+=add_apply(hmonom,r);
2244       erg+=mult(cons_zwei,hilf1,hilf2);
2245       erg+=hoch(cons_zwei,hilf2,hilf3);
2246       erg+=hoch(cons_zwei,hilf1,hilf4);
2247       erg+=euler_phi(hilf4,hilf5);
2248       erg+=mult_apply(aa,hilf5);
2249       erg+=add_apply(hilf3,hilf5);
2250       erg+=inc(hilf1);
2251       erg+=hoch(cons_zwei,hilf1,hilf2);
2252       erg+=sub(a,hilf1,hilf3);
2253       erg+=hoch(cons_zwei,hilf3,hilf4);
2254       erg+=m_iindex_iexponent_monom(s_i_i(hilf2)-1L,s_i_i(hilf4),hmonom);
2255       erg+=mult_apply(hilf5,hmonom);
2256       erg+=add_apply(hmonom,r);
2257     }
2258     erg+=mult_apply(aa,aa);
2259     erg+=mult_apply(cons_zwei,aa);
2260     erg+=div(r,aa,r);
2261     erg+=freeall(hilf1); erg+=freeall(hilf2); erg+=freeall(hilf3);
2262     erg+=freeall(hilf4); erg+=freeall(hilf5); erg+=freeall(hmonom1);
2263     erg+=freeall(hmonom2); erg+=freeall(aa);
2264     }
2265     erg+=freeall(hmonom);
2266     ENDR("internal function zykelind_aff1Z2");
2267 }
2268 
zykelind_aff1Zn(a,b)2269 INT zykelind_aff1Zn(a,b) OP a,b;
2270 /* Berechnet den Zyklenzeiger der Gruppe aller affinen Abbildungen
2271 von Z_a nach Z_a.  */
2272 {
2273     INT erg=OK;
2274     OP hilf=callocobject();
2275     OP hilf1=callocobject();
2276     erg+=m_iindex_iexponent_monom(0L,1L,b);
2277     erg+=integer_factor(a,hilf);/* monopoly Faktorisierung von q */
2278     while(hilf!=NULL)
2279     {
2280       erg+=zykelind_aff1Zp(S_PO_S(hilf),S_PO_K(hilf),hilf1);
2281       erg+=zykelind_dir_prod_apply(hilf1,b);
2282       hilf=s_l_n(hilf);
2283     }
2284     erg+=freeall(hilf1);
2285     if (erg!=OK) EDC("zykelind_aff1Zn");
2286     return erg;
2287 }
2288 
2289 /* ****************************************************************
2290 
2291 Routines for the computation of the cycle index of the projective
2292 linear groups PGL(k,q).
2293 
2294 ******************************************************************* */
2295 
zykelind_pglkq(k,q,ergeb)2296 INT zykelind_pglkq(k,q,ergeb) OP k,q,ergeb;
2297 /* Berechnet den Zyklenzeiger der projektiven Gruppe PGL(k,F_q) als
2298    Permutationsgruppe von PG(k-1,F_q).
2299 */
2300 {
2301     OP p,null,eins,c,c1,c2,c3,d,hilf,hilf1,zs1,zs2,zs3,zs4,zs5,zs6,v1,v2,v3;
2302     INT i,j,l;
2303     INT erg=OK;
2304     if (S_O_K(k)!=INTEGER) return error(" zykelind_pglkq(k,q,ergeb) k not INTEGER");
2305     if (S_O_K(q)!=INTEGER) return error(" zykelind_pglkq(k,q,ergeb) q not INTEGER");
2306     if (S_I_I(k)<1L) return error(" zykelind_pglkq(k,q,ergeb) k<1");
2307     if (!emptyp(ergeb)) freeself(ergeb);
2308     p=callocobject();
2309     c=callocobject();
2310     c1=callocobject();
2311     c2=callocobject();
2312     c3=callocobject();
2313     d=callocobject();
2314     hilf=callocobject();
2315     hilf1=callocobject();
2316     zs1=callocobject();
2317     zs2=callocobject();
2318     zs3=callocobject();
2319     zs4=callocobject();
2320     zs5=callocobject();
2321     zs6=callocobject();
2322     null=callocobject();
2323     eins=callocobject();
2324     v1=callocobject();
2325     v2=callocobject();
2326     v3=callocobject();
2327     if (charakteristik_bestimmen(q,p)!=OK) return error("in computation of zykelind_pglkq(k,q,ergeb)");
2328     erg+=subexponenten_bestimmen(k,q,v1,v2,v3);
2329     M_I_I(0L,null);
2330     M_I_I(1L,eins);
2331     erg+=m_scalar_polynom(null,ergeb);
2332     first_part_EXPONENT(k,c);
2333     do
2334     {  /*2*/
2335       erg+=m_scalar_polynom(eins,zs1);
2336       for (i=0L;i<S_PA_LI(c);++i)
2337       {  /*3*/
2338         if (S_PA_II(c,i)>0L)
2339         {  /*4*/
2340           M_I_I(i+1L,d);
2341           erg+=m_scalar_polynom(null,zs2);
2342           first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1);
2343           do
2344           { /*5*/
2345         erg+=m_scalar_polynom(eins,zs3);
2346         for (j=0L;j<S_V_LI(c1);++j)
2347         { /*6*/
2348           if (S_V_II(c1,j)!=0L)
2349           { /*7*/
2350             erg+=m_scalar_polynom(null,zs4);
2351             first_part_into_atmost_k_parts(S_V_I(c1,j),S_V_I(S_V_I(v2,i),j),c2);
2352             do
2353             { /*8*/
2354               erg+=m_scalar_polynom(eins,zs5);
2355               for (l=0L;l<S_V_LI(c2);++l)
2356               {  /*9*/
2357             if (S_V_II(c2,l)!=0L)
2358             {  /*10*/
2359               erg+=m_scalar_polynom(null,zs6);
2360               first_part_EXPONENT(S_V_I(c2,l),c3);
2361               do
2362               {  /*11*/
2363                 erg+=zykeltyp_poly_part_pglkq(d,S_V_I(S_V_I(v1,i),j),S_V_I(S_V_I(v3,i),j),c3,p,q,hilf);
2364                 erg+=add_apply(hilf,zs6);
2365               } while (next(c3,c3)); /*11*/
2366               erg+=zykelind_dir_prod_pglkq_apply(q,zs6,zs5);
2367             }  /*10*/
2368               }  /*9*/
2369               erg+=fmultinom_ext(S_V_I(S_V_I(v2,i),j),c2,hilf);
2370               erg+=mult_apply(hilf,zs5); /* Vielleicht hilf in POLY verwandeln?*/
2371               erg+=add_apply(zs5,zs4);
2372               l=next_part_into_atmost_k_parts(c2);
2373             } while(l==1L); /*8*/
2374             erg+=zykelind_dir_prod_pglkq_apply(q,zs4,zs3);
2375           }  /*7*/
2376         }  /*6*/
2377           erg+=add_apply(zs3,zs2);
2378           j=next_unordered_part_into_atmost_k_parts(c1);
2379           } while(j==1L); /*5*/
2380         erg+=zykelind_dir_prod_pglkq_apply(q,zs2,zs1);
2381         }  /*4*/
2382       }  /*3*/
2383     erg+=zykelind_aus_subzykelind(q,zs1,hilf); /* HF130696 */
2384     erg+=add_apply(hilf,ergeb); /* HF130696 */
2385     /*erg+=add_apply(zs1,ergeb);*/ /* HF130696 */
2386     }  /*2*/
2387     while (next(c,c));
2388     erg+=freeall(p); erg+=freeall(c); erg+=freeall(c1);
2389     erg+=freeall(c2); erg+=freeall(c3); erg+=freeall(d);
2390     erg+=freeall(hilf1); erg+=freeall(zs1); erg+=freeall(zs2);
2391     erg+=freeall(zs3); erg+=freeall(zs4); erg+=freeall(zs5);
2392     erg+=freeall(zs6); erg+=freeall(null); erg+=freeall(eins);
2393     erg+=freeall(v1); erg+=freeall(v2); erg+=freeall(v3);
2394     /*erg+=zykelind_aus_subzykelind(q,ergeb,hilf);
2395     erg+=copy(hilf,ergeb);*/ /* HF130696 */
2396     erg+=freeall(hilf);
2397     if (erg!=OK) error(" in computation of zykelind_pglkq(k,q,ergeb) ");
2398     return(erg);
2399 }
2400 
co_zykelind_pglkq(k,q,ergeb)2401 INT co_zykelind_pglkq(k,q,ergeb) OP k,q,ergeb;
2402 /* Berechnet den Zyklenzeiger der projektiven Gruppe PGL(k,F_q) als
2403    Permutationsgruppe von PG(k-1,F_q).
2404 */
2405 {
2406     OP p,null,eins,c,c1,c2,c3,d,hilf,hilf1,zs1,zs2,zs3,zs4,zs5,zs6,v1,v2,v3;
2407     INT i,j,l;
2408     INT erg=OK;
2409     if (S_O_K(k)!=INTEGER) return error(" zykelind_pglkq(k,q,ergeb) k not INTEGER");
2410     if (S_O_K(q)!=INTEGER) return error(" zykelind_pglkq(k,q,ergeb) q not INTEGER");
2411     if (S_I_I(k)<1L) return error(" zykelind_pglkq(k,q,ergeb) k<1");
2412     if (!emptyp(ergeb)) freeself(ergeb);
2413     p=callocobject();
2414     c=callocobject();
2415     c1=callocobject();
2416     c2=callocobject();
2417     c3=callocobject();
2418     d=callocobject();
2419     hilf=callocobject();
2420     hilf1=callocobject();
2421     zs1=callocobject();
2422     zs2=callocobject();
2423     zs3=callocobject();
2424     zs4=callocobject();
2425     zs5=callocobject();
2426     zs6=callocobject();
2427     null=callocobject();
2428     eins=callocobject();
2429     v1=callocobject();
2430     v2=callocobject();
2431     v3=callocobject();
2432     if (charakteristik_bestimmen(q,p)!=OK) return error("in computation of zykelind_pglkq(k,q,ergeb)");
2433     erg+=subexponenten_bestimmen(k,q,v1,v2,v3);
2434     M_I_I(0L,null);
2435     M_I_I(1L,eins);
2436     erg+=m_scalar_polynom(null,ergeb);
2437     /*first_part_EXPONENT(k,c);
2438     do */
2439     m_il_v(S_I_I(k),zs2);
2440     copy(k,S_V_I(zs2,0L));
2441     for (i=1L;i<S_V_LI(zs2);++i) m_i_i(0L,S_V_I(zs2,i));
2442     m_ks_pa(EXPONENT,zs2,c);
2443     println(c);
2444     {  /*2*/
2445       erg+=m_scalar_polynom(eins,zs1);
2446       for (i=0L;i<S_PA_LI(c);++i)
2447       {  /*3*/
2448         if (S_PA_II(c,i)>0L)
2449         {  /*4*/
2450           M_I_I(i+1L,d);
2451           erg+=m_scalar_polynom(null,zs2);
2452           first_unordered_part_into_atmost_k_parts(S_PA_II(c,i),S_V_LI(S_V_I(v1,i)),c1);
2453           do
2454           { /*5*/
2455         erg+=m_scalar_polynom(eins,zs3);
2456         for (j=0L;j<S_V_LI(c1);++j)
2457         { /*6*/
2458           if (S_V_II(c1,j)!=0L)
2459           { /*7*/
2460             erg+=m_scalar_polynom(null,zs4);
2461             first_part_into_atmost_k_parts(S_V_I(c1,j),S_V_I(S_V_I(v2,i),j),c2);
2462             do
2463             { /*8*/
2464               erg+=m_scalar_polynom(eins,zs5);
2465               for (l=0L;l<S_V_LI(c2);++l)
2466               {  /*9*/
2467             if (S_V_II(c2,l)!=0L)
2468             {  /*10*/
2469               erg+=m_scalar_polynom(null,zs6);
2470               first_part_EXPONENT(S_V_I(c2,l),c3);
2471               do
2472               {  /*11*/
2473                 erg+=zykeltyp_poly_part_pglkq(d,S_V_I(S_V_I(v1,i),j),S_V_I(S_V_I(v3,i),j),c3,p,q,hilf);
2474                 erg+=add_apply(hilf,zs6);
2475               } while (next(c3,c3)); /*11*/
2476               erg+=zykelind_dir_prod_pglkq_apply(q,zs6,zs5);
2477             }  /*10*/
2478               }  /*9*/
2479               erg+=fmultinom_ext(S_V_I(S_V_I(v2,i),j),c2,hilf);
2480               erg+=mult_apply(hilf,zs5); /* Vielleicht hilf in POLY verwandeln?*/
2481               erg+=add_apply(zs5,zs4);
2482               l=next_part_into_atmost_k_parts(c2);
2483             } while(l==1L); /*8*/
2484             erg+=zykelind_dir_prod_pglkq_apply(q,zs4,zs3);
2485           }  /*7*/
2486         }  /*6*/
2487           erg+=add_apply(zs3,zs2);
2488           j=next_unordered_part_into_atmost_k_parts(c1);
2489           } while(j==1L); /*5*/
2490         erg+=zykelind_dir_prod_pglkq_apply(q,zs2,zs1);
2491         }  /*4*/
2492       }  /*3*/
2493     erg+=add_apply(zs1,ergeb);
2494     }  /*2*/
2495     /*while (next(c,c));*/
2496     erg+=freeall(p);
2497     erg+=freeall(c);
2498     erg+=freeall(c1);
2499     erg+=freeall(c2);
2500     erg+=freeall(c3);
2501     erg+=freeall(d);
2502     erg+=freeall(hilf1);
2503     erg+=freeall(zs1);
2504     erg+=freeall(zs2);
2505     erg+=freeall(zs3);
2506     erg+=freeall(zs4);
2507     erg+=freeall(zs5);
2508     erg+=freeall(zs6);
2509     erg+=freeall(null);
2510     erg+=freeall(eins);
2511     erg+=freeall(v1);
2512     erg+=freeall(v2);
2513     erg+=freeall(v3);
2514     erg+=zykelind_aus_subzykelind(q,ergeb,hilf);
2515     erg+=copy(hilf,ergeb);
2516     erg+=freeall(hilf);
2517     if (erg!=OK) error(" in computation of zykelind_pglkq(k,q,ergeb) ");
2518     return(erg);
2519 }
2520 
min_pot(a,b,c,d)2521 static INT min_pot(a,b,c,d) OP a,b,c,d;
2522 /* 2 Elemente g1,g2 einer zyklischen Gruppe der Ordnung c seien gegeben als
2523 Potenzen eines erzeugenden Elementes g1=g^a und g2=g^b. Die errechnete Zahl
2524 d ist die Ordnung von g1 g2^(-1). Das heisst: d ist minimal mit der
2525 Eigenschaft, dass g1^d=g2^d.
2526 */
2527 {
2528     OP hilf;
2529     INT erg=OK;
2530     /*if (S_O_K(a)!=INTEGER) return error(" min_pot(a,b,c,d) a not INTEGER");
2531     if (S_O_K(b)!=INTEGER) return error(" min_pot(a,b,c,d) b not INTEGER");
2532     if (S_O_K(c)!=INTEGER) return error(" min_pot(a,b,c,d) c not INTEGER");
2533     if (S_I_I(c)<1L) return error(" min_pot(a,b,c,d) c < 1");*/
2534     if (!emptyp(d)) freeself(d);
2535 
2536     if (EQ(a,b)) { M_I_I(1L,d); goto endr_ende; }
2537 
2538     hilf=callocobject();
2539     erg+=sub(a,b,hilf);
2540     erg+=ggt(hilf,c,hilf);
2541     erg+=ganzdiv(c,hilf,d);
2542     erg+=freeall(hilf);
2543 
2544     ENDR("min_pot");
2545 }
2546 
zykelind_dir_prod_pglkq_apply(q,a,b)2547 static INT zykelind_dir_prod_pglkq_apply(q,a,b) OP q,a,b;
2548 /* Berechnet das direkte Produkt der Subzykeltypen a und b und ersetzt b durch
2549 das errechnete Ergebnis. q=Maechtigkeit des Koerpers.
2550 */
2551 {
2552     OP hilf=callocobject();
2553     OP qq=callocobject();
2554     INT erg=OK;
2555     /*if (S_O_K(q)!=INTEGER) return error(" zykelind_dir_prod_pglkq_apply(q,a,b) q not INTEGER");
2556     if (S_I_I(q)<1L) return error(" zykelind_dir_prod_pglkq_apply(q,a,b) q<1");
2557     if (S_O_K(a)!=POLYNOM) return error(" zykelind_dir_prod_pglkq_apply(q,a,b) a not POLYNOM");
2558     if (S_O_K(b)!=POLYNOM) return error(" zykelind_dir_prod_pglkq_apply(q,a,b) b not POLYNOM");*/
2559     erg+=copy(q,qq);erg+=dec(qq);
2560     erg+=zykelind_dir_prod_pglkq(qq,a,b,hilf);
2561     erg+=copy(hilf,b);
2562     erg+=freeall(hilf);
2563     erg+=freeall(qq);
2564     if (erg!=OK) error("in computation of zykelind_dir_prod_pglkq_apply(q,a,b) ");
2565     return(erg);
2566 }
2567 
zykelind_hoch_dir_prod_pglkq(q,a,c,b)2568 static INT zykelind_hoch_dir_prod_pglkq(q,a,c,b) OP q,a,b,c;
2569 /* Berechnet die c-fache Hintereinanderausfuehrung des direkten Produktes
2570 des Subzykeltyps a mit sich selbst. Das Ergebnis ist c. Der Koerper
2571 enthaelt q Elemente.
2572 */
2573 {
2574     INT erg=OK;
2575     /*if (S_O_K(q)!=INTEGER) return error("zykelind_hoch_dir_prod_pglkq(q,a,c,b)  q not INTEGER");
2576     if (S_O_K(a)!=POLYNOM) return error("zykelind_hoch_dir_prod_pglkq(q,a,c,b) a not POLYNOM");
2577     if (S_O_K(c)!=INTEGER) return error("zykelind_hoch_dir_prod_pglkq(q,a,c,b) c not INTEGER");
2578     if (S_I_I(c)<0L) return error("zykelind_hoch_dir_prod_pglkq(q,a,c,b) c<0");*/
2579     if (not EMPTYP(b)) erg+=freeself(b);
2580     if (nullp(c))
2581        return M_I_I(1L,b);
2582     else if (einsp(c))
2583          return copy(a,b);
2584     else    {
2585             OP qq = callocobject();
2586             OP n = callocobject();
2587             OP d = callocobject();
2588             erg+=copy(q,qq);erg+=dec(qq);
2589             erg+=copy(c,n);
2590             erg+=copy(a,b);
2591             erg+=dec(n);
2592             while (not nullp(n)) {
2593                 erg+=zykelind_dir_prod_pglkq(qq,a,b,d);
2594                 erg+=dec(n);
2595                 erg+=copy(d,b);
2596                 }
2597             erg+=freeall(d);
2598             erg+=freeall(n);
2599             erg+=freeall(qq);
2600         };
2601     if (erg != OK) error(" in computation of zykelind_hoch_dir_prod_pglkq(q,a,c,b) ");
2602     return(erg);
2603 }
2604 
mod_mult(modul,a,b,c)2605 static INT mod_mult(modul,a,b,c) OP modul,a,b,c;
2606 /*  c + a.b mod modul, wobei 1<=c<=modul ist.  */
2607 {
2608     INT erg=OK;
2609     /*if (S_O_K(modul)!=INTEGER) return error(" mod_mult(modul,a,b,c)  modul not INTEGER");
2610     if (S_I_I(modul)<1L) return error(" mod_mult(modul,a,b,c) modul < 1");
2611     if (S_O_K(a)!=INTEGER) return error(" mod_mult(modul,a,b,c)  a not INTEGER");
2612     if (S_O_K(b)!=INTEGER) return error(" mod_mult(modul,a,b,c)  b not INTEGER");*/
2613     if (!emptyp(c)) freeself(c);
2614     erg+=mult(a,b,c);
2615     erg+=mod(c,modul,c);
2616     if (nullp(c)) erg+=add_apply(modul,c);
2617     ENDR("mod_mult");
2618 }
2619 
subexponenten_bestimmen(d,q,a,b,cc)2620 static INT subexponenten_bestimmen(d,q,a,b,cc) OP d,q,a,b,cc;
2621 /* d=maximaler Grad der Polynome, die auftreten koennen
2622    q=Maechtigkeiy des Koerpers
2623    a,b,cc=Vektoren der Laenge d
2624    s_v_i(a,i) ist ein Vektor, der die Subexponenten enthaelt, die bei Polynomen
2625               vom Grad i+1 auftreten koennen
2626    s_v_i(b,i) ist ein Vektor der gleichen Laenge wie s_v_i(a,i), er
2627               enthaelt die Anzahl der normierten, irreduziblen Polynome
2628               vom Grad i+1 zu dem entsprechenden Subexponent
2629    s_v_i(c,i) ist ein Vektor der gleichen Laenge wie s_v_i(a,i), er
2630               enthaelt die entsprechenden integralen Elemente.
2631 */
2632 {
2633     INT i,j,k,l,ii;
2634     OP hilf,hilfv,hilfv1,dd,c,e,f,g,h,speicher,qq,gruppe;
2635     OP ax_e;
2636     INT erg=OK;
2637     hilf=callocobject();
2638     hilfv=callocobject();
2639     hilfv1=callocobject();
2640     gruppe=callocobject();
2641     dd=callocobject();
2642     qq=callocobject();
2643     c=callocobject();
2644     e=callocobject();
2645     f=callocobject();
2646     g=callocobject();
2647     h=callocobject();
2648     speicher=callocobject();
2649     erg+=copy(q,qq);
2650     erg+=dec(qq);
2651     erg+=zyklische_gruppe(qq,gruppe);
2652     init(BINTREE,speicher);
2653     erg+=m_l_v(d,a);
2654     erg+=m_l_v(d,b);
2655     erg+=m_l_v(d,cc);
2656     for (i=0L;i<S_I_I(d);++i)
2657     {
2658       M_I_I(i+1L,dd);
2659       erg+=m_il_v(0L,hilf);
2660       erg+=m_il_v(0L,hilfv);
2661       erg+=m_il_v(0L,hilfv1);
2662       l=0L;
2663       erg+=hoch(q,dd,c);
2664       erg+=dec(c);
2665       erg+=alle_teiler(c,e);
2666       for (j=0L;j<S_V_LI(e);++j)
2667       {
2668         if (einsp(dd) && einsp(S_V_I(e,j)))
2669         {
2670           erg+=inc(hilf);erg+=inc(hilfv);erg+=inc(hilfv1);
2671           erg+=copy(S_V_I(e,j),S_V_I(hilfv,l));
2672           erg+=copy(S_V_I(S_V_I(gruppe,0L),0L),S_V_I(hilfv1,l));
2673           M_I_I(1L,S_V_I(hilf,l));
2674           l=l+1L;
2675           ax_e = callocobject(); erg+=copy(S_V_I(e,j),ax_e);
2676           insert(ax_e,speicher,NULL,NULL);
2677         }
2678         else
2679         {
2680           erg+=euler_phi(S_V_I(e,j),f);
2681           erg+=quores(f,dd,g,h);
2682           if (nullp(h))
2683           {
2684         ax_e = callocobject(); erg+=copy(S_V_I(e,j),ax_e);
2685         if (insert(ax_e,speicher,NULL,NULL)==INSERTOK)
2686         {
2687           erg+=ggt(S_V_I(e,j),qq,h);
2688           erg+=ganzdiv(S_V_I(e,j),h,f);
2689           erg+=euler_phi(h,c);
2690           erg+=ganzdiv(g,c,c);
2691           for (ii=0L;ii<S_V_LI(S_V_I(gruppe,S_I_I(h)-1L));++ii)
2692           {
2693             erg+=inc(hilf);erg+=inc(hilfv);erg+=inc(hilfv1);
2694             erg+=copy(f,S_V_I(hilfv,l));
2695             erg+=copy(c,S_V_I(hilf,l));
2696             erg+=copy(S_V_I(S_V_I(gruppe,S_I_I(h)-1L),ii),S_V_I(hilfv1,l));
2697             ++l;
2698           }
2699         }
2700           }
2701         }
2702       }
2703       /* e=callocobject(); AK 260594 */
2704       erg+=copy(hilfv,S_V_I(a,i));
2705       erg+=copy(hilf,S_V_I(b,i));
2706       erg+=copy(hilfv1,S_V_I(cc,i));
2707     }
2708     erg+=freeall(e);
2709     erg+=freeall(hilf);
2710     erg+=freeall(hilfv);
2711     erg+=freeall(hilfv1);
2712     erg+=freeall(dd);
2713     erg+=freeall(qq);
2714     erg+=freeall(c);
2715     erg+=freeall(f);
2716     erg+=freeall(g);
2717     erg+=freeall(h);
2718     erg+=freeall(gruppe);
2719     erg+=freeall(speicher);
2720     ENDR("subexponenten_bestimmen");
2721 }
2722 
zyklische_gruppe(a,b)2723 static INT zyklische_gruppe(a,b) OP a,b;
2724 /* a ist die Ordnung der zyklischen Gruppe (ein INTEGER-Objekt)
2725    die Elemente von der Gruppe sind dann die Integer-Objekte 1,2,...,a
2726    b ist ein Vektor der Laenge a
2727    s_v_i(b,i) ist ein Vektor der alle Elemente der Gruppe besitzt, deren
2728               Ordnung i+1 ist
2729    die Ordnung von dem Element i berechnet man als a/ggt(a,i)
2730 */
2731 {
2732     OP index,hilf,hilf1;
2733     INT i;
2734     INT erg=OK;
2735     if (S_O_K(a)!=INTEGER) return error("zyklische_gruppe(a,b) a not INTEGER");
2736     if (S_I_I(a)<1L) return error("zyklische_gruppe(a,b) a <1");
2737 
2738     FREESELF(b);
2739     CALLOCOBJECT3(index,hilf,hilf1);
2740     erg+=m_l_v(a,b);
2741     for (i=0L;i<S_V_LI(b);++i)
2742         erg+=m_il_v(0L,S_V_I(b,i));
2743     M_I_I(1L,index);
2744     while(le(index,a))
2745     {
2746         erg+=ggt(index,a,hilf);
2747         erg+=ganzdiv(a,hilf,hilf);
2748         i=S_I_I(hilf)-1L;
2749         INC(S_V_I(b,i));
2750         erg+=copy(index,S_V_I(S_V_I(b,i),S_V_LI(S_V_I(b,i))-1L));
2751         INC(index);
2752     }
2753     FREEALL3(index,hilf,hilf1);
2754     ENDR("zyklische_gruppe");
2755 }
2756 
zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb)2757 static INT zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb) OP d,exp,ew,mu,p,q,ergeb;
2758 /* d   = Grad des Polynoms
2759    exp = Subexponent des Polynoms
2760    ew  = integrales Element des Polynoms
2761    mu  = Partition
2762    p   = Charakteristik
2763    q   = Maechtigkeit des Koerpers
2764    ergeb = Ergebnis
2765 */
2766 {
2767     INT i;
2768     OP hilf,hilf1;
2769     INT erg=OK;
2770     /*if (S_O_K(d)!=INTEGER) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb)  d not INTEGER");
2771     if (S_O_K(exp)!=INTEGER) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb) exp  not INTEGER");
2772     if (S_O_K(ew)!=INTEGER) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb) ew not INTEGER");
2773     if (S_O_K(p)!=INTEGER) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb)  p not INTEGER");
2774     if (S_O_K(q)!=INTEGER) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb)  q not INTEGER");
2775     if (S_O_K(mu)!=PARTITION) return error("zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb) mu not PARTITION");*/
2776     if (!emptyp(ergeb)) erg+=freeself(ergeb);
2777     hilf=callocobject();
2778     hilf1=callocobject();
2779     M_I_I(1L,hilf);
2780     erg+=m_scalar_polynom(hilf,ergeb);
2781     for (i=0L;i<S_PA_LI(mu);++i)
2782     {
2783       if (S_PA_II(mu,i)!=0L)
2784       {
2785         erg+=zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i+1L,p,q,hilf);
2786         erg+=zykelind_hoch_dir_prod_pglkq(q,hilf,S_PA_I(mu,i),hilf1);
2787         erg+=zykelind_dir_prod_pglkq_apply(q,hilf1,ergeb);
2788       }
2789     }
2790     erg+=kung_formel(d,mu,q,hilf);
2791     erg+=invers_apply(hilf);
2792     erg+=mult_apply(hilf,ergeb);
2793     erg+=freeall(hilf);
2794     erg+=freeall(hilf1);
2795     if (erg!=OK) error(" in computation of zykeltyp_poly_part_pglkq(d,exp,ew,mu,p,q,ergeb) ");
2796     return(erg);
2797 }
2798 
zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb)2799 static INT zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb)
2800     OP d,exp,ew,p,q,ergeb;
2801     INT i;
2802 /* Berechnet den Subzykeltyp einer Hyperbegleitmatrix eines irreduziblen,
2803 normierten Polynoms vom Grad d, Subexponenten exp, integralem Element ew,
2804 wobei i mal die Begleutmatrix des Polynoms in der Hyperbegleitmatrix
2805 erscheint, p=Charakteristik des Koerpers, der aus q Elementen besteht.
2806 */
2807 {
2808     OP e,hilf,hilf1,hilf2,hilftyp,qq,hilfpoly;
2809     INT j,k;
2810     INT erg=OK;
2811     /*if (S_O_K(d)!=INTEGER) return error("zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb)  d not INTEGER");
2812     if (S_O_K(exp)!=INTEGER) return error("zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb) exp  not INTEGER");
2813     if (S_O_K(ew)!=INTEGER) return error("zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb) ew not INTEGER");
2814     if (S_O_K(p)!=INTEGER) return error("zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb)  p not INTEGER");
2815     if (S_O_K(q)!=INTEGER) return error("zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb)  q not INTEGER");*/
2816     if (!emptyp(ergeb)) freeself(ergeb);
2817     e=callocobject();
2818     qq=callocobject();
2819     hilf=callocobject();
2820     hilf1=callocobject();
2821     hilf2=callocobject();
2822     hilftyp=callocobject();
2823     hilfpoly=callocobject();
2824     erg+=copy(q,qq);erg+=dec(qq);
2825     erg+=m_il_v(i,e);
2826     erg+=copy(exp,S_V_I(e,0L));
2827     erg+=m_il_v(3L,hilftyp);
2828     M_I_I(1L,hilf);
2829     erg+=m_scalar_polynom(hilf,ergeb);
2830     k=1L;
2831     for (j=1L;j<i;++j)
2832     {
2833       erg+=copy(S_V_I(e,j-1L),S_V_I(e,j));
2834       if (k<j+1L)
2835       {
2836         k=k*S_I_I(p);
2837         erg+=mult_apply(p,S_V_I(e,j));
2838       }
2839     }
2840     erg+=hoch(q,d,hilf);
2841     erg+=copy(hilf,hilf1);
2842     erg+=dec(hilf1);
2843     erg+=ganzdiv(hilf1,exp,hilf2);
2844     erg+=copy(hilf2,S_V_I(hilftyp,2L));
2845     erg+=copy(exp,S_V_I(hilftyp,0L));
2846     erg+=copy(ew,S_V_I(hilftyp,1L));
2847     erg+=vek_to_monom(qq,hilftyp,hilfpoly);
2848     erg+=mult_apply(hilfpoly,ergeb);
2849     for (j=1L;j<i;++j)
2850     {
2851       erg+=mult_apply(hilf,hilf1);
2852       erg+=ganzdiv(hilf1,S_V_I(e,j),hilf2);
2853       erg+=copy(hilf2,S_V_I(hilftyp,2L));
2854       erg+=copy(S_V_I(e,j),S_V_I(hilftyp,0L));
2855       erg+=ganzdiv(S_V_I(e,j),exp,hilf2);
2856       erg+=mod_mult(qq,ew,hilf2,S_V_I(hilftyp,1L));
2857       erg+=vek_to_monom(qq,hilftyp,hilfpoly);
2858       erg+=mult_apply(hilfpoly,ergeb);
2859     }
2860     erg+=freeall(e);
2861     erg+=freeall(qq);
2862     erg+=freeall(hilf);
2863     erg+=freeall(hilf1);
2864     erg+=freeall(hilf2);
2865     erg+=freeall(hilftyp);
2866     erg+=freeall(hilfpoly);
2867     if (erg!=OK) error(" in computation of zykeltyp_hyperbegleitmatrix_poly_pglkq(d,exp,ew,i,p,q,ergeb) ");
2868     return(erg);
2869 }
2870 
zykelind_aus_subzykelind(q,a,b)2871 static INT zykelind_aus_subzykelind(q,a,b) OP q,a,b;
2872 /* Berechnet den Zyklenzeiger von PGL(k,F_q) aus dem Subzyklenzeiger
2873    von GL(k,F_q) auf F_q^k\{0}.
2874 */
2875 {
2876 	    INT i,j;
2877 	    INT erg=OK;
2878 	OP qq,hilf,hilfpoly,hmonom,hvekt;
2879     OP monom;
2880     if (S_O_K(q)!=INTEGER) return error(" zykelind_aus_subzykelind(q,a,b)  q not INTEGER");
2881     if (S_O_K(a)!=POLYNOM) return error(" zykelind_aus_subzykelind(q,a,b)  a not POLYNOM");
2882 	CALLOCOBJECT5(qq,hilf,hilfpoly,hmonom,hvekt);
2883     if (!emptyp(b)) freeself(b);
2884     M_I_I(0L,qq);
2885     erg+=m_scalar_polynom(qq,b);
2886     erg+=copy(q,qq);
2887 	erg+=dec(qq);
2888     monom=a;
2889     while (monom!=NULL)
2890     {
2891       erg+=monom_to_vek(qq,monom,hvekt);
2892       erg+=m_scalar_polynom(S_PO_K(monom),hilfpoly);
2893         for (j=0L;j<S_V_LI(hvekt);++j)
2894         {
2895             erg+=m_iindex_iexponent_monom(s_v_ii(S_V_I(hvekt,j),0L)-1L,s_v_ii(S_V_I(hvekt,j),2L),hmonom); /* HF130696 */
2896             erg+=mult_apply(hmonom,hilfpoly);
2897         }
2898         for (j=0L;j<S_V_LI(S_PO_S(hilfpoly));++j)
2899         {
2900 /*
2901             erg+=ganzdiv(S_PO_SI(hilfpoly,j),qq,hilf);
2902             erg+=copy(hilf,S_PO_SI(hilfpoly,j));
2903 */
2904             GANZDIV_APPLY(S_PO_SI(hilfpoly,j),qq);
2905         }
2906     ADD_APPLY(hilfpoly,b);
2907     monom=S_PO_N(monom);
2908     }
2909 	FREEALL5(qq,hilf,hilfpoly,hmonom,hvekt);
2910 	ENDR("zykelind_aus_subzykelind");
2911 }
2912 
zykelind_dir_prod_pglkq(q,a,b,c)2913 static INT zykelind_dir_prod_pglkq(q,a,b,c)
2914 /* Berechnet aus den Subzykelindizes a und b einen
2915    weiteren Subzykelindex c. Es operiere G auf X und H
2916    auf Y dann operiert  G\times H auf X\times Y.
2917    q ist die Anzahl der Elemente im Koerper minus 1.  */
2918     OP a,b,c,q;
2919 {
2920     OP monom1,monom2,monom3,monom4,avek,bvek,neu;
2921     OP hilf,hilf0,hilf1,hilf2,hilf3,hilf4;
2922     INT i1,i2;
2923     INT erg=OK;
2924     if (S_O_K(q)!=INTEGER) return error("zykelind_dir_prod_pglkq(q,a,b,c)  q not INTEGER");
2925     if (S_O_K(a)!=POLYNOM) return error("zykelind_dir_prod_pglkq(q,a,b,c)  a not POLYNOM");
2926     if (S_O_K(b)!=POLYNOM) return error("zykelind_dir_prod_pglkq(q,a,b,c)  b not POLYNOM");
2927     if (not EMPTYP(c)) erg+=freeself(c);
2928     if (einsp(a)) return copy(b,c);
2929     else if (einsp(b)) return copy(a,c);
2930 
2931     hilf=callocobject();hilf0=callocobject();hilf1=callocobject();
2932     hilf2=callocobject();hilf3=callocobject();hilf4=callocobject();
2933     monom3=callocobject();
2934     monom4=callocobject();
2935     avek=callocobject();bvek=callocobject();
2936     neu=callocobject();
2937     erg+=m_il_v(3L,neu);
2938     M_I_I(0L,hilf);
2939     erg+=m_scalar_polynom(hilf,c);
2940     monom1=a;
2941     while (monom1!=NULL)
2942     {
2943       erg+=monom_to_vek(q,monom1,avek);
2944       monom2=b;
2945       while (monom2!=NULL)
2946       {
2947         erg+=monom_to_vek(q,monom2,bvek);
2948         erg+=m_skn_po(S_PO_S(monom1),S_PO_K(monom1),NULL,monom3);
2949         erg+=m_skn_po(S_PO_S(monom2),S_PO_K(monom2),NULL,monom4);
2950         erg+=mult_apply(monom4,monom3);
2951         for (i1=0L;i1<S_V_LI(avek);++i1)
2952         {
2953         for (i2=0L;i2<S_V_LI(bvek);++i2)
2954         {
2955             erg+=copy(S_V_I(avek,i1),hilf1);
2956             erg+=copy(S_V_I(bvek,i2),hilf2);
2957             erg+=kgv(S_V_I(hilf1,0L),S_V_I(hilf2,0L),hilf);
2958             erg+=ganzdiv(hilf,S_V_I(hilf1,0L),hilf3);
2959             erg+=mod_mult(q,S_V_I(hilf1,1L),hilf3,hilf4);
2960             erg+=copy(hilf4,S_V_I(hilf1,1L));
2961             erg+=ganzdiv(hilf,S_V_I(hilf2,0L),hilf3);
2962             erg+=mod_mult(q,S_V_I(hilf2,1L),hilf3,hilf4);
2963             erg+=copy(hilf4,S_V_I(hilf2,1L));
2964             erg+=min_pot(S_V_I(hilf1,1L),S_V_I(hilf2,1L),q,hilf0);
2965             erg+=mod_mult(q,hilf0,S_V_I(hilf1,1L),S_V_I(neu,1L));
2966             erg+=mult_apply(hilf0,hilf);
2967             erg+=copy(hilf,S_V_I(neu,0L));
2968             erg+=mult(S_V_I(hilf1,2L),S_V_I(hilf2,2L),hilf);
2969             erg+=mult_apply(S_V_I(hilf1,0L),hilf);
2970             erg+=mult_apply(S_V_I(hilf2,0L),hilf);
2971             erg+=ganzdiv(hilf,S_V_I(neu,0L),hilf);
2972             erg+=copy(hilf,S_V_I(neu,2L));
2973             erg+=vek_to_monom(q,neu,monom4);
2974             erg+=mult_apply(monom4,monom3);
2975         }
2976         }
2977         monom2=S_PO_N(monom2);
2978         /*if (S_O_K(S_PO_S(monom3))==INTEGERVECTOR)  C_O_K(S_PO_S(monom3),VECTOR);*/
2979         erg+=add(c,monom3,c);
2980       }
2981       monom1=S_PO_N(monom1);
2982     }
2983     erg+=freeall(hilf);
2984     erg+=freeall(hilf0);
2985     erg+=freeall(hilf1);
2986     erg+=freeall(hilf2);
2987     erg+=freeall(hilf3);
2988     erg+=freeall(hilf4);
2989     erg+=freeall(monom3);
2990     erg+=freeall(monom4);
2991     freeall(neu);
2992     freeall(avek);
2993     freeall(bvek);
2994     ENDR("zykelind_dir_prod_pglkq");
2995 }
2996 
monom_to_vek(q,a,b)2997 static INT monom_to_vek(q,a,b) OP a,b,q;
2998 /* Bestimmt aus dem Subzykeltyp a (einem Polynom Objekt) einen
2999 Vektor b, der Subzykellaenge und integrales Element von jedem Zykel
3000 beinhaltet. Ein Zykel wird dann durch ein Tripel dargestellt:
3001 1. Komponente: Subzykellaenge
3002 2. Komponente: integrales Element
3003 3. Komponente: vielfachheit des Subzykels
3004 q ist die um 1 verringerte Anzahl der Koerperelemente */
3005 {
3006     INT i;
3007     INT erg=OK;
3008     OP typ,hilf;
3009     typ=callocobject();
3010     hilf=callocobject();
3011     m_il_v(3L,typ);
3012     m_il_v(0L,b);
3013     for (i=0L;i<S_V_LI(S_PO_S(a));++i)
3014     {
3015         if (!nullp(S_V_I(S_PO_S(a),i)))
3016         {
3017           M_I_I(i,hilf);
3018           erg+=quores(hilf,q,S_V_I(typ,0L),S_V_I(typ,1L));
3019           erg+=inc(S_V_I(typ,0L));
3020           erg+=inc(S_V_I(typ,1L));
3021           erg+=copy(S_V_I(S_PO_S(a),i),S_V_I(typ,2L));
3022           erg+=inc(b);
3023           erg+=copy(typ,S_V_I(b,S_V_LI(b)-1L));
3024         }
3025     }
3026     erg+=freeall(typ);erg+=freeall(hilf);
3027     ENDR("monom_to_vek");
3028 }
3029 
vek_to_monom(q,a,b)3030 static INT vek_to_monom(q,a,b) OP a,b,q;
3031 /* Umkehrung obiger Transformation.
3032    a ist ein Tripel, das den Subzykeltyp enthaelt.
3033    b ist ein MONOM
3034    q ist |F_q|-1
3035 */
3036 {
3037     OP aa,bb;
3038     INT erg=OK;
3039     aa=callocobject();bb=callocobject();
3040     erg+=copy(S_V_I(a,0L),aa);
3041     erg+=dec(aa);
3042     erg+=copy(S_V_I(a,1L),bb);
3043     erg+=dec(bb);
3044     erg+=mult_apply(q,aa);
3045     erg+=add_apply(bb,aa);
3046     erg+=m_iindex_iexponent_monom(s_i_i(aa),s_v_ii(a,2L),b); /* HF130696 */
3047     erg+=freeall(aa);erg+=freeall(bb);
3048     ENDR("vek_to_monom");
3049 }
3050 
3051 /* ***************************************************************
3052 
3053 Some SYMMETRICA routine to compute enumeration formulae of
3054 N.G. de Bruijn.
3055 
3056 ****************************************************************** */
3057 
debruijn_all_functions(a,b,c)3058 INT debruijn_all_functions(a,b,c) OP a,b,c;
3059 /* a und b sind Zyklenzeiger, a gehoert zu einer Gruppenaktion auf dem
3060 Definitionsbereich X, b zu einer auf dem Bildbereich Y. c ist die Anzahl
3061 der Orbiten von Funktionen bezueglich der Gruppeneaktion des direkten
3062 Produktes der zwei Gruppen auf der Menge aller Funktionen von X nach Y.
3063 */
3064 {
3065     INT erg=OK;
3066     OP hilf,hilf1,hilf2,hilfmonom,vek;
3067     INT i,j,k;
3068     hilf=callocobject();
3069     hilf1=callocobject();
3070     hilf2=callocobject();
3071     vek=callocobject();
3072     if (!emptyp(c)) erg+=freeself(c);
3073     erg+=numberofvariables(a,hilf);
3074     erg+=m_l_v(hilf,vek);
3075     M_I_I(0L,c);
3076     hilfmonom=b;
3077     while (hilfmonom!=NULL)
3078     {
3079       /*if (S_O_K(S_PO_S(hilfmonom))==INTEGERVECTOR) C_O_K(S_PO_S(hilfmonom),VECTOR);*/
3080       for (i=0L;i<S_V_LI(vek);++i)
3081       {
3082         erg+=m_i_i(i+1L,hilf);
3083         erg+=alle_teiler(hilf,hilf1);
3084         erg+=m_i_i(0L,hilf2);
3085         for (j=0L;j<S_V_LI(hilf1);++j)
3086         {
3087           if (S_V_II(hilf1,j)<=S_V_LI(S_PO_S(hilfmonom)))
3088           {
3089         erg+=mult(S_V_I(hilf1,j),S_PO_SI(hilfmonom,S_V_II(hilf1,j)-1L),hilf);
3090         erg+=add_apply(hilf,hilf2);
3091           }
3092         }
3093         erg+=copy(hilf2,S_V_I(vek,i));
3094       }
3095       erg+=eval_polynom(a,vek,hilf);
3096       erg+=mult_apply(S_PO_K(hilfmonom),hilf);
3097       erg+=add_apply(hilf,c);
3098       hilfmonom=S_PO_N(hilfmonom);
3099     }
3100     erg+=freeall(hilf); erg+=freeall(hilf1); erg+=freeall(hilf2);
3101     erg+=freeall(vek);
3102     if (erg!=OK) EDC("debruijn_all_functions");
3103     return erg;
3104 }
3105 
zykelind_red(a,c,b)3106 static INT zykelind_red(a,c,b) OP a,b,c;
3107 /* Je nachdem ob die Summe \sum_i i typ_i gleich c ist oder nicht
3108 werden die entsprechenden Monome des Zyklenzeigers a derern Typ
3109 typ ist zu b zusammengefasst oder nicht.*/
3110 {
3111     OP hilfm,hilf,hilf1;
3112     INT erg=OK;
3113     hilf=callocobject();
3114     hilf1=callocobject();
3115     M_I_I(0L,hilf);
3116     erg+=m_scalar_polynom(hilf,b);
3117     hilfm=a;
3118     while (hilfm!=NULL)
3119     {
3120       /*if (S_O_K(S_PO_S(hilfm))==INTEGERVECTOR) C_O_K(S_PO_S(hilfm),VECTOR);*/
3121       erg+=sum_vector11(S_PO_S(hilfm),hilf,c);
3122       if (eq(hilf,c))
3123       {
3124         erg+=copy(S_PO_S(hilfm),hilf);
3125         erg+=m_skn_po(hilf,S_PO_K(hilfm),NULL,hilf1);
3126         erg+=add_apply(hilf1,b);
3127       }
3128       hilfm=S_PO_N(hilfm);
3129     }
3130     erg+=freeall(hilf1);
3131     erg+=freeall(hilf);
3132     if (erg!=OK) error(" in computation of zykelind_red(a,c,b)");
3133     return(erg);
3134 }
3135 
zykelind_red_apply(a,c)3136 static INT zykelind_red_apply(a,c) OP a,c;
3137 {
3138     OP hilf;
3139     INT erg=OK;
3140     hilf=callocobject();
3141     erg+=zykelind_red(a,c,hilf);
3142     erg+=copy(hilf,a);
3143     erg+=freeall(hilf);
3144     if (erg!=OK) error(" in computation of zykelind_red_apply(a,c)");
3145     return(erg);
3146 }
3147 
debruijn_inj_functions(a,b,c)3148 INT debruijn_inj_functions(a,b,c) OP a,b,c;
3149 {
3150     OP d,hilfmonom,hilf;
3151     INT erg=OK;
3152     d=callocobject();
3153     hilf=callocobject();
3154     if (!emptyp(c)) freeself(c);
3155     M_I_I(0L,c);
3156     erg+=numberofvariables(a,hilf);
3157     erg+=polya2_sub(b,hilf,d);
3158     hilfmonom=a;
3159     /*if (S_O_K(S_PO_S(hilfmonom))==INTEGERVECTOR) C_O_K(S_PO_S(hilfmonom),VECTOR);*/
3160     erg+=sum_vector1(S_PO_S(hilfmonom),hilf);
3161     erg+=zykelind_red_apply(d,hilf);
3162     while (hilfmonom!=NULL)
3163     {
3164       /*if (S_O_K(S_PO_S(hilfmonom))==INTEGERVECTOR) C_O_K(S_PO_S(hilfmonom),VECTOR);*/
3165       erg+=debruijn_formel(S_PO_S(hilfmonom),d,hilf);
3166       erg+=mult_apply(S_PO_K(hilfmonom),hilf);
3167       erg+=add_apply(hilf,c);
3168       hilfmonom=S_PO_N(hilfmonom);
3169     }
3170     erg+=freeall(hilf);
3171     erg+=freeall(d);
3172     if (erg!=OK) error("in computation of debruijn_inj_functions(a,b,c)");
3173     return(erg);
3174 }
3175 
debruijn_formel(a,b,c)3176 static INT debruijn_formel(a,b,c) OP a,b,c;
3177 {
3178     OP hilfm,hilf;
3179     INT i;
3180     INT erg=OK;
3181     hilf=callocobject();
3182     if (!emptyp(c)) freeself(c);
3183     hilfm=b;
3184     while (hilfm!=NULL)
3185     {
3186       /*if (S_O_K(S_PO_S(hilfm))==INTEGERVECTOR) C_O_K(S_PO_S(hilfm),VECTOR);*/
3187       if (comp_vector1(a,S_PO_S(hilfm))==0L)
3188       {
3189         M_I_I(1L,c);
3190         for (i=0L;i<S_V_LI(a);++i)
3191         if (S_V_II(a,i)>1L)
3192         {
3193           erg+=fakul(S_V_I(a,i),hilf);
3194           erg+=mult_apply(hilf,c);
3195         }
3196       erg+=mult_apply(S_PO_K(hilfm),c);
3197       erg+=freeall(hilf);
3198       if (erg!=OK) error("in computation of debruijn_formel(a,b,c)");
3199       return(erg);
3200       }
3201       hilfm=S_PO_N(hilfm);
3202     }
3203     M_I_I(0L,c);
3204     freeall(hilf);
3205     if (erg!=OK) error("in computation of debruijn_formel(a,b,c)");
3206     return(erg);
3207 }
3208 
sum_vector11(vecobj,ergebnis,gr)3209 static INT sum_vector11(vecobj,ergebnis,gr) OP vecobj,ergebnis,gr;
3210 /* berechnet die Summe
3211 $\sum_{i=0L}^{s_v_li(vecobj)-1L} (i+1)*s_v_i(vecobj,i)$  falls diese kleiner
3212 als gr bleibt, ansonsten gibt sie die erste Teilsumme groesser als gr
3213 aus.  */
3214 {
3215     INT i;
3216     INT erg = OK;
3217     OP hilf=callocobject();
3218     if ((S_O_K(vecobj)!=VECTOR)&&(S_O_K(vecobj)!=INTEGERVECTOR))
3219     return error("sum_vector11(vecobj,ergebnis)  vecobj not VECTOR");
3220     if (!emptyp(ergebnis)) erg+=freeself(ergebnis);
3221     M_I_I(0L,ergebnis);
3222     for (    i=0L; i < S_V_LI(vecobj);i++)
3223         {
3224         erg+=m_i_i(i+1L,hilf);
3225         erg+=mult_apply(S_V_I(vecobj,i),hilf);
3226         erg += add_apply(hilf , ergebnis);
3227         if (gt(ergebnis,gr))
3228         {
3229           erg+=freeall(hilf);
3230           if (erg!=OK) error(" in computation of sum_vector11(vecobj,ergebnis) ");
3231           return(erg);
3232         }
3233         }
3234     erg+=freeall(hilf);
3235     if (erg!=OK) error(" in computation of sum_vector11(vecobj,ergebnis) ");
3236     return erg;
3237 }
3238 
sum_vector1(vecobj,ergebnis)3239 static INT sum_vector1(vecobj,ergebnis) OP vecobj,ergebnis;
3240 /* berechnet die Summe
3241 $\sum_{i=0L}^{s_v_li(vecobj)-1L} (i+1)*s_v_i(vecobj,i)$  */
3242 {
3243     INT i;
3244     INT erg = OK;
3245     OP hilf=callocobject();
3246     if ((S_O_K(vecobj)!=VECTOR)&&(S_O_K(vecobj)!=INTEGERVECTOR))
3247     return error("sum_vector1(vecobj,ergebnis)  vecobj not VECTOR");
3248     if (!emptyp(ergebnis)) erg+=freeself(ergebnis);
3249     M_I_I(0L,ergebnis);
3250     for (    i=0L; i < S_V_LI(vecobj);i++)
3251         {
3252         erg+=m_i_i(i+1L,hilf);
3253         erg+=mult_apply(S_V_I(vecobj,i),hilf);
3254         erg += add_apply(hilf , ergebnis);
3255         }
3256     if (erg!=OK) error(" in computation of sum_vector1(vecobj,ergebnis) ");
3257     return erg;
3258 }
3259 
stirling_numbers_second_kind_vector(a,b)3260 INT stirling_numbers_second_kind_vector(a,b) OP a,b;
3261 /* a INTEGER object ,
3262    the result b is a VECTOR object of length a+1
3263    with entry s_v_i(i,b) =  2. Stirl. number S(a,i)
3264 */
3265 /* HF 1994 */
3266 /* AK 200704 V3.0 */
3267 {
3268     INT erg=OK;
3269     CTO(INTEGER,"stirling_numbers_second_kind_vector(1)",a);
3270     SYMCHECK(S_I_I(a)<0,"stirling_numbers_second_kind_vector:parameter <0");
3271     {
3272     if (NULLP_INTEGER(a))
3273         {
3274         erg += m_o_v(cons_null,b);
3275         }
3276     else
3277         {
3278         OP bb,c,d,e,f;
3279         INT i,j;
3280         CALLOCOBJECT5(bb,c,d,e,f);
3281         M_I_I(0L,f);
3282         erg+=m_il_v(S_I_I(a)+1L,b);
3283         M_I_I(0L,S_V_I(b,0L));
3284         i=0L;
3285         erg+=m_iindex_iexponent_monom(0L,s_i_i(a),d);
3286         for (j=1;j<=S_I_I(a);j++)
3287           {
3288           M_I_I(j,c);
3289           erg+=zykelind_Sn(c,bb);
3290           erg+=debruijn_all_functions(d,bb,e);
3291           erg+=sub(e,f,S_V_I(b,j));
3292           CLEVER_COPY(e,f);
3293           }
3294         FREEALL5(bb,c,d,e,f);
3295         }
3296     }
3297     ENDR("stirling_numbers_second_kind_vector");
3298 }
3299 
polya1_sub(a,c,b)3300 INT polya1_sub(a,c,b) OP a,b,c;
3301 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
3302 /* b wird ergebnis x_i ----> 1 + 2 q^i */
3303 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */
3304 {
3305     OP d,e,f,g;
3306     INT i;
3307     INT erg=OK;
3308     if (S_O_K(a)!=POLYNOM) return error("polya1_sub(a,c,b) a not POLYNOM");
3309     if (S_O_K(c)!=INTEGER) return error("polya1_sub(a,c,b) c not INTEGER");
3310     if (not EMPTYP(b)) erg+=freeself(b);
3311     d=callocobject();
3312     e=callocobject();
3313     f=callocobject();
3314     g=callocobject();
3315     M_I_I(1L,d);
3316     erg += m_scalar_polynom(d,e);
3317     M_I_I(2L,d);
3318     erg += m_il_v(1L,f);
3319     M_I_I(1L,s_v_i(f,0L));
3320     erg+=m_skn_po(f,d,NULL,g);
3321     erg += m_il_v(S_I_I(c),d);
3322     for (i=0L;i<S_V_LI(d);i++)
3323     {
3324       erg += add(e,g,f); erg+=copy(f,S_V_I(d,i));
3325       erg += inc(s_v_i(S_PO_S(g),0L));
3326     }
3327     erg += eval_polynom(a,d,b);
3328     erg += freeall(d);
3329     erg += freeall(e);
3330     erg += freeall(f);
3331     erg += freeall(g);
3332     if (erg != OK) return error("polya1_sub: error during computation");
3333     return erg;
3334 }
3335 
polya2_sub(a,c,b)3336 INT polya2_sub(a,c,b) OP a,b,c;
3337 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
3338 /* b wird ergebnis x_i ----> 1 + i q^i */
3339 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */
3340 {
3341     OP d,e,f,g;
3342     INT i;
3343     INT erg=OK;
3344     if (S_O_K(a)!=POLYNOM) return error("polya2_sub(a,c,b) a not POLYNOM");
3345     if (S_O_K(c)!=INTEGER) return error("polya2_sub(a,c,b) c not INTEGER");
3346     if (not EMPTYP(b)) erg+=freeself(b);
3347     d=callocobject();
3348     e=callocobject();
3349     f=callocobject();
3350     g=callocobject();
3351     M_I_I(1L,d);
3352     erg += m_scalar_polynom(d,e);
3353     /*M_I_I(2L,d);*/
3354     erg += m_il_v(1L,f);
3355     M_I_I(1L,s_v_i(f,0L));
3356     erg+=m_skn_po(f,d,NULL,g);
3357     erg += m_il_v(S_I_I(c),d);
3358     for (i=0L;i<S_V_LI(d);i++)
3359         {
3360         erg += add(e,g,f); erg+=copy(f,S_V_I(d,i));
3361         inc(s_po_s(g)); m_i_i(0L,S_PO_SI(g,i));
3362         m_i_i(1L,S_PO_SI(g,i+1L));
3363         /*erg += inc(S_V_I(S_PO_S(g),0L));*/
3364         erg += inc(S_PO_K(g));
3365         }
3366         numberofvariables(a,f);
3367     while (gt(f,c))
3368     {
3369           inc(c);inc(d);copy(e,s_v_i(d,s_v_li(d)-1L));
3370     }
3371     erg += eval_polynom(a,d,b);
3372     erg += freeall(d);
3373     erg += freeall(e);
3374     erg += freeall(f);
3375     erg += freeall(g);
3376     if (erg != OK)
3377         return error("polya2_sub: error during computation");
3378     return erg;
3379 }
3380 
polya3_sub(a,c,dd,b)3381 INT polya3_sub(a,c,dd,b) OP a,b,c,dd;
3382 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
3383 /* b wird ergebnis x_i ----> 1 + q^i + q^2i + q^3i + ... */
3384 /* dd ist die hoechste Potenz von q die eingesetzt werden kann  */
3385 /* das Ergebnis stimmt nur bis zu der Potenz q^dd   */
3386 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 7.6.94 */
3387 {
3388     OP d,e,f,g,h;
3389     INT i;
3390     INT erg=OK;
3391     if (S_O_K(a)!=POLYNOM) return error("polya3_sub(a,c,b) a not POLYNOM");
3392     if (S_O_K(c)!=INTEGER) return error("polya3_sub(a,c,b) c not INTEGER");
3393     if (not EMPTYP(b)) erg+=freeself(b);
3394     d=callocobject();
3395     e=callocobject();
3396     f=callocobject();
3397     g=callocobject();
3398     h=callocobject();
3399     M_I_I(1L,d);
3400     erg += m_scalar_polynom(d,e);
3401     erg += m_il_v(1L,f);
3402     M_I_I(1L,s_v_i(f,0L));
3403     erg+=m_skn_po(f,d,NULL,g);
3404     erg += m_il_v(S_I_I(c),d);
3405     for (i=0L;i<S_V_LI(d);i++)
3406         {
3407         erg += add(e,g,f);
3408         mult(g,g,h);
3409         while (le(S_PO_SI(h,0L),dd))
3410         {
3411                     add_apply(h,f);
3412             mult_apply(g,h);
3413         }
3414         erg+=copy(f,S_V_I(d,i));
3415         inc(S_PO_SI(g,0L));
3416         }
3417     erg += eval_polynom(a,d,b);
3418     erg += freeall(d);
3419     erg += freeall(e);
3420     erg += freeall(h);
3421     erg += freeall(f);
3422     erg += freeall(g);
3423     if (erg != OK)
3424         return error("polya3_sub: error during computation");
3425     return erg;
3426 }
3427 
polya_const_sub(a,b,c)3428 INT polya_const_sub(a,b,c) OP a,b,c;
3429 /* a ist ein Zyklenzeiger (also ein Polynom Objekt).
3430 b ist ein Integer Objekt. Jede Unbestimmte in a wird durch b ersetzt.
3431 c ist das Ergebnis nach dieser Substitution.  */
3432 {
3433     OP lan,vekt;
3434     INT erg=OK;
3435     INT i;
3436     if (S_O_K(a)!=POLYNOM) return error("polya_const_sub(a,b,c) a not POLYNOM");
3437     if (S_O_K(b)!=INTEGER) return error("polya_const_sub(a,b,c) b not INTEGER");
3438     if (not EMPTYP(c)) erg+=freeself(c);
3439     lan = callocobject();
3440     vekt= callocobject();
3441     erg+=numberofvariables(a,lan);
3442     erg+=m_l_v(lan,vekt);
3443     for (i=0L;i<S_I_I(lan);++i) erg+=copy(b,S_V_I(vekt,i));
3444     erg+=eval_polynom(a,vekt,c);
3445     erg+=freeall(lan);
3446     erg+=freeall(vekt);
3447     if (erg != OK) error(" in computation of polya_const_sub(a,b,c) ");
3448     return(erg);
3449 }
3450 
eval_polynom_maxgrad(a,b,c,d)3451 static INT eval_polynom_maxgrad(a,b,c,d) OP a,b,c,d;
3452 /* a ist ein Polynom in mehreren Unbestimmten
3453    die Unbestimmte x_i wird durch den i-ten Eintrag des Vektors b ersetzt. (dies
3454    sollte ein Polynom in einer Unbestimmten sein.)
3455    c ist ein INTEGER Objekt, das den maximalen Grad angibt.
3456    d ist das Resultat.
3457 */
3458 {
3459     INT erg=OK;
3460     {
3461     OP monom1,poly2,poly3,hpoly,hilf;
3462     INT i;
3463     CALLOCOBJECT4(poly2,poly3,hpoly,hilf);
3464     M_I_I(0L,hilf);
3465     erg+=m_scalar_polynom(hilf,hpoly);
3466     M_I_I(1L,hilf);
3467     monom1=a;
3468     init(POLYNOM,d); // AK 141204
3469     while (monom1!=NULL)
3470     {
3471       erg+=m_scalar_polynom(hilf,poly2);
3472       for (i=0L; i<S_V_LI(S_PO_S(monom1)); ++i)
3473       {
3474         if (!nullp(S_V_I(S_PO_S(monom1),i)))
3475         {
3476           erg+=hoch_po_maxgrad(S_V_I(b,i),S_V_I(S_PO_S(monom1),i),c,hpoly);
3477           erg+=mult_po_po_maxgrad(hpoly,poly2,c,poly3);
3478           erg+=copy(poly3,poly2);
3479         }
3480       }
3481       erg+=mult_apply(S_PO_K(monom1),poly2);
3482       erg+=add_apply(poly2,d);
3483       monom1=S_PO_N(monom1);
3484     }
3485     FREEALL4(poly2,poly3,hpoly,hilf);
3486     }
3487     ENDR("eval_polynom_maxgrad");
3488 }
3489 
co_polya_sub(a,c,maxgrad,b)3490 INT co_polya_sub(a,c,maxgrad,b) OP a,b,c,maxgrad;
3491 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
3492 /* b wird ergebnis x_i ----> 1 + q^i */
3493 /* maxgrad ist der maximale Grad der berechnet werden soll */
3494 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 15.3.94 */
3495 {
3496     OP d,e,f,g;
3497     INT i;
3498     INT erg=OK;
3499     if (S_O_K(a)!=POLYNOM) return error("co_polya_sub(a,c,maxgrad,b) a not POLYNOM");
3500     if (S_O_K(c)!=INTEGER) return error("co_polya_sub(a,c,maxgrad,b) c not INTEGER");
3501     if (not EMPTYP(b)) erg+=freeself(b);
3502     d=callocobject();
3503     e=callocobject();
3504     f=callocobject();
3505     g=callocobject();
3506     M_I_I(1L,d);
3507     erg += m_scalar_polynom(d,e);
3508     /*M_I_I(1L,d);*/
3509     erg += m_il_v(1L,f);
3510     M_I_I(1L,s_v_i(f,0L));
3511     erg+=m_skn_po(f,d,NULL,g);
3512     erg += m_il_v(S_I_I(c),d);
3513     for (i=0L;i<S_V_LI(d);i++)
3514         {
3515         erg += add(e,g,f); erg+=copy(f,S_V_I(d,i));
3516         erg += inc(s_v_i(S_PO_S(g),0L));
3517         }
3518     erg += eval_polynom_maxgrad(a,d,maxgrad,b);
3519     erg += freeall(d);
3520     erg += freeall(e);
3521     erg += freeall(f);
3522     erg += freeall(g);
3523     if (erg != OK)
3524         return error("co_polya_sub: error during computation");
3525     return erg;
3526 }
3527 
mult_po_po_maxgrad(a,b,maxgrad,res)3528 static INT mult_po_po_maxgrad(a,b,maxgrad,res) OP a,b,maxgrad,res;
3529 {
3530     INT erg=OK;
3531     OP aexp= callocobject();
3532     OP ergexp= callocobject();
3533     OP ergkoeff= callocobject();
3534     OP ergglied= callocobject();
3535     OP h3= callocobject();
3536     OP h1,h2;
3537     OP aa,bb;
3538     if(res==a)
3539     {
3540       aa= callocobject();
3541       erg+=copy(a,aa);
3542     }
3543     else aa= a;
3544     if(res==b)
3545     {
3546       bb= callocobject();
3547       erg+=copy(b,bb);
3548     }
3549     else bb= b;
3550 
3551     // erg+=freeself(res);
3552     init(POLYNOM,res); // AK 141204
3553     for(h1= aa;h1;h1= s_po_n(h1))
3554     {
3555       erg+=copy(s_po_si(h1,0L),aexp);
3556       if(gt(aexp,maxgrad)) break;
3557       for(h2= bb;h2;h2= s_po_n(h2))
3558       {
3559         erg+=add(aexp,s_po_si(h2,0L),ergexp);
3560         if(gt(ergexp,maxgrad)) break;
3561         erg+=mult(s_po_k(h1),s_po_k(h2),ergkoeff);
3562         erg+=m_il_v(1L,h3);
3563         erg+=copy(ergexp,s_v_i(h3,0L));
3564         erg+=m_skn_po(h3,ergkoeff,NULL,ergglied);
3565         erg+=add_apply(ergglied,res);
3566       }
3567     }
3568     if(bb!=b) erg+=freeall(bb);
3569     if(aa!=a) erg+=freeall(aa);
3570     FREEALL5(h3,ergglied,ergkoeff,ergexp,aexp);
3571     ENDR("mult_po_po_maxgrad");
3572 }
3573 
hoch_po_maxgrad(poly,expo,maxgrad,res)3574 static INT hoch_po_maxgrad(poly,expo,maxgrad,res) OP poly,expo,maxgrad,res;
3575 
3576 {
3577     INT erg=OK;
3578     CTO(POLYNOM,"hoch_po_maxgrad(1)",poly);
3579     {
3580     OP h1= callocobject();
3581     OP h2= callocobject();
3582     OP pp;
3583     if(nullp(expo))
3584     {
3585       erg+=m_i_i(1L,h1);
3586       erg+=m_scalar_polynom(h1,res);
3587       goto fertig;
3588     }
3589     if(poly==res)
3590     {
3591       pp= callocobject();
3592       erg+=copy(poly,pp);
3593     }
3594     else
3595     {
3596       pp= poly;
3597       erg+=copy(poly,res);
3598     }
3599     erg+=m_i_i(2L,h1);
3600     while(le(h1,expo))
3601     {
3602       erg+=mult_po_po_maxgrad(res,res,maxgrad,res);
3603       erg+=add_apply(h1,h1);
3604     }
3605     erg+=m_i_i(2L,h2);
3606     erg+=div(h1,h2,h1);
3607     erg+=sub(expo,h1,h2);
3608     if(!nullp(h2))
3609     {
3610       if(einsp(h2)) erg+=copy(pp,h1);
3611       else erg+=hoch_po_maxgrad(pp,h2,maxgrad,h1);
3612       erg+=mult_po_po_maxgrad(res,h1,maxgrad,res);
3613     }
3614     fertig:
3615     if(pp!=poly) erg+=freeall(pp);
3616     erg+=freeall(h2); erg+=freeall(h1);
3617     }
3618     ENDR("hoch_po_maxgrad");
3619 }
3620 
co_polya3_sub(a,c,dd,b)3621 INT co_polya3_sub(a,c,dd,b) OP a,b,c,dd;
3622 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
3623 /* b wird ergebnis x_i ----> 1 + q^i + q^2i + q^3i + ... */
3624 /* dd ist die hoechste Potenz von q die eingesetzt werden kann  */
3625 /* das Ergebnis stimmt nur bis zu der Potenz q^dd   */
3626 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */ /*FRIP 7.6.94 */
3627 {
3628     OP d,e,f,g,h;
3629     INT i;
3630     INT erg=OK;
3631     if (S_O_K(a)!=POLYNOM) return error("co_polya3_sub(a,c,dd,b) a not POLYNOM");
3632     if (S_O_K(c)!=INTEGER) return error("co_polya3_sub(a,c,dd,b) c not INTEGER");
3633     if (not EMPTYP(b)) erg+=freeself(b);
3634     d=callocobject();
3635     e=callocobject();
3636     f=callocobject();
3637     g=callocobject();
3638     h=callocobject();
3639     M_I_I(1L,d);
3640     erg += m_scalar_polynom(d,e);
3641     erg += m_il_v(1L,f);
3642     M_I_I(1L,s_v_i(f,0L));
3643     erg+=m_skn_po(f,d,NULL,g);
3644     erg += m_il_v(S_I_I(c),d);
3645     for (i=0L;i<S_V_LI(d);i++)
3646         {
3647         erg += add(e,g,f);
3648         mult(g,g,h);
3649         while (le(S_PO_SI(h,0L),dd))
3650         {
3651                     add_apply(h,f);
3652             mult_apply(g,h);
3653         }
3654         erg+=copy(f,S_V_I(d,i));
3655         inc(S_PO_SI(g,0L));
3656         }
3657     erg += eval_polynom_maxgrad(a,d,dd,b);
3658     FREEALL5(d,e,h,f,g);
3659     ENDR("co_polya3_sub");
3660 }
3661 
comp_vector1(a,b)3662 static INT comp_vector1(a,b) OP a,b;
3663 /* Etwas geaenderte Version von comp_vector(a,b);
3664    Es werden auch zwei Vektoren unterschiedlicher Laenge verglichen.
3665    Sind die zusaetzlichen Stellen eines der beiden Vektoren gleich 0
3666    so werden die Vektoren als gleich angesehen. Das Ergebnis ist gleich
3667    0 falls a=b
3668    >0 falls a>b
3669    <0 falls a<b.
3670    a und b sind 2 Vektor Objekte. */
3671 /* AK 060488 */ /* AK 280689 V1.0 */ /* AK 201289 V1.1 */
3672 /* AK 200891 V1.3 */
3673 {
3674     INT i,erg;
3675     if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR))
3676     return error("comp_vector1(a,b) a not VECTOR");
3677     if ((S_O_K(b)!=VECTOR)&&(S_O_K(b)!=INTEGERVECTOR))
3678     return error("comp_vector1(a,b) b not VECTOR");
3679     if (S_V_LI(a)<=S_V_LI(b))
3680     {
3681       for (    i=0L; i<S_V_LI(a); i++)
3682       {
3683         erg= comp(S_V_I(a,i),S_V_I(b,i));
3684         if (erg != 0L) return(erg);
3685       }
3686       i=S_V_LI(a);
3687       while (i<S_V_LI(b))
3688       {
3689         erg= (-1L)*(! nullp(S_V_I(b,i)));
3690         /* erg=0 falls s_v_i(b,i) gleich 0 ist, sonst ist erg>0 */
3691         if (erg != 0L) return(erg);
3692         ++i;
3693       }
3694     }
3695     else
3696     {
3697       for (    i=0L; i<S_V_LI(b); i++)
3698       {
3699         erg = comp(S_V_I(a,i),S_V_I(b,i));
3700         if (erg != 0L) return(erg);
3701       }
3702       while (i<S_V_LI(a))
3703       {
3704         erg= (! nullp(S_V_I(a,i)));
3705         /* erg=0 falls s_v_i(a,i) gleich 0 ist, sonst ist erg<0 */
3706         if (erg != 0L) return(erg);
3707         ++i;
3708       }
3709     }
3710     return(0L);
3711 }
3712 
ordnung(a,ord)3713 static INT ordnung(a,ord) OP a,ord;
3714 /* Berechnet die Ordnung einer Permutation vom Zykeltyp a.
3715    a ist ein Polynom Objekt, das den Zykeltyp der Permutation darstellt.
3716    ord ist die Ordnung der zugehoerigen Permutation(en).  */
3717 {
3718     OP  b,c;
3719     INT i;
3720     INT erg=OK;
3721     if (S_O_K(a)!=POLYNOM) return error("ordnung(a,b) a not POLYNOM");
3722     if (not EMPTYP(ord)) erg+=freeself(ord);
3723     b=callocobject();
3724     c=callocobject();
3725     M_I_I(1L,ord);
3726     erg+=copy(S_PO_S(a),b);
3727     for (i=0L;i<S_V_LI(b);++i)
3728     {
3729       if (S_V_II(b,i)!=0L)
3730       {
3731         M_I_I(i+1L,c);
3732         erg+=kgv(ord,c,ord);
3733       }
3734     }
3735     erg+=freeall(b);
3736     erg+=freeall(c);
3737     if (erg != OK) error(" in computation of ordnung(a,b) ");
3738     return(erg);
3739 }
3740 
alle_teiler(a,b)3741 INT alle_teiler(a,b) OP a,b;
3742 /* a ist eine Integer Zahl.
3743    b, ein Vektor Objekt, enthaelt alle Teiler dieser Zahl. */
3744 {
3745     OP aa,tei,teiler1,vielfachheit,vekt,hilf,hilf1;
3746     INT i,j,n;
3747     INT erg=OK;
3748     CTO(INTEGER,"alle_teiler(1)",a);
3749 
3750     if (S_I_I(a)==1L)
3751     {
3752         erg+=m_il_v(1L,b);
3753         M_I_I(1L,S_V_I(b,0L));
3754         goto endr_ende;
3755     }
3756     aa=callocobject();
3757     teiler1=callocobject();
3758     vielfachheit=callocobject();
3759     vekt=callocobject();
3760     hilf=callocobject();
3761     hilf1=callocobject();
3762     erg+=integer_factor(a,aa);/* monopoly Faktorisierung von a */
3763     erg+=m_il_v(0L,teiler1);
3764     erg+=m_il_v(0L,vielfachheit);
3765     tei=aa;
3766     while (tei != NULL)
3767     {
3768       erg+=inc(teiler1);
3769       erg+=inc(vielfachheit);
3770       erg+=copy(S_PO_S(tei),S_V_I(teiler1,S_V_LI(teiler1)-1L));
3771       erg+=copy(S_PO_K(tei),S_V_I(vielfachheit,S_V_LI(vielfachheit)-1L));
3772       /* teiler1 ist vector mit den Primteilern von a als Eintraegen */
3773       tei=S_L_N(tei);
3774     }
3775     n=S_V_LI(teiler1); /* Anzahl der verschiedenen Primteiler von a */
3776     erg+=m_il_v(0L,b);      /* b enthaelt alle Teiler von a */
3777     erster_kandidat(n,vekt);
3778     j= -1L;
3779     do
3780     {
3781       erg+=inc(b);
3782       ++j;
3783       erg+=m_i_i(1L,hilf);
3784       for (i=0L; i<n; ++i)
3785       {
3786         if (S_V_II(vekt,i)!=0L)
3787         {
3788           erg+=hoch(S_V_I(teiler1,i),S_V_I(vekt,i),hilf1);
3789           erg+=mult(hilf,hilf1,hilf);
3790           /* hilf ist ein Teiler von a */
3791         }
3792       }
3793       erg+=copy(hilf,S_V_I(b,j));
3794       i=next_kandidat2(vielfachheit,vekt);
3795     } while(i==1L);
3796     FREEALL3(aa,hilf,hilf1);
3797     erg+=freeall(vekt);
3798     erg+=freeall(vielfachheit);
3799     erg+=freeall(teiler1);
3800     ENDR("alle_teiler");
3801 }
3802 
zykeltyp_pi_hoch(a,b,c)3803 INT zykeltyp_pi_hoch(a,b,c)
3804     OP a,b,c;
3805 /* a ist ein Vektorobjekt, das den Zykeltyp einer Permutation pi
3806    enthaelt. c ist ein Polynomobjekt, das den Zykeltyp von pi^b
3807    enthaelt. */
3808 {
3809     OP poly1,poly2,vekt;
3810     INT i,j;
3811     INT erg=OK;
3812     if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR))
3813     return error("zykeltyp_pi_hoch(a,b,c) a not VECTOR");
3814     if (S_O_K(b)!=INTEGER) return error("zykeltyp_pi_hoch(a,b,c) b not INTEGER");
3815     if (S_I_I(b)<1L) return error("zykeltyp_pi_hoch(a,b,c) b<1");
3816     if (not EMPTYP(c)) erg+=freeself(c);
3817     poly1=callocobject();
3818     erg+=m_skn_po(a,cons_eins,NULL,poly1);
3819     if (S_I_I(b)==1L)
3820     {
3821     erg+=copy(poly1,c);
3822     erg+=freeall(poly1);
3823     if (erg != OK) error(" in computation of zykeltyp_pi_hoch(a,b,c) ");
3824     return(erg);
3825     }
3826     vekt=callocobject();
3827     poly2=callocobject();
3828     erg+=m_l_v(S_V_L(a),vekt);
3829     for (i=0L;i<S_V_LI(vekt);++i)
3830     {
3831       j=ggt_i(i+1L,S_I_I(b));
3832       erg+=m_iindex_iexponent_monom(((i+1L)/j)-1L,j,poly2);
3833       erg+=copy(poly2,S_V_I(vekt,i));
3834      }
3835     erg+=eval_polynom(poly1,vekt,c);
3836     erg+=freeall(vekt);
3837     erg+=freeall(poly1);
3838     erg+=freeall(poly2);
3839     ENDR("zykeltyp_pi_hoch");
3840 }
3841 
erster_kandidat(n,v)3842 static INT erster_kandidat(n,v) OP v; INT n;
3843 {
3844     int i;
3845     INT erg=OK;
3846     if (n<1L) return error("erster_kandidat(n,v) n<1");
3847     if (not EMPTYP(v)) erg+=freeself(v);
3848     erg+=m_il_v(n,v);
3849     for (i = 0L;i < n; M_I_I(0L,S_V_I(v,i)) , ++i)
3850         ;
3851     if (erg != OK) error(" in computation of erster_kandidat(n,v) ");
3852     return(erg);
3853 }
3854 
next_kandidat(m,v)3855 static INT next_kandidat(m,v) OP v; INT m;
3856 {
3857     int i,j,fertig;
3858     if (m<0L) return error("next_kandidat(m,v) m<0");
3859     if (S_O_K(v)!=VECTOR) return error("next_kandidat(m,v) v not VECTOR");
3860     /* for (i=0L;i<S_V_LI(v);++i)
3861        {
3862          if (S_O_K(S_V_I(v,i))!=INTEGER) error("next_kandidat(m,v) elements of v not INTEGER");
3863        }*/
3864     i=S_V_LI(v)-1L;
3865     fertig=0L;
3866     while (fertig==0L && i >= 0L)
3867     {
3868        M_I_I(S_V_II(v,i)+1L,S_V_I(v,i));
3869        if (S_V_II(v,i) > m)
3870        {
3871           M_I_I(0L,S_V_I(v,i));
3872           i=i-1L;
3873        }
3874        else
3875        fertig=1L;
3876     }
3877     if (i<0L)
3878     return(2L); /*  alle Kandidaten aufgelistet  */
3879     else
3880     return(1L); /*  kein Fehler aufgetreten  */
3881 }
3882 
next_kandidat2(vfh,v)3883 static INT next_kandidat2(vfh,v) OP v,vfh;
3884 {
3885     int i,fertig;
3886     if (S_O_K(vfh)!=VECTOR) return error("next_kandidat2(vfh,v) vfh not VECTOR");
3887     /* for (i=0;i<S_V_LI(vfh);++i)
3888     {
3889        if (S_O_K(S_V_I(vfh,i))!=INTEGER) error("next_kandidat2(vfh,v) elements of vfh not INTEGER");
3890        if (S_V_II(vfh,i)<0) error("next_kandidat2(vfh,v) elements of vfh <0");
3891     }*/
3892     if (S_O_K(v)!=VECTOR) return error("next_kandidat2(vfh,v) v not VECTOR");
3893     /* for (i=0L;i<S_V_LI(v);++i)
3894        {
3895          if (S_O_K(S_V_I(v,i))!=INTEGER) error("next_kandidat2(vfh,v) elements of v not INTEGER");
3896        }*/
3897     i=S_V_LI(v)-1L;
3898     fertig=0L;
3899     while (fertig==0L && i >= 0L)
3900     {
3901       M_I_I(S_V_II(v,i)+1L,S_V_I(v,i));
3902       if (S_V_II(v,i) > S_V_II(vfh,i))
3903       {
3904         M_I_I(0L,S_V_I(v,i));
3905         i=i-1L;
3906       }
3907       else
3908       fertig=1L;
3909     }
3910     if (i<0L)
3911     return(2L); /*  alle Kandidaten aufgelistet  */
3912     else
3913     return(1L); /*  kein Fehler aufgetreten  */
3914 }
3915 
mu(a)3916 static INT mu(a) OP a;
3917 /* Berechnet Moebiusfunktion(a)   */
3918 {
3919     OP aa,tei;
3920     INT j;
3921     INT erg=OK;
3922     if (S_O_K(a)!=INTEGER) return error("mu(a) a not INTEGER");
3923     if (S_I_I(a)<1L) return error("mu(a) a<1");
3924     if (S_I_I(a)==1L)
3925     {
3926       if (erg != OK) error(" in computation of mu(a) ");
3927       return(1L);
3928     }
3929     aa=callocobject();
3930     erg+=integer_factor(a,aa);/* monopoly Faktorisierung von a */
3931         j=0L;
3932         tei=aa;
3933         while (tei != NULL)
3934         {
3935           ++j;
3936           if(S_PO_KI(tei)>1L)
3937           {
3938         erg+=freeall(aa);
3939         if (erg != OK) error(" in computation of mu(a) ");
3940         return(0L);
3941           }
3942           tei=S_L_N(tei);
3943         }
3944         if (j%2L==0L)
3945         {
3946           erg+=freeall(aa);
3947           if (erg != OK) error(" in computation of mu(a) ");
3948           return(1L);
3949         }
3950         else
3951         {
3952           erg+=freeall(aa);
3953           if (erg != OK) error(" in computation of mu(a) ");
3954           return(-1L);
3955         }
3956 }
3957 
coeff_of_in(a,b,c)3958 INT coeff_of_in(a,b,c) OP a,b,c;
3959 /* Bestimmt c, den Koeffizienten von x^a in dem Polynom b ( b ist ein
3960    Polynom in einer Unbestimmten). */
3961 {
3962     OP poly;
3963     INT erg=OK;
3964     if (S_O_K(a)!=INTEGER) return error("coeff_of_in(a,b,c) a not INTEGER");
3965     if (S_I_I(a)<0L) return error("coeff_of_in(a,b,c) a<0");
3966     if (S_O_K(b)!=POLYNOM) return error("coeff_of_in(a,b,c) b not POLYNOM");
3967     if (not EMPTYP(c)) erg+=freeself(c);
3968     poly=b;
3969     while (poly!=NULL)
3970     {
3971       if (eq(a,S_PO_SI(poly,0L)))
3972       {
3973         erg+=copy(S_PO_K(poly),c);
3974         if (erg != OK) error(" in computation of coeff_of_in(a,b,c) ");
3975         return(erg);
3976       }
3977       poly=S_PO_N(poly);
3978     }
3979     M_I_I(0L,c);
3980     if (erg != OK) error(" in computation of coeff_of_in(a,b,c) ");
3981     return(erg);
3982 }
3983 
vektor_mult_apply(a,b)3984 static INT vektor_mult_apply(a,b) OP a,b;
3985 /* Sei a[i] das i-te Element von a, dann wird a[i] als a[i]*b berechnet. */
3986 {
3987     INT i;
3988     INT erg=OK;
3989     /*if (S_O_K(a)==INTEGERVECTOR) C_O_K(a,VECTOR);*/
3990     if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR))
3991     return error("vektor_mult_apply(a,b) a not VECTOR");
3992     if (S_O_K(b)!=INTEGER) return error("vektor_mult_apply(a,b) b not INTEGER");
3993     for (i=0L;i<S_V_LI(a);++i)
3994     erg+=mult_apply(b,S_V_I(a,i));
3995     if (erg != OK) error(" in computation of vektor_mult_apply(a,b) ");
3996     return(erg);
3997 }
3998 
vektor_prod(a,b)3999 static INT vektor_prod(a,b) OP a,b;
4000 /* a ist ein Vektorobjekt, das Integerobjekte enthaelt.
4001    b wird das Produkt all dieser Eintraege des Vektors. */
4002 {
4003     INT i;
4004     INT erg=OK;
4005     if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR))
4006     return error("vektor_prod(a,b) a not VECTOR");
4007     if (not EMPTYP(b)) erg+=freeself(b);
4008     M_I_I(1L,b);
4009     for (i=0L;i<S_V_LI(a);++i)
4010        erg+=mult_apply(S_V_I(a,i),b);
4011     if (erg != OK) error(" in computation of vektor_prod(a,b) ");
4012     return(erg);
4013 }
4014 
vektor_kgv_prod_durch_kgv(a,b,c)4015 static INT vektor_kgv_prod_durch_kgv(a,b,c) OP a,b,c;
4016 /* a ist ein Vektorobjekt, das Integerobjekte enthaelt.
4017    Jedes dieser Integerobjekte wird um 1 vergroessert, und von
4018    all diesen Zahlen das kgv (=b)  und das Produkt ueber alle Zahlen
4019    dividiert durch kgv (=c) bestimmt. */
4020 {
4021     OP aa;
4022     INT i;
4023     INT erg=OK;
4024     if ((S_O_K(a)!=VECTOR)&&(S_O_K(a)!=INTEGERVECTOR))
4025     return error("vektor_kgv_prod_durch_kgv(a,b,c) a not VECTOR");
4026     if (not EMPTYP(b)) erg+=freeself(b);
4027     if (not EMPTYP(c)) erg+=freeself(c);
4028     if (S_V_LI(a)==1L)
4029     {
4030       M_I_I(1L,b);
4031       M_I_I(S_V_II(a,0L)+1L,c);
4032       if (erg != OK) error(" in computation of vektor_kgv_prod_durch_kgv(a,b,c) ");
4033       return(erg);
4034     }
4035     else
4036     aa=callocobject();
4037     erg+=copy(a,aa);
4038     M_I_I(1L,b);
4039     for (i=0L;i<S_V_LI(a);++i)
4040     {
4041       erg+=inc(S_V_I(aa,i));
4042       erg+=kgv(b,S_V_I(aa,i),b);
4043     }
4044     erg+=vektor_prod(aa,c);
4045     erg+=ganzdiv(c,b,c);
4046     erg+=freeall(aa);
4047     if (erg != OK) error(" in computation of vektor_kgv_prod_durch_kgv(a,b,c) ");
4048     return(erg);
4049 }
4050 
fmultinom_ext(a,b,c)4051 static INT fmultinom_ext(a,b,c) OP a,b,c;
4052 /* a ist ein INTEGER objekt.  b ist ein VECTOR objekt. Die Komponenten
4053 von b sind wieder INTEGER objekte (groesser oder gleich 0). Das Ergebnis
4054 c ist die Anzahl der moeglichen Anordnungen der Elemente von b. */
4055 {
4056     INT i;
4057     OP hilfoben,hilfunten,hilf,hilf1,part;
4058     INT erg=OK;
4059     CTO(INTEGER,"fmultinom_ext",a);
4060     CTTO(INTEGERVECTOR,VECTOR,"fmultinom_ext",b);
4061 
4062 
4063     hilfoben=callocobject();
4064     hilfunten=callocobject();
4065     hilf=callocobject();
4066     hilf1=callocobject();
4067     part=callocobject();
4068     m_v_pa(b,part);
4069     t_VECTOR_EXPONENT(part,part);
4070     erg+=fakul(a,hilfoben);
4071     M_I_I(1L,hilfunten);
4072     M_I_I(0L,hilf1);
4073     for (i=0L;i<S_PA_LI(part);++i)
4074     {
4075       erg+=add_apply(S_PA_I(part,i),hilf1);
4076       erg+=fakul(S_PA_I(part,i),hilf);
4077       erg+=mult_apply(hilf,hilfunten);
4078     }
4079     erg+=sub(a,hilf1,hilf1);
4080     erg+=fakul(hilf1,hilf);
4081     erg+=mult_apply(hilf,hilfunten);
4082     erg+=div(hilfoben,hilfunten,c);
4083     erg+=freeall(hilfoben);
4084     erg+=freeall(hilfunten);
4085     erg+=freeall(hilf);
4086     erg+=freeall(hilf1);
4087     erg+=freeall(part);
4088     ENDR("internal func fmultinom_ext");
4089 }
4090 
fmultinom(a,b,c)4091 static INT fmultinom(a,b,c) OP a,b,c;
4092 /* a ist ein INTEGER objekt. b ist ein VECTOR objekt. c ist der
4093 Multinomialkoeffizient a ueber den Elementen von b.  */
4094 {
4095     INT i;
4096     OP hilfoben,hilfunten,hilf;
4097     INT erg=OK;
4098     if (S_O_K(a)!=INTEGER) return error("fmultinom(a,b,c)  a not INTEGER");
4099     if (S_O_K(b)!=VECTOR) return error("fmultinom(a,b,c)  b not VECTOR");
4100     /* for (i=0L;i<S_V_LI(b);++i)
4101     {
4102       if (S_O_K(S_V_I(b,i))!=INTEGER) return error("fmultinom(a,b,c)  b not vector of
4103     INTEGERs");
4104     }*/
4105     if (!emptyp(c)) freeself(c);
4106     hilfoben=callocobject();
4107     hilfunten=callocobject();
4108     hilf=callocobject();
4109     erg+=fakul(a,hilfoben);
4110     M_I_I(1L,hilfunten);
4111     for (i=0L;i<S_V_LI(b);++i)
4112     {
4113       erg+=fakul(S_V_I(b,i),hilf);
4114       erg+=mult_apply(hilf,hilfunten);
4115     }
4116     erg+=div(hilfoben,hilfunten,c);
4117     erg+=freeall(hilfoben);
4118     erg+=freeall(hilfunten);
4119     erg+=freeall(hilf);
4120     if (erg!=OK) error("  in computation of fmultinom(a,b,c) ");
4121     return(erg);
4122 }
4123 
first_unordered_part_into_atmost_k_parts(s,k,a)4124 static INT first_unordered_part_into_atmost_k_parts(s,k,a) OP a; INT k,s;
4125 /*first_pa_into_atmost_k_parts(s,k,a)*/
4126 /* Bestimmt die erste Darstellung von s als Summe von k Summanden >=0.
4127 Diese Darstellung wird als VECTOR a weitergegeben.  */
4128 {
4129     int i;
4130     INT erg=OK;
4131     m_il_nv(k,a);
4132     if (k>0) M_I_I(s,S_V_I(a,k-1L));
4133     ENDR("internal func first_unordered_part_into_atmost_k_parts");
4134 }
4135 
next_unordered_part_into_atmost_k_parts(a)4136 static INT next_unordered_part_into_atmost_k_parts(a) OP a;
4137 /*next_pa_into_atmost_k_parts(a)*/
4138 /* Berechnet den Nachfolger der Darstellung einer natuerlichen Zahl
4139 als Summe von hoechstens k Summanden >=0.  Die natuerliche Zahl ist
4140 dabei die Summe ueber alle Elemente von a, k ist die Laenge von a. */
4141 {
4142     int i;
4143     INT erg = OK;
4144     CTO(VECTOR,"next_unordered_part_into_atmost_k_parts",a);
4145     i=S_V_LI(a)-1L;
4146     while( (i>=0L) && nullp(S_V_I(a,i)) ) --i;
4147     if (i<=0L)  return(2L); /* alle aufglistet */
4148     copy(S_V_I(a,i),S_V_I(a,S_V_LI(a)-1L));
4149     dec(S_V_I(a,S_V_LI(a)-1L));
4150     inc(S_V_I(a,i-1L));
4151     if (i<S_V_LI(a)-1L) M_I_I(0L,S_V_I(a,i));
4152     return(1L); /*  kein Fehler aufgetreten  */
4153     ENDR("internal func next_unordered_part_into_atmost_k_parts");
4154 }
4155 
first_part_into_atmost_k_parts(n,k,v)4156 static INT first_part_into_atmost_k_parts(n,k,v) OP n,k,v;
4157 /* Bestimmte die erste Partition der Zahl n in k Teile. Die Partition
4158 wird durch ein VECTOR objekt v dargestellt.  */
4159 {
4160     INT i;
4161     if (! emptyp(v)) freeself(v);
4162     m_l_v(k,v);
4163     copy(n,S_V_I(v,0L));
4164     for (i=1L;i<S_I_I(k);++i) M_I_I(0L,S_V_I(v,i));
4165     return OK;
4166 }
4167 
next_part_into_atmost_k_parts(v)4168 static INT next_part_into_atmost_k_parts(v) OP v;
4169 {
4170     OP hilf,hilf1,hilf2,hilf3;
4171     INT i,j,l;
4172     INT res;
4173     hilf=callocobject();
4174     hilf1=callocobject();
4175     hilf2=callocobject();
4176     hilf3=callocobject();
4177     i=S_V_LI(v);
4178     M_I_I(0L,hilf);
4179     M_I_I(1L,hilf1);
4180     do
4181     {
4182       do
4183       {
4184         --i;
4185         add_apply(S_V_I(v,i),hilf);
4186       } while ((i>=1L) && (le(S_V_I(v,i),hilf1)));
4187       if ((i==0L) && (eq(S_V_I(v,i),hilf1)))
4188         {
4189         res=2L;
4190         goto ende;
4191         }
4192       copy(S_V_I(v,i),hilf1);
4193       dec(hilf1);
4194       quores(hilf,hilf1,hilf2,hilf3);
4195       if (nullp(hilf3)) l=0L;
4196       else l=1L;
4197       if (S_I_I(hilf2)+i+l<=S_V_LI(v))
4198       {
4199         for (j=0L;j<S_I_I(hilf2);++j) copy(hilf1,S_V_I(v,i+j));
4200         if (l==1L)
4201         {
4202           copy(hilf3,S_V_I(v,i+j));
4203           ++j;
4204         }
4205         for (;i+j<S_V_LI(v);++j)
4206         {
4207           if (!nullp(S_V_I(v,i+j))) copy(cons_null,S_V_I(v,i+j));
4208         }
4209         res = 1L;
4210         goto ende;
4211       }
4212       else
4213       if (i==0L)
4214         {
4215         res=2L;
4216         goto ende;
4217         }
4218       else
4219       inc(hilf1);
4220     } while(1L==1L);
4221 ende:
4222     freeall(hilf);
4223     freeall(hilf1);
4224     freeall(hilf2);
4225     freeall(hilf3);
4226     return res;
4227 }
4228 
frip_latex_zykelind(a)4229 INT frip_latex_zykelind(a) OP a;
4230 {
4231     OP monom;
4232     INT i;
4233     if (S_O_K(a)!=POLYNOM) return error("frip_latex_zykelind(a)  a not POLYNOM");
4234     printf("$ ");
4235     monom=a;
4236     while (monom!=NULL)
4237     {
4238       if (!einsp(S_PO_K(monom)))
4239       {
4240         print(S_PO_K(monom));
4241         printf(" ");
4242       }
4243       for (i=0L;i<S_V_LI(S_PO_S(monom));++i)
4244       if (!nullp(S_V_I(S_PO_S(monom),i)))
4245       {
4246         if (!einsp(S_V_I(S_PO_S(monom),i)))
4247         printf( "x_{%" PRIINT "}^{%" PRIuPTR "}\n" ,i+1,S_V_II(S_PO_S(monom),i));
4248         else
4249         printf( "x_{%" PRIINT "}\n" ,i+1);
4250       }
4251       if (S_PO_N(monom)!=NULL) printf("+");
4252       monom=S_PO_N(monom);
4253     }
4254     printf("$\n");
4255     return OK;
4256 }
4257 
4258 /* **************************************************************
4259 
4260 Routines for computing the Redfield cup and cap product.
4261 
4262 ***************************************************************** */
4263 
redf_cap_hoch(a,n,b)4264 INT redf_cap_hoch(a,n,b) OP a,n,b;
4265 {
4266     INT i,fertig;
4267     OP hilfk,hilf,c;
4268     INT erg=OK;
4269     if (S_O_K(a)!=VECTOR) return error("redf_cap_hoch(a,n,b)  a is not VECTOR");
4270     if (S_O_K(n)!=VECTOR) return error("redf_cap_hoch(a,n,b)  n is not VECTOR");
4271     if (!eq(S_V_L(a),S_V_L(n)))
4272        return error("redf_cap_hoch(a,n,b) a and n of different length");
4273     if (S_V_LI(a)==0L) return error("redf_cap_hoch(a,n,b) a is a VECTOR of length 0");
4274     for (i=0L;i<S_V_LI(a);++i)
4275     {
4276       if (S_O_K(S_V_I(a,i))!=POLYNOM)
4277          return error("redf_cap_hoch(a,n,b) elements of a not POLYNOM");
4278       if (S_O_K(S_V_I(n,i))!=INTEGER)
4279          return error("redf_cap_hoch(a,n,b) elements of n not INTEGER");
4280     }
4281     if (not EMPTYP(b)) erg+=freeself(b);
4282     M_I_I(0L,b);
4283     hilfk=callocobject();
4284     hilf=callocobject();
4285     if (eq(S_V_L(a),cons_eins))
4286     {
4287       c=S_V_I(a,0L);
4288       while (c!=NULL)
4289       {
4290         erg+=redf_formel(S_PO_S(c),S_V_II(n,0L)-1L,hilfk);
4291         erg+=hoch(S_PO_K(c),S_V_I(n,0L),hilf);
4292         erg+=mult_apply(hilf,hilfk);
4293         erg+=add_apply(hilfk,b);
4294         c=S_PO_N(c);
4295       }
4296     }
4297     else
4298     {
4299       OP nn=callocobject();
4300       OP hilf1=callocobject();
4301       erg+=copy(S_V_I(a,0L),hilf);
4302       copy(S_V_I(n,0l),hilf1);
4303       for (i=1L;i<S_V_LI(a);++i)
4304       {
4305         erg+=redf_f1h(hilf,S_V_I(a,i),hilf1,S_V_I(n,i),hilfk);
4306         erg+=copy(hilfk,hilf);
4307         if (i==1L) M_I_I(1L,hilf1);
4308       }
4309       erg+=sum_vector(n,nn);
4310       c=hilf;
4311       while (c!=NULL)
4312       {
4313         erg+=redf_formel(S_PO_S(c),S_I_I(nn)-1L,hilfk);
4314         erg+=mult_apply(S_PO_K(c),hilfk);
4315         erg+=add_apply(hilfk,b);
4316         c=S_PO_N(c);
4317       }
4318       erg+=freeall(nn);
4319       erg+=freeall(hilf1);
4320     }
4321     erg+=freeall(hilfk);
4322     erg+=freeall(hilf);
4323     if (erg != OK) error(" in computation of redf_cap_hoch(a,n,b) ");
4324     return(erg);
4325 }
4326 
redf_cup_hoch(a,n,b)4327 INT redf_cup_hoch(a,n,b) OP a,n,b;
4328 {
4329     INT i,fertig;
4330     OP hilfk,hilf,c;
4331     INT erg=OK;
4332     if (S_O_K(a)!=VECTOR) return error("redf_cup_hoch(a,n,b)  a is not VECTOR");
4333     if (S_O_K(n)!=VECTOR) return error("redf_cup_hoch(a,n,b)  n is not VECTOR");
4334     if (!eq(S_V_L(a),S_V_L(n)))
4335        return error("redf_cup_hoch(a,n,b) a and n of different length");
4336     if (S_V_LI(a)==0L) return error("redf_cup_hoch(a,n,b) a is a VECTOR of length 0");
4337     for (i=0L;i<S_V_LI(a);++i)
4338     {
4339       if (S_O_K(S_V_I(a,i))!=POLYNOM)
4340          return error("redf_cup_hoch(a,n,b) elements of a not POLYNOM");
4341       if (S_O_K(S_V_I(n,i))!=INTEGER)
4342          return error("redf_cup_hoch(a,n,b) elements of n not INTEGER");
4343     }
4344     if (not EMPTYP(b)) erg+=freeself(b);
4345     hilfk=callocobject();
4346     hilf=callocobject();
4347     if (eq(S_V_L(a),cons_eins))
4348     {
4349       copy(S_V_I(a,0L),b);
4350       c=b;
4351       while (c!=NULL)
4352       {
4353         erg+=redf_formel(S_PO_S(c),S_V_II(n,0L)-1L,hilfk);
4354         erg+=hoch(S_PO_K(c),S_V_I(n,0L),hilf);
4355         erg+=mult(hilf,hilfk,S_PO_K(c));
4356         c=S_PO_N(c);
4357       }
4358     }
4359     else
4360     {
4361       OP nn=callocobject();
4362       OP hilf1=callocobject();
4363       erg+=copy(S_V_I(a,0L),hilf);
4364       copy(S_V_I(n,0l),hilf1);
4365       for (i=1L;i<S_V_LI(a);++i)
4366       {
4367         erg+=redf_f1h(hilf,S_V_I(a,i),hilf1,S_V_I(n,i),hilfk);
4368         erg+=copy(hilfk,hilf);
4369         if (i==1L) M_I_I(1L,hilf1);
4370       }
4371       erg+=sum_vector(n,nn);
4372       c=hilf;
4373       while (c!=NULL)
4374       {
4375         erg+=redf_formel(S_PO_S(c),S_I_I(nn)-1L,hilfk);
4376         erg+=mult_apply(hilfk,S_PO_K(c));
4377         c=S_PO_N(c);
4378       }
4379       erg+=freeall(nn);
4380       erg+=freeall(hilf1);
4381       erg+=copy(hilf,b);
4382     }
4383     erg+=freeall(hilfk);
4384     erg+=freeall(hilf);
4385     if (erg != OK) error(" in computation of redf_cup_hoch(a,n,b) ");
4386     return(erg);
4387 }
4388 
redf_cap(a,b)4389 INT redf_cap(a,b) OP a,b;
4390 /* Berechnet das cap-Produkt der Polynome, die in dem Vektor
4391    a uebergeben werden. Das Ergebnis ist b. */
4392 {
4393     INT erg=OK;
4394     OP hpoly,hpoly1,monom;
4395     INT i;
4396     if (S_O_K(a)!=VECTOR) return error("redf_cap(a,b)  a not VECTOR");
4397     if (S_V_LI(a)<=1L)
4398        return error("redf_cap(a,b) there must be at least 2 cycle indices in a");
4399     for (i=0L;i<S_V_LI(a);++i)
4400     {
4401       if (S_O_K(S_V_I(a,i))!=POLYNOM)
4402          return error("redf_cap(a,b)  Elements of a not POLYNOM");
4403     }
4404 
4405     hpoly=callocobject();
4406     hpoly1=callocobject();
4407     erg+=m_i_i(0L,b);
4408     erg+=copy(S_V_I(a,0L),hpoly);
4409     for (i=1L;i<S_V_LI(a);++i)
4410     {
4411       erg+=redf_f1(hpoly,S_V_I(a,i),hpoly1);
4412       erg+=copy(hpoly1,hpoly);
4413     }
4414     monom=hpoly;
4415     while (monom!=NULL)
4416     {
4417       erg+=redf_formel(S_PO_S(monom),S_V_LI(a)-1L,hpoly1);
4418       erg+=mult_apply(S_PO_K(monom),hpoly1);
4419       erg+=add_apply(hpoly1,b);
4420       monom=S_PO_N(monom);
4421     }
4422     erg+=freeall(hpoly);
4423     erg+=freeall(hpoly1);
4424     ENDR("redf_cap");
4425 }
4426 
redf_cup(a,b)4427 INT redf_cup(a,b) OP a,b;
4428 /* Berechnet das cup-Produkt der Polynome, die im Vektor a
4429    uebergeben werden. Das Ergebnis ist b.  */
4430 {
4431     INT erg=OK;
4432     OP hpoly,hpoly1,monom;
4433     INT i;
4434     if (S_O_K(a)!=VECTOR) return error("redf_cup(a,b)  a not VECTOR");
4435     if (S_V_LI(a)<=1L)
4436        return error("redf_cup(a,b) there must be at least 2 cycle indices in a");
4437     for (i=0L;i<S_V_LI(a);++i)
4438     {
4439       if (S_O_K(S_V_I(a,i))!=POLYNOM)
4440          return error("redf_cup(a,b)  Elements of a not POLYNOM");
4441     }
4442     if (not EMPTYP(b)) erg+=freeself(b);
4443     hpoly=callocobject();
4444     hpoly1=callocobject();
4445     erg+=copy(S_V_I(a,0L),hpoly);
4446     for (i=1L;i<S_V_LI(a);++i)
4447     {
4448       erg+=redf_f1(hpoly,S_V_I(a,i),hpoly1);
4449       erg+=copy(hpoly1,hpoly);
4450     }
4451     monom=hpoly;
4452     while (monom!=NULL)
4453     {
4454       erg+=redf_formel(S_PO_S(monom),S_V_LI(a)-1L,hpoly1);
4455       erg+=mult_apply(hpoly1,S_PO_K(monom));
4456       monom=S_PO_N(monom);
4457     }
4458     erg+=copy(hpoly,b);
4459     erg+=freeall(hpoly); erg+=freeall(hpoly1);
4460     if (erg!=OK) return error(" in computation of redf_cup(a,b) ");
4461     return erg;
4462 }
4463 
redf_f1(a,b,c)4464 static INT redf_f1(a,b,c) OP a,b,c;
4465 /* a,b sin POLYNOME, c wird ein neues POLYNOM, dessen MONOMe sowohl in
4466    a als auch in b vorkommen. Die entsprechenden Koeffizienten werden
4467    zusammenmultipliziert.
4468    Dazu werden a und b in Listen umgewandelt. Diese Listen werden in
4469    redf_f2 auf gleiche MONOM-VECTOREN untersucht, und c wird dann in
4470    redf_f3 aufgebaut.
4471 */
4472 {
4473     INT erg=OK;
4474     OP al=callocobject();
4475     OP bl=callocobject();
4476     erg+=copy_list(a,al);
4477     erg+=copy_list(b,bl);
4478     erg+=m_i_i(0L,c);
4479     erg+=redf_f2(al,bl,c);
4480     erg+=freeall(al);erg+=freeall(bl);
4481     if (erg!=OK) return error(" in computation of redf_f1");
4482     return erg;
4483 }
4484 
redf_f2(von,nach,har)4485 static INT redf_f2(von,nach,har) OP von,nach,har;
4486 /* untersucht die Listen von und nach auf gleiche MONOM-VECTORen
4487    Falls solche auftreten wird redf_f3 aufgerufen.
4488 */
4489 {
4490     INT erg;
4491     OP nn = callocobject();
4492     *nn = *nach;
4493     while((von != NULL) && (nn != NULL))
4494     {
4495         erg=comp_monomvector_monomvector(S_L_S(von),S_L_S(nn));
4496         if (erg < 0L) von = S_L_N(von);
4497         else if (erg >0L) nn = S_L_N(nn);
4498         else
4499         {
4500           redf_f3(S_L_S(von),S_L_S(nn),har);
4501           nn = S_L_N(nn);
4502         }
4503     }
4504     return(OK);
4505 }
4506 
redf_f3(a,b,c)4507 static INT redf_f3(a,b,c) OP a,b,c;
4508 /* a,b sin MONOMe mit gleichem S_MO_S VECTOR
4509    ihre Koeffizienten werden zusammenmultipliziert und als neuer
4510    Term zu c (POLYNOM) mit S_MO_S VECTOR dazuaddiert
4511 */
4512 {
4513     INT erg=OK;
4514     OP hilf=callocobject();
4515     OP monom=callocobject();
4516     erg+=mult(S_MO_K(a),S_MO_K(b),hilf);
4517     erg+=m_skn_po(S_MO_S(a),hilf,NULL,monom);
4518     erg+=add_apply(monom,c);
4519     erg+=freeall(hilf); erg+=freeall(monom);
4520     if (erg!=OK) EDC("redf_f3");
4521     return erg;
4522 }
4523 
redf_f1h(a,b,na,nb,c)4524 static INT redf_f1h(a,b,na,nb,c) OP a,b,na,nb,c;
4525 /* a,b sin POLYNOME, c wird ein neues POLYNOM, dessen MONOMe sowohl in
4526    a als auch in b vorkommen. Die entsprechenden Koeffizienten werden
4527    zusammenmultipliziert.
4528    Dazu werden a und b in Listen umgewandelt. Diese Listen werden in
4529    redf_f2h auf gleiche MONOM-VECTOREN untersucht, und c wird dann in
4530    redf_f3h aufgebaut.
4531    na und nb sind die Vielfachheiten, mit denen a bzw b auftritt
4532 */
4533 {
4534     INT erg=OK;
4535     OP al=callocobject();
4536     OP bl=callocobject();
4537     erg+=copy_list(a,al);
4538     erg+=copy_list(b,bl);
4539     erg+=m_i_i(0L,c);
4540     erg+=redf_f2h(al,bl,na,nb,c);
4541     erg+=freeall(al);erg+=freeall(bl);
4542     if (erg!=OK) return error(" in computation of redf_f1h");
4543     return erg;
4544 }
4545 
redf_f2h(von,nach,na,nb,har)4546 static INT redf_f2h(von,nach,na,nb,har) OP von,nach,na,nb,har;
4547 /* untersucht die Listen von und nach auf gleiche MONOM-VECTORen
4548    Falls solche auftreten wird redf_f3h aufgerufen.
4549 */
4550 {
4551     INT erg;
4552     OP nn = callocobject();
4553     *nn = *nach;
4554     while((von != NULL) && (nn != NULL))
4555     {
4556         erg=comp_monomvector_monomvector(S_L_S(von),S_L_S(nn));
4557         if (erg < 0L) von = S_L_N(von);
4558         else if (erg >0L) nn = S_L_N(nn);
4559         else
4560         {
4561           redf_f3h(S_L_S(von),S_L_S(nn),na,nb,har);
4562           nn = S_L_N(nn);
4563         }
4564     }
4565     return(OK);
4566 }
4567 
redf_f3h(a,b,na,nb,c)4568 static INT redf_f3h(a,b,na,nb,c) OP a,b,na,nb,c;
4569 /* a,b sin MONOMe mit gleichem S_MO_S VECTOR
4570    ihre Koeffizienten werden zusammenmultipliziert und als neuer
4571    Term zu c (POLYNOM) mit S_MO_S VECTOR dazuaddiert
4572 */
4573 {
4574     INT erg=OK;
4575     OP hilf=callocobject();
4576     OP monom=callocobject();
4577     erg+=hoch(S_MO_K(a),na,hilf);
4578     erg+=hoch(S_MO_K(b),nb,monom);
4579     erg+=mult_apply(monom,hilf);
4580     erg+=freeself(monom);
4581     erg+=m_skn_po(S_MO_S(a),hilf,NULL,monom);
4582     erg+=add_apply(monom,c);
4583     erg+=freeall(hilf); erg+=freeall(monom);
4584     if (erg!=OK) EDC("redf_f3h");
4585     return erg;
4586 }
4587 
redf_formel(a,n,b)4588 static INT redf_formel(a,n,b) OP a,b; INT n;
4589 /* Berechnet den Koeffizienten fuer die Errechnung des
4590    cup bzw. cap Produktes von n+1 gleichen Monomen mit der
4591    Gestalt a (ist ein Vektor Objekt). Das Ergebnis ist b. */
4592 {
4593     OP hilf;
4594     INT i,erg;
4595     erg=OK;
4596     if (a==NULL) return m_i_i(0L,b);
4597     if ((S_O_K(a)!=VECTOR) && (S_O_K(a)!=INTEGERVECTOR))
4598        return error("redf_formel(a,n,b)  a not VECTOR");
4599     if (not EMPTYP(b)) erg+=freeself(b);
4600     if (n<1L) return error("redf_formel(a,n,b)  n<1");
4601     hilf=callocobject();
4602     erg+=m_i_i(1L,b);
4603     for (i=0L; i<S_V_LI(a); ++i)
4604     {
4605       if (S_V_II(a,i)!=0L)
4606       {
4607         erg+=fakul(S_V_I(a,i),hilf);
4608         erg+=mult(b,hilf,b);
4609         erg+=m_i_i(i+1L,hilf);
4610         erg+=hoch(hilf,S_V_I(a,i),hilf);
4611         erg+=mult(b,hilf,b);
4612       }
4613     }
4614     erg+=m_i_i(n,hilf);
4615     erg+=hoch(b,hilf,b);
4616     erg+=freeall(hilf);
4617     if (erg != OK) error(" in computation of redf_formel(a,n,b) ");
4618     return(erg);
4619 }
4620 
4621 /* *************************************************************
4622 
4623 Routines for handling multi-dimensional cycle indices. Especially
4624 the cycle indices of the symmetry groups of Platonic solids.
4625 
4626 ***************************************************************** */
4627 
mz_vereinfachen(aa,c)4628 INT mz_vereinfachen(aa,c) OP aa,c;
4629 {
4630     INT i,j,k,l;
4631     INT erg=OK;
4632     OP vector=callocobject();
4633     OP hilf=callocobject();
4634     OP monom,a,b;
4635     a=s_mz_po(aa);
4636     b=s_mz_v(aa);
4637     m_i_i(0L,c);
4638     l=S_V_LI(b);
4639     monom=a;
4640     while (monom!=NULL)
4641     {
4642       m_il_v(l,vector);
4643       j=0L;
4644       for (i=0L;i<S_V_LI(S_PO_S(monom));++i)
4645       {
4646         if ((j<l) && (i==S_V_II(b,j)))
4647         {
4648           m_il_v(0L,S_V_I(vector,j));
4649           ++j;
4650           k= -1L;
4651         }
4652         erg+=inc(S_V_I(vector,j-1L));
4653         erg+=copy(S_V_I(S_PO_S(monom),i),S_V_I(S_V_I(vector,j-1L),++k));
4654       }
4655       for (i=1L;i<l;++i) erg+=add_apply(S_V_I(vector,i),S_V_I(vector,0L));
4656       erg+=m_skn_po(S_V_I(vector,0L),S_PO_K(monom),NULL,hilf);
4657       erg+=add_apply(hilf,c);
4658       erg+=freeself(vector);
4659       monom=S_PO_N(monom);
4660     }
4661     erg+=freeall(vector);
4662     erg+=freeall(hilf);
4663     ENDR("mz_vereinfachen");
4664 }
4665 
mz_extrahieren(aa,c,dd)4666 INT mz_extrahieren(aa,c,dd)
4667     OP aa,c,dd;
4668 /* aa ist ein Zyklenzeiger mit mehreren Familien von Unbekannten.
4669 c ist ein Vektor Objekt. Die Laenge des Vektors gibt an, wieviele
4670 Teilfamilien von Unbestimmten ausgewaehlt werden. Die Eintraege in
4671 c sind die Nummern der Familien von Unbestimmten, also 1,2,3,....
4672 Diese sollen der Groesse nach angeordnet sein.
4673 d ist der neue Zyklenzeiger.  (ein oder mehrdimensional, je nachdem
4674 wie viele Familien extrahiert wurden.  */
4675 {
4676     OP a,b,d,e,variablen,vektor,hilf;
4677     INT i,j,k,ihilf;
4678     INT erg=OK;
4679     if (S_O_K(aa)!=VECTOR) return error("mz_extrahieren(a,b,c) a not a cycle index in several alphabets 1");
4680     a=s_mz_po(aa);
4681     b=s_mz_v(aa);
4682     if (S_O_K(b)!=VECTOR) return error("mz_extrahieren(a,b,c) a not a cycle index in several alphabets 2");
4683     if (S_O_K(a)!=POLYNOM) return error("mz_extrahieren(a,b,c) a not a cycle index in several alphabets 3");
4684     if (S_O_K(c)!=VECTOR) return error("mz_extrahieren(a,b,c) b not VECTOR");
4685     for (i=0L;i<S_V_LI(b);++i)
4686     {
4687       if (S_O_K(S_V_I(b,i))!=INTEGER) return error("mz_extrahieren(a,b,c) Elements of s_mz_v(a) not INTEGER");
4688     }
4689     for (i=1L;i<S_V_LI(b);++i)
4690     {
4691       if (S_V_II(b,i)<=S_V_II(b,i-1L)) return error("mz_extrahieren(a,b,c) Elements of s_mz_v(a) not increasing");
4692     }
4693     for (i=0L;i<S_V_LI(c);++i)
4694     {
4695       if (S_O_K(S_V_I(c,i))!=INTEGER) return error("mz_extrahieren(a,b,c) Elements of b not INTEGER");
4696     }
4697     for (i=1L;i<S_V_LI(c);++i)
4698     {
4699       if (S_V_II(c,i)<=S_V_II(c,i-1L)) return error("mz_extrahieren(a,b,c) Elements of b not increasing");
4700     }
4701     if (not EMPTYP(dd)) erg+=freeself(dd);
4702     variablen=callocobject();
4703     vektor=callocobject();
4704     hilf=callocobject();
4705     d=callocobject();
4706     e=callocobject();
4707     erg+=m_l_v(s_v_l(c),e);
4708     M_I_I(0L,S_V_I(e,0L));
4709     erg+=numberofvariables(a,variablen);
4710     erg+=m_l_v(variablen,vektor);
4711     j=0L;
4712     i=0L;
4713     for (k=0L; k<S_V_LI(c); ++k)
4714     {
4715         ihilf=s_mz_vii(aa,S_V_II(c,k)-1L);
4716         for (;i<ihilf;++i)
4717         M_I_I(1L,s_v_i(vektor,i));
4718         while (S_V_II(b,j)<ihilf) ++j;
4719         if (j+1L<S_V_LI(b))
4720         {
4721           if (k<S_V_LI(c)-1L)
4722           M_I_I(S_V_II(b,j+1L)-S_V_II(b,j)+S_V_II(e,k),S_V_I(e,k+1L));
4723           for (i=S_V_II(b,j);i<S_V_II(b,j+1L);++i)
4724         {
4725           erg+=m_iindex_monom(i-S_V_II(b,j)+S_V_II(e,k),hilf);
4726           erg+=copy(hilf,S_V_I(vektor,i));
4727         }
4728           if (k==S_V_LI(c)-1L)
4729           {
4730         ++j;
4731         for (i=S_V_II(b,j);i<S_V_LI(vektor);++i)
4732         M_I_I(1L,S_V_I(vektor,i));
4733           }
4734         }
4735         else
4736         {
4737           for (i=S_V_II(b,j);i<S_I_I(variablen);++i)
4738         {
4739           erg+=m_iindex_monom(i-S_V_II(b,j)+S_V_II(e,k),hilf);
4740           erg+=copy(hilf,S_V_I(vektor,i));
4741         }
4742         }
4743      }
4744     erg+=eval_polynom(a,vektor,d);
4745     erg+=m_v_po_mz(e,d,dd);
4746     erg+=freeall(variablen); erg+=freeall(vektor); erg+=freeall(hilf);
4747     erg+=freeall(d);
4748     erg+=freeall(e);
4749     ENDR("mz_extrahieren");
4750 }
4751 
s_mz_v(a)4752 OP s_mz_v(a) OP a;
4753 /* select_multizykelind_vector */
4754 {
4755     return (s_v_i(a,0L));
4756 }
4757 
s_mz_vi(a,i)4758 OP s_mz_vi(a,i) OP a;
4759 /* select_multizykelind_vector-ith */
4760     INT i;
4761 {
4762     return(S_V_I(S_V_I(a,0L),i));
4763 }
4764 
s_mz_vii(a,i)4765 INT s_mz_vii(a,i) OP a;
4766 /* select_multizykelind_vector-ith as integer */
4767     INT i;
4768 {
4769     return(S_V_II(S_V_I(a,0L),i));
4770 }
4771 
s_mz_po(a)4772 OP s_mz_po(a) OP a;
4773 /* select_multizykelind_polynom */
4774 {
4775     return (S_V_I(a,1L));
4776 }
4777 
m_v_po_mz(v,p,z)4778 INT m_v_po_mz(v,p,z) OP v,p,z;
4779 /* make_v_polynom_multizykelind */
4780 {
4781     INT erg=OK;
4782     if (S_V_LI(v)>1L)
4783     {
4784       erg+=m_il_v(2L,z);
4785       erg+=copy(v,S_V_I(z,0L));
4786       erg+=copy(p,S_V_I(z,1L));
4787     }
4788     else erg+=copy(p,z);
4789     ENDR("m_v_po_mz");
4790 }
4791 
zykelind_tetraeder(aa)4792 INT zykelind_tetraeder(aa) OP aa;
4793 /* Berechnet den Zyklenzeiger der Drehgruppe des Tetraeders.
4794 Es treten 3 Familien von Unbestimmten auf. Die erste Familie
4795 bezieht sich auf Gruppenaktion auf der Menge der Knoten, die zweite
4796 auf der Menge der Kanten und die dritte auf der Menge der Flaechen
4797 des Tetraeders.  */
4798 {
4799     OP a,b,koef,vektor,hilf;
4800     INT i;
4801     INT erg=OK;
4802     koef=callocobject();
4803     vektor=callocobject();
4804     hilf=callocobject();
4805     a=callocobject();
4806     b=callocobject();
4807     erg+=m_ioiu_b(1L,12L,koef);
4808     erg+=m_il_v(11L,vektor);
4809     for (i=0L;i<S_V_LI(vektor);++i) M_I_I(0L,S_V_I(vektor,i));
4810     M_I_I(4L,S_V_I(vektor,0L));
4811     M_I_I(6L,S_V_I(vektor,4L));
4812     M_I_I(4L,S_V_I(vektor,8L));
4813     erg+=m_skn_po(vektor,koef,NULL,a);
4814     erg+=m_ioiu_b(8L,12L,koef);
4815     M_I_I(1L,S_V_I(vektor,0L));
4816     M_I_I(1L,S_V_I(vektor,2L));
4817     M_I_I(0L,S_V_I(vektor,4L));
4818     M_I_I(2L,S_V_I(vektor,6L));
4819     M_I_I(1L,S_V_I(vektor,8L));
4820     M_I_I(1L,S_V_I(vektor,10L));
4821     erg+=m_skn_po(vektor,koef,NULL,hilf);
4822     erg+=add(hilf,a,a);
4823     erg+=m_ioiu_b(3L,12L,koef);
4824     M_I_I(0L,S_V_I(vektor,0L));
4825     M_I_I(2L,S_V_I(vektor,1L));
4826     M_I_I(0L,S_V_I(vektor,2L));
4827     M_I_I(2L,S_V_I(vektor,4L));
4828     M_I_I(2L,S_V_I(vektor,5L));
4829     M_I_I(0L,S_V_I(vektor,6L));
4830     M_I_I(0L,S_V_I(vektor,8L));
4831     M_I_I(2L,S_V_I(vektor,9L));
4832     M_I_I(0L,S_V_I(vektor,10L));
4833     erg+=m_skn_po(vektor,koef,NULL,hilf);
4834     erg+=add(hilf,a,a);
4835     erg+=m_il_v(3L,b);
4836     M_I_I(0L,S_V_I(b,0L));
4837     M_I_I(4L,S_V_I(b,1L));
4838     M_I_I(8L,S_V_I(b,2L));
4839     erg+=freeall(hilf); erg+=freeall(vektor); erg+=freeall(koef);
4840     erg+=m_v_po_mz(b,a,aa);
4841     erg+=freeall(a);
4842     erg+=freeall(b);
4843     ENDR("zykelind_tetraeder");
4844 }
4845 
zykelind_tetraeder_extended(aa)4846 INT zykelind_tetraeder_extended(aa) OP aa;
4847 /* Berechnet den Zyklenzeiger der Gruppe aller Symmetrien des
4848 Tetraeders. Es treten 3 Familien von Unbestimmten auf. Die erste Familie
4849 bezieht sich auf Gruppenaktion auf der Menge der Knoten, die zweite
4850 auf der Menge der Kanten und die dritte auf der Menge der Flaechen
4851 des Tetraeders.  */
4852 {
4853     OP a,koef,vektor,hilf;
4854     INT i;
4855     INT erg=OK;
4856     koef=callocobject();
4857     vektor=callocobject();
4858     hilf=callocobject();
4859     erg+=zykelind_tetraeder(aa);
4860     a=s_mz_po(aa);
4861     erg+=m_ioiu_b(1L,2L,koef);
4862     erg+=m_scalar_polynom(koef,hilf);
4863     erg+=mult(hilf,a,a);
4864     erg+=m_ioiu_b(1L,4L,koef);
4865     erg+=m_il_v(12L,vektor);
4866     for (i=0L;i<s_v_li(vektor);++i) M_I_I(0L,S_V_I(vektor,i));
4867     M_I_I(2L,S_V_I(vektor,0L));
4868     M_I_I(1L,S_V_I(vektor,1L));
4869     M_I_I(2L,S_V_I(vektor,4L));
4870     M_I_I(2L,S_V_I(vektor,5L));
4871     M_I_I(2L,S_V_I(vektor,8L));
4872     M_I_I(1L,S_V_I(vektor,9L));
4873     erg+=m_skn_po(vektor,koef,NULL,hilf);
4874     erg+=add(hilf,a,a);
4875     M_I_I(0L,S_V_I(vektor,0L));
4876     M_I_I(0L,S_V_I(vektor,1L));
4877     M_I_I(1L,S_V_I(vektor,3L));
4878     M_I_I(0L,S_V_I(vektor,4L));
4879     M_I_I(1L,S_V_I(vektor,5L));
4880     M_I_I(1L,S_V_I(vektor,7L));
4881     M_I_I(0L,S_V_I(vektor,8L));
4882     M_I_I(0L,S_V_I(vektor,9L));
4883     M_I_I(1L,S_V_I(vektor,11L));
4884     erg+=m_skn_po(vektor,koef,NULL,hilf);
4885     erg+=add(hilf,a,a);
4886     erg+=freeall(hilf); erg+=freeall(vektor); erg+=freeall(koef);
4887     if (erg != OK) error(" in computation of zykelind_tetraeder_extended(a) ");
4888     return(erg);
4889 }
4890 
zykelind_tetraeder_vertices(a)4891 INT zykelind_tetraeder_vertices(a) OP a;
4892 {
4893     OP b,c,d;
4894     INT erg=OK;
4895     if (not EMPTYP(a)) erg+=freeself(a);
4896     b=callocobject();
4897     d=callocobject();
4898     erg+=zykelind_tetraeder(b);
4899     c=s_mz_v(b);
4900     erg+=m_il_v(1L,d);
4901     M_I_I(1L,S_V_I(d,0L));
4902     erg+=mz_extrahieren(b,d,a);
4903     erg+=freeall(b); erg+=freeall(d);
4904     if (erg != OK) error(" in computation of zykelind_tetraeder_vertices(a) ");
4905     return(erg);
4906 }
4907 
zykelind_tetraeder_edges(a)4908 INT zykelind_tetraeder_edges(a) OP a;
4909 {
4910     OP b,c,d;
4911     INT erg=OK;
4912     if (not EMPTYP(a)) erg+=freeself(a);
4913     b=callocobject();
4914     d=callocobject();
4915     erg+=zykelind_tetraeder(b);
4916     c=s_mz_v(b);
4917     erg+=m_il_v(1L,d);
4918     M_I_I(2L,S_V_I(d,0L));
4919     erg+=mz_extrahieren(b,d,a);
4920     erg+=freeall(b); erg+=freeall(d);
4921     if (erg != OK) error(" in computation of zykelind_tetraeder_edges(a) ");
4922     return(erg);
4923 }
4924 
zykelind_tetraeder_faces(a)4925 INT zykelind_tetraeder_faces(a) OP a;
4926 {
4927     OP b,c,d;
4928     INT erg=OK;
4929     if (not EMPTYP(a)) erg+=freeself(a);
4930     b=callocobject();
4931     d=callocobject();
4932     erg+=zykelind_tetraeder(b);
4933     c=s_mz_v(b);
4934     erg+=m_il_v(1L,d);
4935     M_I_I(3L,S_V_I(d,0L));
4936     erg+=mz_extrahieren(b,d,a);
4937     erg+=freeall(b); erg+=freeall(d);
4938     if (erg != OK) error(" in computation of zykelind_tetraeder_faces(a) ");
4939     return(erg);
4940 }
4941 
zykelind_tetraeder_vertices_extended(a)4942 INT zykelind_tetraeder_vertices_extended(a) OP a;
4943 {
4944     OP b,c,d;
4945     INT erg=OK;
4946     if (not EMPTYP(a)) erg+=freeself(a);
4947     b=callocobject();
4948     d=callocobject();
4949     erg+=zykelind_tetraeder_extended(b);
4950     c=s_mz_v(b);
4951     erg+=m_il_v(1L,d);
4952     M_I_I(1L,S_V_I(d,0L));
4953     erg+=mz_extrahieren(b,d,a);
4954     erg+=freeall(b); erg+=freeall(d);
4955     if (erg != OK) error(" in computation of zykelind_tetraeder_vertices_extended(a) ");
4956     return(erg);
4957 }
4958 
zykelind_tetraeder_edges_extended(a)4959 INT zykelind_tetraeder_edges_extended(a) OP a;
4960 {
4961     OP b,c,d;
4962     INT erg=OK;
4963     if (not EMPTYP(a)) erg+=freeself(a);
4964     b=callocobject();
4965     d=callocobject();
4966     erg+=zykelind_tetraeder_extended(b);
4967     c=s_mz_v(b);
4968     erg+=m_il_v(1L,d);
4969     M_I_I(2L,S_V_I(d,0L));
4970     erg+=mz_extrahieren(b,d,a);
4971     erg+=freeall(b); erg+=freeall(d);
4972     if (erg != OK) error(" in computation of zykelind_tetraeder_edges_extended(a) ");
4973     return(erg);
4974 }
4975 
zykelind_tetraeder_faces_extended(a)4976 INT zykelind_tetraeder_faces_extended(a) OP a;
4977 {
4978     OP b,c,d;
4979     INT erg=OK;
4980     if (not EMPTYP(a)) erg+=freeself(a);
4981     b=callocobject();
4982     d=callocobject();
4983     erg+=zykelind_tetraeder_extended(b);
4984     c=s_mz_v(b);
4985     erg+=m_il_v(1L,d);
4986     M_I_I(3L,S_V_I(d,0L));
4987     erg+=mz_extrahieren(b,d,a);
4988     erg+=freeall(b); erg+=freeall(d);
4989     if (erg != OK) error(" in computation of zykelind_tetraeder_faces_extended(a) ");
4990     return(erg);
4991 }
4992 
zykelind_cube(aa)4993 INT zykelind_cube(aa) OP aa;
4994 /* Berechnet den Zyklenzeiger der Drehgruppe des Wuerfels.
4995 Es treten 3 Familien von Unbestimmten auf. Die erste Familie
4996 bezieht sich auf Gruppenaktion auf der Menge der Knoten, die zweite
4997 auf der Menge der Kanten und die dritte auf der Menge der Flaechen
4998 des Wuerfels. */
4999 {
5000     OP a,b,koef,vektor,hilf;
5001     INT i;
5002     INT erg=OK;
5003     koef=callocobject();
5004     vektor=callocobject();
5005     hilf=callocobject();
5006     a=callocobject();
5007     b=callocobject();
5008     erg+=m_ioiu_b(1L,24L,koef);
5009     erg+=m_il_v(16L,vektor);
5010     for (i=0L;i<S_V_LI(vektor);++i)
5011     M_I_I(0L,S_V_I(vektor,i));
5012     M_I_I(8L,S_V_I(vektor,0L));
5013     M_I_I(12L,S_V_I(vektor,6L));
5014     M_I_I(6L,S_V_I(vektor,12L));
5015     erg+=m_skn_po(vektor,koef,NULL,a);
5016     erg+=m_ioiu_b(1L,3L,koef);
5017     M_I_I(2L,S_V_I(vektor,0L));
5018     M_I_I(2L,S_V_I(vektor,2L));
5019     M_I_I(0L,S_V_I(vektor,6L));
5020     M_I_I(4L,S_V_I(vektor,8L));
5021     M_I_I(0L,S_V_I(vektor,12L));
5022     M_I_I(2L,S_V_I(vektor,14L));
5023     erg+=m_skn_po(vektor,koef,NULL,hilf);
5024     erg+=add(hilf,a,a);
5025     erg+=m_ioiu_b(1L,8L,koef);
5026     M_I_I(0L,S_V_I(vektor,0L));
5027     M_I_I(4L,S_V_I(vektor,1L));
5028     M_I_I(0L,S_V_I(vektor,2L));
5029     M_I_I(6L,S_V_I(vektor,7L));
5030     M_I_I(0L,S_V_I(vektor,8L));
5031     M_I_I(2L,S_V_I(vektor,12L));
5032     M_I_I(2L,S_V_I(vektor,13L));
5033     M_I_I(0L,S_V_I(vektor,14L));
5034     erg+=m_skn_po(vektor,koef,NULL,hilf);
5035     erg+=add(hilf,a,a);
5036     erg+=m_ioiu_b(1L,4L,koef);
5037     M_I_I(2L,S_V_I(vektor,6L));
5038     M_I_I(5L,S_V_I(vektor,7L));
5039     M_I_I(0L,S_V_I(vektor,8L));
5040     M_I_I(0L,S_V_I(vektor,12L));
5041     M_I_I(3L,S_V_I(vektor,13L));
5042     erg+=m_skn_po(vektor,koef,NULL,hilf);
5043     erg+=add(hilf,a,a);
5044     M_I_I(0L,S_V_I(vektor,1L));
5045     M_I_I(2L,S_V_I(vektor,3L));
5046     M_I_I(0L,S_V_I(vektor,6L));
5047     M_I_I(0L,S_V_I(vektor,7L));
5048     M_I_I(3L,S_V_I(vektor,9L));
5049     M_I_I(2L,S_V_I(vektor,12L));
5050     M_I_I(0L,S_V_I(vektor,13L));
5051     M_I_I(1L,S_V_I(vektor,15L));
5052     erg+=m_skn_po(vektor,koef,NULL,hilf);
5053     erg+=add(hilf,a,a);
5054     erg+=m_il_v(3L,b);
5055     M_I_I(0L,S_V_I(b,0L));
5056     M_I_I(6L,S_V_I(b,1L));
5057     M_I_I(12L,S_V_I(b,2L));
5058     erg+=freeall(hilf); erg+=freeall(vektor); erg+=freeall(koef);
5059     erg+=m_v_po_mz(b,a,aa);
5060     erg+=freeall(a); erg+=freeall(b);
5061     if (erg != OK) error(" in computation of zykelind_cube(a) ");
5062     return(erg);
5063 }
5064 
zykelind_cube_extended(aa)5065 INT zykelind_cube_extended(aa) OP aa;
5066 {
5067     OP a,koef,vektor,hilf;
5068     INT i;
5069     INT erg=OK;
5070     koef=callocobject();
5071     vektor=callocobject();
5072     hilf=callocobject();
5073     erg+=zykelind_cube(aa);
5074     a=s_mz_po(aa);
5075     erg+=m_ioiu_b(1L,2L,koef);
5076     erg+=m_scalar_polynom(koef,hilf);
5077     erg+=mult(hilf,a,a);
5078     erg+=m_ioiu_b(1L,8L,koef);
5079     erg+=m_il_v(18L,vektor);
5080     for (i=0L;i<S_V_LI(vektor);++i) M_I_I(0L,S_V_I(vektor,i));
5081     M_I_I(4L,S_V_I(vektor,0L));
5082     M_I_I(2L,S_V_I(vektor,1L));
5083     M_I_I(2L,S_V_I(vektor,6L));
5084     M_I_I(5L,S_V_I(vektor,7L));
5085     M_I_I(2L,S_V_I(vektor,12L));
5086     M_I_I(2L,S_V_I(vektor,13L));
5087     erg+=m_skn_po(vektor,koef,NULL,hilf);
5088     erg+=add(hilf,a,a);
5089     M_I_I(0L,S_V_I(vektor,0L));
5090     M_I_I(0L,S_V_I(vektor,1L));
5091     M_I_I(2L,S_V_I(vektor,3L));
5092     M_I_I(0L,S_V_I(vektor,6L));
5093     M_I_I(0L,S_V_I(vektor,7L));
5094     M_I_I(3L,S_V_I(vektor,9L));
5095     M_I_I(0L,S_V_I(vektor,12L));
5096     M_I_I(1L,S_V_I(vektor,13L));
5097     M_I_I(1L,S_V_I(vektor,15L));
5098     erg+=m_skn_po(vektor,koef,NULL,hilf);
5099     erg+=add(hilf,a,a);
5100     erg+=m_ioiu_b(1L,48L,koef);
5101     M_I_I(4L,S_V_I(vektor,1L));
5102     M_I_I(0L,S_V_I(vektor,3L));
5103     M_I_I(6L,S_V_I(vektor,7L));
5104     M_I_I(0L,S_V_I(vektor,9L));
5105     M_I_I(3L,S_V_I(vektor,13L));
5106     M_I_I(0L,S_V_I(vektor,15L));
5107     erg+=m_skn_po(vektor,koef,NULL,hilf);
5108     erg+=add(hilf,a,a);
5109     erg+=m_ioiu_b(1L,16L,koef);
5110     M_I_I(4L,S_V_I(vektor,6L));
5111     M_I_I(4L,S_V_I(vektor,7L));
5112     M_I_I(4L,S_V_I(vektor,12L));
5113     M_I_I(1L,S_V_I(vektor,13L));
5114     erg+=m_skn_po(vektor,koef,NULL,hilf);
5115     erg+=add(hilf,a,a);
5116     erg+=m_ioiu_b(1L,6L,koef);
5117     M_I_I(1L,S_V_I(vektor,1L));
5118     M_I_I(1L,S_V_I(vektor,5L));
5119     M_I_I(0L,S_V_I(vektor,6L));
5120     M_I_I(0L,S_V_I(vektor,7L));
5121     M_I_I(2L,S_V_I(vektor,11L));
5122     M_I_I(0L,S_V_I(vektor,12L));
5123     M_I_I(0L,S_V_I(vektor,13L));
5124     M_I_I(1L,S_V_I(vektor,17L));
5125     erg+=m_skn_po(vektor,koef,NULL,hilf);
5126     erg+=add(hilf,a,a);
5127     erg+=freeall(hilf);
5128     erg+=freeall(vektor);
5129     erg+=freeall(koef);
5130     if (erg != OK) error(" in computation of zykelind_cube_extended(a) ");
5131     return(erg);
5132 }
5133 
zykelind_cube_vertices(a)5134 INT zykelind_cube_vertices(a) OP a;
5135 {
5136     OP b,c,d;
5137     INT erg=OK;
5138     if (not EMPTYP(a)) erg+=freeself(a);
5139     b=callocobject();
5140     d=callocobject();
5141     erg+=zykelind_cube(b);
5142     c=s_mz_v(b);
5143     erg+=m_il_v(1L,d);
5144     M_I_I(1L,S_V_I(d,0L));
5145     erg+=mz_extrahieren(b,d,a);
5146     erg+=freeall(b); erg+=freeall(d);
5147     if (erg != OK) error(" in computation of zykelind_cube_vertices(a) ");
5148     return(erg);
5149 }
5150 
zykelind_cube_edges(a)5151 INT zykelind_cube_edges(a) OP a;
5152 {
5153     OP b,c,d;
5154     INT erg=OK;
5155     if (not EMPTYP(a)) erg+=freeself(a);
5156     b=callocobject();
5157     d=callocobject();
5158     erg+=zykelind_cube(b);
5159     c=s_mz_v(b);
5160     erg+=m_il_v(1L,d);
5161     M_I_I(2L,S_V_I(d,0L));
5162     erg+=mz_extrahieren(b,d,a);
5163     erg+=freeall(b); erg+=freeall(d);
5164     if (erg != OK) error(" in computation of zykelind_cube_edges(a) ");
5165     return(erg);
5166 }
5167 
zykelind_cube_faces(a)5168 INT zykelind_cube_faces(a) OP a;
5169 {
5170     OP b,c,d;
5171     INT erg=OK;
5172     if (not EMPTYP(a)) erg+=freeself(a);
5173     b=callocobject();
5174     d=callocobject();
5175     erg+=zykelind_cube(b);
5176     c=s_mz_v(b);
5177     erg+=m_il_v(1L,d);
5178     M_I_I(3L,S_V_I(d,0L));
5179     erg+=mz_extrahieren(b,d,a);
5180     erg+=freeall(b); erg+=freeall(d);
5181     if (erg != OK) error(" in computation of zykelind_cube_faces(a) ");
5182     return(erg);
5183 }
5184 
zykelind_cube_vertices_extended(a)5185 INT zykelind_cube_vertices_extended(a) OP a;
5186 {
5187     OP b,c,d;
5188     INT erg=OK;
5189     if (not EMPTYP(a)) erg+=freeself(a);
5190     b=callocobject();
5191     d=callocobject();
5192     erg+=zykelind_cube_extended(b);
5193     c=s_mz_v(b);
5194     erg+=m_il_v(1L,d);
5195     M_I_I(1L,S_V_I(d,0L));
5196     erg+=mz_extrahieren(b,d,a);
5197     erg+=freeall(b); erg+=freeall(d);
5198     if (erg != OK) error(" in computation of zykelind_cube_vertices_extended(a) ");
5199     return(erg);
5200 }
5201 
zykelind_cube_edges_extended(a)5202 INT zykelind_cube_edges_extended(a) OP a;
5203 {
5204     OP b,c,d;
5205     INT erg=OK;
5206     if (not EMPTYP(a)) erg+=freeself(a);
5207     b=callocobject();
5208     d=callocobject();
5209     erg+=zykelind_cube_extended(b);
5210     c=s_mz_v(b);
5211     erg+=m_il_v(1L,d);
5212     M_I_I(2L,S_V_I(d,0L));
5213     erg+=mz_extrahieren(b,d,a);
5214     erg+=freeall(b); erg+=freeall(d);
5215     if (erg != OK) error(" in computation of zykelind_cube_edges_extended(a) ");
5216     return(erg);
5217 }
5218 
zykelind_cube_faces_extended(a)5219 INT zykelind_cube_faces_extended(a) OP a;
5220 {
5221     OP b,c,d;
5222     INT erg=OK;
5223     if (not EMPTYP(a)) erg+=freeself(a);
5224     b=callocobject();
5225     d=callocobject();
5226     erg+=zykelind_cube_extended(b);
5227     c=s_mz_v(b);
5228     erg+=m_il_v(1L,d);
5229     M_I_I(3L,S_V_I(d,0L));
5230     erg+=mz_extrahieren(b,d,a);
5231     erg+=freeall(b); erg+=freeall(d);
5232     if (erg != OK) error(" in computation of zykelind_cube_faces_extended(a) ");
5233     return(erg);
5234 }
5235 
zykelind_dodecahedron(aa)5236 INT zykelind_dodecahedron(aa) OP aa;
5237 /* Berechnet den Zyklenzeiger der Drehgruppe des Dodecaeders.
5238 Es treten 3 Familien von Unbestimmten auf. Die erste Familie
5239 bezieht sich auf Gruppenaktion auf der Menge der Knoten, die zweite
5240 auf der Menge der Kanten und die dritte auf der Menge der Flaechen
5241 des Dodecaeders.  */
5242 {
5243     OP a,b,koef,vektor,hilf;
5244     INT i;
5245     INT erg=OK;
5246     koef=callocobject();
5247     vektor=callocobject();
5248     hilf=callocobject();
5249     a=callocobject();
5250     b=callocobject();
5251     erg+=m_ioiu_b(1L,60L,koef);
5252     erg+=m_il_v(25L,vektor);
5253     for (i=0L;i<S_V_LI(vektor);++i)
5254     M_I_I(0L,S_V_I(vektor,i));
5255     M_I_I(20L,S_V_I(vektor,0L));
5256     M_I_I(30L,S_V_I(vektor,10L));
5257     M_I_I(12L,S_V_I(vektor,20L));
5258     erg+=m_skn_po(vektor,koef,NULL,a);
5259     erg+=m_ioiu_b(1L,3L,koef);
5260     M_I_I(2L,S_V_I(vektor,0L));
5261     M_I_I(6L,S_V_I(vektor,2L));
5262     M_I_I(0L,S_V_I(vektor,10L));
5263     M_I_I(10L,S_V_I(vektor,12L));
5264     M_I_I(0L,S_V_I(vektor,20L));
5265     M_I_I(4L,S_V_I(vektor,22L));
5266     erg+=m_skn_po(vektor,koef,NULL,hilf);
5267     erg+=add(hilf,a,a);
5268     erg+=m_ioiu_b(1L,4L,koef);
5269     M_I_I(0L,S_V_I(vektor,0L));
5270     M_I_I(10L,S_V_I(vektor,1L));
5271     M_I_I(0L,S_V_I(vektor,2L));
5272     M_I_I(2L,S_V_I(vektor,10L));
5273     M_I_I(14L,S_V_I(vektor,11L));
5274     M_I_I(0L,S_V_I(vektor,12L));
5275     M_I_I(6L,S_V_I(vektor,21L));
5276     M_I_I(0L,S_V_I(vektor,22L));
5277     erg+=m_skn_po(vektor,koef,NULL,hilf);
5278     erg+=add(hilf,a,a);
5279     erg+=m_ioiu_b(2L,5L,koef);
5280     M_I_I(0L,S_V_I(vektor,1L));
5281     M_I_I(4L,S_V_I(vektor,4L));
5282     M_I_I(0L,S_V_I(vektor,10L));
5283     M_I_I(0L,S_V_I(vektor,11L));
5284     M_I_I(6L,S_V_I(vektor,14L));
5285     M_I_I(2L,S_V_I(vektor,20L));
5286     M_I_I(0L,S_V_I(vektor,21L));
5287     M_I_I(2L,S_V_I(vektor,24L));
5288     erg+=m_skn_po(vektor,koef,NULL,hilf);
5289     erg+=add(hilf,a,a);
5290     erg+=m_il_v(3L,b);
5291     M_I_I(0L,S_V_I(b,0L));
5292     M_I_I(10L,S_V_I(b,1L));
5293     M_I_I(20L,S_V_I(b,2L));
5294     erg+=freeall(hilf);
5295     erg+=freeall(vektor);
5296     erg+=freeall(koef);
5297     m_v_po_mz(b,a,aa);
5298     erg+=freeall(a); erg+=freeall(b);
5299     if (erg != OK) error(" in computation of zykelind_dodecahedron(a) ");
5300     return(erg);
5301 }
5302 
zykelind_dodecahedron_extended(aa)5303 INT zykelind_dodecahedron_extended(aa) OP aa;
5304 {
5305     OP a,koef,vektor,hilf;
5306     INT i;
5307     INT erg=OK;
5308     koef=callocobject();
5309     vektor=callocobject();
5310     hilf=callocobject();
5311     erg+=zykelind_dodecahedron(aa);
5312     a=s_mz_po(aa);
5313     erg+=m_ioiu_b(1L,2L,koef);
5314     erg+=m_scalar_polynom(koef,hilf);
5315     erg+=mult(hilf,a,a);
5316     erg+=m_ioiu_b(1L,120L,koef);
5317     erg+=m_il_v(30L,vektor);
5318     for (i=0L;i<S_V_LI(vektor);++i) M_I_I(0L,S_V_I(vektor,i));
5319     M_I_I(10L,S_V_I(vektor,1L));
5320     M_I_I(15L,S_V_I(vektor,11L));
5321     M_I_I(6L,S_V_I(vektor,21L));
5322     erg+=m_skn_po(vektor,koef,NULL,hilf);
5323     erg+=add(hilf,a,a);
5324     erg+=m_ioiu_b(1L,6L,koef);
5325     M_I_I(1L,S_V_I(vektor,1L));
5326     M_I_I(3L,S_V_I(vektor,5L));
5327     M_I_I(0L,S_V_I(vektor,11L));
5328     M_I_I(5L,S_V_I(vektor,15L));
5329     M_I_I(0L,S_V_I(vektor,21L));
5330     M_I_I(2L,S_V_I(vektor,25L));
5331     erg+=m_skn_po(vektor,koef,NULL,hilf);
5332     erg+=add(hilf,a,a);
5333     erg+=m_ioiu_b(1L,8L,koef);
5334     M_I_I(4L,S_V_I(vektor,0L));
5335     M_I_I(8L,S_V_I(vektor,1L));
5336     M_I_I(0L,S_V_I(vektor,5L));
5337     M_I_I(4L,S_V_I(vektor,10L));
5338     M_I_I(13L,S_V_I(vektor,11L));
5339     M_I_I(0L,S_V_I(vektor,15L));
5340     M_I_I(4L,S_V_I(vektor,20L));
5341     M_I_I(4L,S_V_I(vektor,21L));
5342     M_I_I(0L,S_V_I(vektor,25L));
5343     erg+=m_skn_po(vektor,koef,NULL,hilf);
5344     erg+=add(hilf,a,a);
5345     erg+=m_ioiu_b(1L,5L,koef);
5346     M_I_I(0L,S_V_I(vektor,0L));
5347     M_I_I(0L,S_V_I(vektor,1L));
5348     M_I_I(2L,S_V_I(vektor,9L));
5349     M_I_I(0L,S_V_I(vektor,10L));
5350     M_I_I(0L,S_V_I(vektor,11L));
5351     M_I_I(3L,S_V_I(vektor,19L));
5352     M_I_I(0L,S_V_I(vektor,20L));
5353     M_I_I(1L,S_V_I(vektor,21L));
5354     M_I_I(1L,S_V_I(vektor,29L));
5355     erg+=m_skn_po(vektor,koef,NULL,hilf);
5356     erg+=add(hilf,a,a);
5357     erg+=freeall(hilf);
5358     erg+=freeall(vektor);
5359     erg+=freeall(koef);
5360     if (erg != OK) error(" in computation of zykelind_dodecahedron_extended(a) ");
5361     return(erg);
5362 }
5363 
zykelind_dodecahedron_vertices(a)5364 INT zykelind_dodecahedron_vertices(a) OP a;
5365 {
5366     OP b,c,d;
5367     INT erg=OK;
5368     if (not EMPTYP(a)) erg+=freeself(a);
5369     b=callocobject();
5370     d=callocobject();
5371     erg+=zykelind_dodecahedron(b);
5372     c=s_mz_po(b);
5373     erg+=m_il_v(1L,d);
5374     M_I_I(1L,S_V_I(d,0L));
5375     erg+=mz_extrahieren(b,d,a);
5376     erg+=freeall(b); erg+=freeall(d);
5377     if (erg != OK) error(" in computation of zykelind_dodecahedron_vertices(a) ");
5378     return(erg);
5379 }
5380 
zykelind_dodecahedron_edges(a)5381 INT zykelind_dodecahedron_edges(a) OP a;
5382 {
5383     OP b,c,d;
5384     INT erg=OK;
5385     if (not EMPTYP(a)) erg+=freeself(a);
5386     b=callocobject();
5387     d=callocobject();
5388     erg+=zykelind_dodecahedron(b);
5389     c=s_mz_po(b);
5390     erg+=m_il_v(1L,d);
5391     M_I_I(2L,S_V_I(d,0L));
5392     erg+=mz_extrahieren(b,d,a);
5393     erg+=freeall(b); erg+=freeall(d);
5394     if (erg != OK) error(" in computation of zykelind_dodecahedron_edges(a) ");
5395     return(erg);
5396 }
5397 
zykelind_dodecahedron_faces(a)5398 INT zykelind_dodecahedron_faces(a) OP a;
5399 {
5400     OP b,c,d;
5401     INT erg=OK;
5402     if (not EMPTYP(a)) erg+=freeself(a);
5403     b=callocobject();
5404     d=callocobject();
5405     erg+=zykelind_dodecahedron(b);
5406     c=s_mz_po(b);
5407     erg+=m_il_v(1L,d);
5408     M_I_I(3L,S_V_I(d,0L));
5409     erg+=mz_extrahieren(b,d,a);
5410     erg+=freeall(b); erg+=freeall(d);
5411     if (erg != OK) error(" in computation of zykelind_dodecahedron_faces(a) ");
5412     return(erg);
5413 }
5414 
zykelind_dodecahedron_vertices_extended(a)5415 INT zykelind_dodecahedron_vertices_extended(a) OP a;
5416 {
5417     OP b,c,d;
5418     INT erg=OK;
5419     if (not EMPTYP(a)) erg+=freeself(a);
5420     b=callocobject();
5421     d=callocobject();
5422     erg+=zykelind_dodecahedron_extended(b);
5423     c=s_mz_po(b);
5424     erg+=m_il_v(1L,d);
5425     M_I_I(1L,S_V_I(d,0L));
5426     erg+=mz_extrahieren(b,d,a);
5427     erg+=freeall(b); erg+=freeall(d);
5428     if (erg != OK) error(" in computation of zykelind_dodecahedron_vertices_extended(a) ");
5429     return(erg);
5430 }
5431 
zykelind_dodecahedron_edges_extended(a)5432 INT zykelind_dodecahedron_edges_extended(a) OP a;
5433 {
5434     OP b,c,d;
5435     INT erg=OK;
5436     if (not EMPTYP(a)) erg+=freeself(a);
5437     b=callocobject();
5438     d=callocobject();
5439     erg+=zykelind_dodecahedron_extended(b);
5440     c=s_mz_po(b);
5441     erg+=m_il_v(1L,d);
5442     M_I_I(2L,S_V_I(d,0L));
5443     erg+=mz_extrahieren(b,d,a);
5444     erg+=freeall(b);
5445     erg+=freeall(d);
5446     if (erg != OK) error(" in computation of zykelind_dodecahedron_edges_extended(a) ");
5447     return(erg);
5448 }
5449 
zykelind_dodecahedron_faces_extended(a)5450 INT zykelind_dodecahedron_faces_extended(a) OP a;
5451 {
5452     OP b,c,d;
5453     INT erg=OK;
5454     if (not EMPTYP(a)) erg+=freeself(a);
5455     b=callocobject();
5456     d=callocobject();
5457     erg+=zykelind_dodecahedron_extended(b);
5458     c=s_mz_po(b);
5459     erg+=m_il_v(1L,d);
5460     M_I_I(3L,S_V_I(d,0L));
5461     erg+=mz_extrahieren(b,d,a);
5462     erg+=freeall(b); erg+=freeall(d);
5463     if (erg != OK) error(" in computation of zykelind_dodecahedron_faces_extended(a) ");
5464     return(erg);
5465 }
5466 
polya_multi_sub(aa,b)5467 INT polya_multi_sub(aa,b) OP aa,b;
5468 /* aa ist ein Zyklenzeiger mit mehreren Familien von Unbestimmten.
5469 In der i-ten Familie wird die Unbestimmte x_j durch
5470 den Ausdruck 1+y_i^j ersetzt, wobei y_i ebenfalls Unbestimmte sind.
5471 b ist das Resultat nach dieser Substitution.  */
5472 {
5473     OP a,c,d,e,f,g,h,subvect;
5474     INT i,j,k;
5475     INT erg=OK;
5476     CTO(VECTOR,"polya_multi_sub",aa);
5477     a=s_mz_po(aa);
5478     c=s_mz_v(aa);
5479     if (S_O_K(a)!=POLYNOM) return error("polya_multi_sub(a,b) s_mz_po(a) not POLYNOM");
5480     if (S_O_K(c)!=VECTOR) return error("polya_multi_sub(a,b) s_mz_v(a) not VECTOR");
5481     for (i=0L;i<S_V_LI(c);++i)
5482     {
5483       if (S_O_K(S_V_I(c,i))!=INTEGER) return error("polya_multi_sub(a,b) Elements of s_mz_v(a) not INTEGER");
5484     }
5485     for (i=1L;i<S_V_LI(c);++i)
5486     {
5487       if (S_V_II(c,i)<=S_V_II(c,i-1L)) return error("polya_multi_sub(a,b) Elements of s_mz_v(a) not increasing");
5488     }
5489     if (not EMPTYP(b)) erg+=freeself(b);
5490         d=callocobject();
5491     subvect=callocobject();
5492     e=callocobject();
5493     f=callocobject();
5494     g=callocobject();
5495     h=callocobject();
5496     erg+=numberofvariables(a,h);
5497     M_I_I(1L,d);
5498     erg += m_scalar_polynom(d,e);
5499 /*    M_I_I(1L,d);*/
5500     erg += m_il_v(0L,subvect);
5501     for (j=0L;j<S_V_LI(c);++j)
5502     {
5503     erg += m_il_v(j+1L,f);
5504     M_I_I(1L,S_V_I(f,j));
5505     for (k=0L;k<j;++k) M_I_I(0L,S_V_I(f,k));
5506     erg+=m_skn_po(f,d,NULL,g);
5507     if (j<S_V_LI(c)-1L)
5508     {
5509     for (i=S_V_II(c,j);i<S_V_II(c,j+1L);i++)
5510         {
5511         erg+=inc(subvect);
5512         erg += add(e,g,f);
5513         erg+=copy(f,S_V_I(subvect,S_V_LI(subvect)-1L));
5514         erg += inc(S_V_I(S_PO_S(g),j));
5515         }
5516     }
5517     else
5518     {
5519     for (i=S_V_II(c,j);i<S_I_I(h);i++)
5520         {
5521         erg+=inc(subvect);
5522         erg += add(e,g,f);
5523         erg+=copy(f,S_V_I(subvect,S_V_LI(subvect)-1L));
5524         erg += inc(S_V_I(S_PO_S(g),j));
5525         }
5526     }
5527     }
5528     erg += eval_polynom(a,subvect,b);
5529     erg += freeall(subvect);
5530     erg += freeall(h);
5531     erg += freeall(d);
5532     erg += freeall(e);
5533     erg += freeall(f);
5534     erg += freeall(g);
5535     ENDR("polya_multi_sub");
5536 }
5537 
polya_multi_const_sub(aa,d,b)5538 INT polya_multi_const_sub(aa,d,b) OP aa,b,d;
5539 /* aa ist ein Zyklenzeiger mit mehreren Familien von Unbestimmten.
5540 d ist ein Vektor Objekt dessen Laenge der Anzahl der verschiedenen
5541 Familien von Unbestimmten in aa entspricht.
5542 Die Eintragungen in d sind Integer Objekte.
5543 In der i-ten Familie werden die Unbestimmten durch die Ausdruck
5544 S_V_I(d,i-1L) ersetzt.
5545 b ist das Resultat nach dieser Substitution.  */
5546 {
5547     OP a,c,h,subvect;
5548     INT i,j;
5549     INT erg=OK;
5550     if (S_O_K(aa)!=VECTOR) return error("polya_multi_const_sub(a,d,b) a not a cycle index in several alphabets");
5551     a=s_mz_po(aa);
5552     c=s_mz_v(aa);
5553     if (S_O_K(a)!=POLYNOM) return error("polya_multi_const_sub(a,d,b) s_mz_po(a) not POLYNOM");
5554     if (S_O_K(c)!=VECTOR) return error("polya_multi_const_sub(a,d,b) s_mz_v(a) not VECTOR");
5555     for (i=0L;i<S_V_LI(c);++i)
5556     {
5557       if (S_O_K(S_V_I(c,i))!=INTEGER) return error("polya_multi_const_sub(a,d,b) Elements of s_mz_v(a) not INTEGER");
5558     }
5559     for (i=1L;i<S_V_LI(c);++i)
5560     {
5561       if (S_V_II(c,i)<=S_V_II(c,i-1L)) return error("polya_multi_const_sub(a,d,b) Elements of s_mz_v(a) not increasing");
5562     }
5563     if (S_O_K(d)!=VECTOR) return error("polya_multi_const_sub(a,d,b) d not VECTOR");
5564     if (S_V_LI(c) != S_V_LI(d)) return error("polya_multi_const_sub(a,d,b) s_mz_v(a) and d Vectors not of the same length");
5565     for (i=0L;i<S_V_LI(d);++i)
5566     {
5567       if (S_O_K(S_V_I(d,i))!=INTEGER) return error("polya_multi_const_sub(a,d,b) Elements of d not INTEGER");
5568     }
5569     if (not EMPTYP(b)) erg+=freeself(b);
5570     subvect=callocobject();
5571     h=callocobject();
5572     erg+=numberofvariables(a,h);
5573     erg += m_l_v(h,subvect);
5574     for (j=0L;j<S_V_LI(c);++j)
5575     {
5576     if (j<S_V_LI(c)-1L)
5577     {
5578     for (i=S_V_II(c,j);i<S_V_II(c,j+1L);i++)
5579         {
5580         erg+=copy(S_V_I(d,j),S_V_I(subvect,i));
5581         }
5582         }
5583     else
5584     {
5585     for (i=S_V_II(c,j);i<S_I_I(h);i++)
5586         {
5587         erg+=copy(S_V_I(d,j),S_V_I(subvect,i));
5588         }
5589     }
5590         }
5591     erg += eval_polynom(a,subvect,b);
5592     erg += freeall(subvect);
5593     erg += freeall(h);
5594     if (erg != OK)
5595         return error("polya_multi_const_sub: error during computation");
5596     return erg;
5597 }
5598 
zykelind_test1()5599 static INT zykelind_test1()
5600 {
5601     INT erg=OK;
5602     OP a=callocobject();
5603     OP b=callocobject();
5604     OP c=callocobject();
5605     OP d=callocobject();
5606     OP e=callocobject();
5607     m_i_i(4L,a);
5608     m_i_i(3L,b);
5609     erg+=zykelind_Sn(a,c);
5610     erg+=zykelind_Sn(b,d);
5611     printf("Exponentiation S4 \\wr S3\n");
5612     erg+=zykelind_exponentiation(c,d,e);
5613     println(e);
5614     printf("Zyklenzeiger GL(4,F_3)\n");
5615     erg+=zykelind_glkq(a,b,e);
5616     println(e);
5617     printf("Ordnung Aff(4,F_3)\n");
5618     erg+=ordnung_affkq(a,b,e);
5619     println(e);
5620     printf("Anzahl aller irreduzibler Polynome vom Grad 4 ueber F_3\n");
5621     erg+=number_of_irred_poly_of_degree(a,b,e);
5622     println(e);
5623     m_i_i(6L,b);
5624     printf("Zykelindex Aff(4,Z_6)\n");
5625     erg+=zykelind_affkzn(a,b,e);
5626     println(e);
5627     printf("Zykelindex Aff(1,Z_4)\n");
5628     erg+=zykelind_aff1Zn(a,e);
5629     println(e);
5630     m_i_i(3L,b);
5631     printf("Zykelindex PGL(4,F_3)\n");
5632     erg+=zykelind_pglkq(a,b,e);
5633     println(e);
5634     m_i_i(8L,b);
5635     printf("Zyklenzeiger des Zentralisators der Permutation ");
5636     random_permutation(a,c);
5637     println(c);
5638     erg+=zykelind_centralizer(c,e);
5639     println(e);
5640     printf("Zyklenzeiger des Stablisators der Partition ");
5641     random_partition(a,c);
5642     t_VECTOR_EXPONENT(c,c);
5643     println(c);
5644     erg+=zykelind_stabilizer_part(c,e);
5645     println(e);
5646     printf("Stirling Zahlen 2. Art\n");
5647     erg+=stirling_numbers_second_kind_vector(a,e);
5648     println(e);
5649     printf("Redfield Operatoren\n");
5650     m_il_v(2l,a);
5651     zykelind_Dn(b,S_V_I(a,0L));
5652     zykelind_An(b,S_V_I(a,1L));
5653     erg+=redf_cup(a,e);
5654     println(e);
5655     erg+=redf_cap(a,e);
5656     println(e);
5657     m_il_v(2L,b);
5658     m_i_i(3L,S_V_I(b,0L));
5659     m_i_i(4L,S_V_I(b,1L));
5660     erg+=redf_cup_hoch(a,b,e);
5661     println(e);
5662     erg+=redf_cap_hoch(a,b,e);
5663     println(e);
5664     erg+=zykelind_cube_extended(a);
5665     erg+=mz_vereinfachen(a,e);
5666     printf("Vereinfachen eines Multidim. Zyklenzeigers\n");
5667     println(a);println(e);
5668     m_i_i(1L,S_V_I(b,0L));
5669     m_i_i(3L,S_V_I(b,1L));
5670     printf("Extrahieren der 1. und 3. Familie von Variablen eines Multidim. Zyklenzeigers\n");
5671     erg+=mz_extrahieren(a,b,e);
5672     println(e);
5673     freeall(a);
5674     freeall(b);
5675     freeall(c);
5676     freeall(d);
5677     freeall(e);
5678     ENDR("zykelind_test1");
5679 }
5680 #endif /* POLYTRUE */
5681