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