1 /* SYMMETRICA sr.c */
2
3 #include "def.h"
4 #include "macro.h"
5
6
7 static OP mahh_h = NULL;
8 static INT add_schur_schur_co();
9 static INT scan_schur_co();
10 INT splitpart();
11
12
schur_ende()13 INT schur_ende() /* AK 100692 */
14 {
15 INT erg = OK;
16 INT thp_ende(),thm_ende(),tmh_ende(),tep_ende(),teh_ende(),tem_ende();
17 INT mps_ende(),mem_ende(),mpp_ende(),mmm_ende(),mss_ende();
18 INT mes_ende(),tme_ende();
19
20 erg += thp_ende();
21 erg += thm_ende();
22 erg += tmh_ende();
23 erg += tme_ende();
24 erg += tep_ende();
25 erg += teh_ende();
26 erg += tem_ende();
27 erg += mem_ende();
28 erg += mpp_ende();
29 erg += mps_ende();
30 erg += mmm_ende();
31 erg += mss_ende();
32 erg += mes_ende();
33 if (mahh_h != NULL) {
34 FREEALL(mahh_h);
35 mahh_h=NULL;
36 }
37 ENDR("schur_ende");
38 }
39
schnitt_schur(a,b,c)40 INT schnitt_schur(a,b,c) OP a,b,c;
41 /* gemeinsame bestandteile der schurfunktionen a und b nach c*/
42 /* AK 310789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
43 {
44 OP zeigera, zeigerb;
45 INT erg=OK,e;
46 CTO(SCHUR,"schnitt_schur(1)",a);
47 CTO(SCHUR,"schnitt_schur(2)",b);
48
49 CE3(a,b,c,schnitt_schur);
50
51 zeigera=a; zeigerb=b;
52 while(zeigera != NULL && zeigerb !=NULL)
53 {
54 e = comp(S_S_S(zeigera),S_S_S(zeigerb));
55 if (e == (INT)0)
56 {
57 OP neu = callocobject();
58 erg += m_pa_s(S_S_S(zeigera),neu); /* AK 201192 */
59 if (ge(S_S_K(zeigerb),S_S_K(zeigera)))
60 erg += copy(S_S_K(zeigera),S_S_K(neu));
61 else
62 erg += copy(S_S_K(zeigerb),S_S_K(neu));
63
64 insert(neu,c,add_koeff,comp);
65 zeigera=S_S_N(zeigera);
66 zeigerb=S_S_N(zeigerb);
67 }
68 else if (e < (INT)0) zeigera=S_S_N(zeigera);
69 else if (e > (INT)0) zeigerb=S_S_N(zeigerb);
70 };
71 ENDR("schnitt_schur");
72 }
73
74
einsp_symfunc(p)75 INT einsp_symfunc(p) OP p;
76 /*
77 return TRUE if constant and coeff is eins
78 */
79 /* AK 181103 */
80 {
81 OP z;
82 FORALL(z,p,{
83 if (S_PA_LI(S_MO_S(z)) != 0)
84 {
85 if (not NULLP(S_MO_K(z))) return FALSE;
86 }
87 else
88 {
89 if (not EINSP(S_MO_K(z))) return FALSE;
90 }
91 });
92 return TRUE;
93 }
94
tex_schur(poly)95 INT tex_schur(poly) OP poly;
96 /* AK 101187 */ /* zur ausgabe eines Schurpolynoms */
97 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */
98 /* AK 070291 V1.2 prints to texout */ /* AK 200891 V1.3 */
99 /* AK 021199 works for SCHUR,MONOMIAL,HOMSYM,ELMSYM,POWSYM */
100 {
101 OP zeiger = poly;
102
103 fprintf(texout,"\\ ");
104 if (EMPTYP(poly)) return(OK);
105 while (zeiger != NULL)
106 {
107 if (not einsp (S_S_K(zeiger)))
108 /* der koeffizient wird nur geschrieben wenn er
109 ungleich 1 ist */
110 if (listp(S_S_K(zeiger))) { /* AK 130397 */
111 fprintf(texout,"(");
112 tex(S_S_K(zeiger));
113 fprintf(texout,")");
114 }
115 else {
116 tex(S_S_K(zeiger));
117 }
118
119 if (S_O_K(zeiger) == SCHUR)
120 fprintf(texout,"\\ $S_{ ");
121 else if (S_O_K(zeiger) == MONOMIAL)
122 fprintf(texout,"\\ $m_{ ");
123 else if (S_O_K(zeiger) == HOM_SYM)
124 fprintf(texout,"\\ $h_{ ");
125 else if (S_O_K(zeiger) == POW_SYM)
126 fprintf(texout,"\\ $p_{ ");
127 else if (S_O_K(zeiger) == ELM_SYM)
128 fprintf(texout,"\\ $e_{ ");
129
130 fprint(texout,S_S_S(zeiger));
131 fprintf(texout," } $\\ ");
132 zeiger = S_S_N(zeiger);
133 if (zeiger != NULL) fprintf(texout," $+$ ");
134 texposition += 15;
135 if (texposition >tex_row_length) {
136 fprintf(texout,"\n");
137 texposition = 0;
138 }
139 };
140 fprintf(texout,"\\ ");
141 texposition += 3;
142 return(OK);
143 }
144
compute_skewschur_with_alphabet_det(a,b,c)145 INT compute_skewschur_with_alphabet_det(a,b,c) OP a,b,c;
146 /* skewschurpolyomial with det */
147 /* AK 090790 V1.1 */ /* AK 250291 V1.2 */ /* AK 200891 V1.3 */
148 {
149 INT erg = OK,i,j,gli,kli;
150 OP d,h;
151 CTO(SKEWPARTITION,"compute_skewschur_with_alphabet_det",a);
152 CTO(INTEGER,"compute_skewschur_with_alphabet_det",b);
153 d = callocobject();
154 h = callocobject();
155 gli = S_SPA_GLI(a);
156 kli = S_SPA_KLI(a); /* alt gli */
157 erg += m_ilih_m(gli,gli,d);
158 for (i=(INT)0; i<gli; i++)
159 for (j=(INT)0; j<gli; j++)
160 {
161 if (i >= (gli - kli) )
162 m_i_i(S_SPA_GII(a,j)+j-i-
163 S_SPA_KII(a,i-gli+kli)
164 ,h);
165 else
166 m_i_i(S_SPA_GII(a,j)+j-i,h);
167 erg += compute_complete_with_alphabet(h,b,S_M_IJ(d,i,j));
168 }
169 erg += det_mat_imm(d,c);
170 erg += freeall(d);
171 erg += freeall(h); /* AK 160893 */
172 ENDR("compute_skewschur_with_alphabet_det");
173 }
174
175
176
177
178
compute_schur_with_alphabet_det(a,b,c)179 INT compute_schur_with_alphabet_det(a,b,c) OP a,b,c;
180 /* schurpolyomial with det */
181 /* AK 090790 V1.1 */ /* AK 200891 V1.3 */
182 {
183 INT erg = OK;
184 CTO(PARTITION,"compute_schur_with_alphabet_det(1)",a);
185 CTO(INTEGER,"compute_schur_with_alphabet_det(2)",b);
186 CE3(a,b,c,compute_schur_with_alphabet_det);
187 {
188 OP d,h;
189 INT i,j;
190 d = callocobject();
191 h = callocobject();
192 erg += m_ilih_m(S_PA_LI(a),S_PA_LI(a),d);
193 for (i=(INT)0; i<S_PA_LI(a); i++)
194 for (j=(INT)0; j<S_PA_LI(a); j++)
195 {
196 M_I_I(S_PA_II(a,j)+j-i,h);
197 erg += compute_complete_with_alphabet(h,b,S_M_IJ(d,i,j));
198 }
199 erg += det_mat_imm(d,c);
200 erg += freeall(d);
201 erg += freeall(h); /* fehlte AK 301092 */
202 }
203 ENDR("compute_schur_with_alphabet_det");
204 }
205
206
207
compute_schur(part,res)208 INT compute_schur(part,res) OP part,res;
209 /* AK 161187 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 260291 V1.2 */
210 /* AK 200891 V1.3 */
211 {
212 OP l;
213 INT erg = OK;
214 CTO(PARTITION,"compute_schur(1)",part);
215 l=callocobject();
216 erg += weight( part,l);
217 erg += compute_schur_with_alphabet(part,l,res);
218 erg += freeall(l);
219 ENDR("compute_schur");
220 }
221
t_POLYNOM_MONOMIAL(a,b)222 INT t_POLYNOM_MONOMIAL(a,b) OP a,b;
223 /* assumes a is symmetric */
224 /* AK 080591 V1.2 */ /* AK 200891 V1.3 */
225 {
226 OP c,d,e;
227 INT erg = OK;
228 CTO(POLYNOM,"t_POLYNOM_MONOMIAL(1)",a);
229 CE2(a,b,t_POLYNOM_MONOMIAL);
230 erg += init(MONOMIAL,b);
231 c = callocobject();
232 erg += copy(a,c);
233 e = callocobject();
234 while (not NULLP(c))
235 {
236 d = callocobject();
237 erg += m_v_mon(S_PO_S(c),d);
238 erg += copy(S_PO_K(c),S_S_K(d));
239 erg += compute_monomial_with_alphabet(
240 S_S_S(d),S_V_L(S_PO_S(c)),e);
241 MULT_APPLY(S_PO_K(c),e);
242 erg += sub(c,e,c);
243 INSERT_LIST(d,b,add_koeff,comp_monommonomial);
244 }
245 erg += freeall(e);
246 erg += freeall(c);
247 ENDR("t_POLYNOM_MONOMIAL");
248 }
249
t_POLYNOM_POWER(a,b)250 INT t_POLYNOM_POWER(a,b) OP a,b;
251 /* assumes a is symmetric */
252 /* AK 080591 V1.2 */ /* AK 200891 V1.3 */
253 {
254 OP c,d,e,f=NULL;
255 OP pa,z;
256 INT pain,i;
257 INT erg = OK;
258 CTO(POLYNOM,"t_POLYNOM_POWER",a);
259 CE2(a,b,t_POLYNOM_POWER);
260 if (consp_polynom(a))
261 {
262 erg += m_scalar_powsym(S_PO_K(a),b);
263 goto endr_ende;
264 }
265 FREESELF(b);
266 c = callocobject();
267 erg += copy(a,c);
268 e = callocobject();
269 while (not NULLP(c))
270 {
271 d = callocobject();
272 z = c; pa = c;
273 pain = (INT)0;
274 while (z != NULL)
275 {
276 erg += m_v_pa(S_PO_S(z),d);
277 if ((i=indexofpart(d)) > pain)
278 {
279 pain = i;
280 pa = z;
281 }
282 z = S_PO_N(z);
283 }
284 /* pain ist index der lex kleinsten partition
285 pa der zugehoerige POLYNOM zeiger */
286 erg += m_v_ps(S_PO_S(pa),d);
287 erg += copy(S_PO_K(pa),S_S_K(d));
288 erg += compute_power_with_alphabet(
289 S_S_S(d),S_V_L(S_PO_S(pa)),e);
290 z = e;
291 while (z != NULL)
292 {
293 if (EQ(S_PO_S(z),S_PO_S(pa)))
294 /* find coeff of the leading monom */
295 {
296 f = callocobject();
297 erg += copy(S_PO_K(z),f);
298 erg += invers_apply(f);
299 MULT_APPLY(f,e);
300 break;
301 }
302 z = S_PO_N(z);
303 }
304 erg += mult_apply(S_PO_K(pa),e);
305 erg += sub(c,e,c);
306 erg += mult_apply(f,d); /* AK 020394 */
307 erg += freeall(f);
308 insert(d,b,NULL,NULL);
309 }
310 FREEALL2(e,c);
311 ENDR("t_POLYNOM_POWER");
312 }
313
t_POLYNOM_SCHUR(a,b)314 INT t_POLYNOM_SCHUR(a,b) OP a,b;
315 /* assumes a is symmetric */
316 /* AK 020394 */
317 {
318 OP c;
319 INT erg = OK;
320 CTO(POLYNOM,"t_POLYNOM_SCHUR(1)",a);
321 CE2(a,b,t_POLYNOM_SCHUR);
322 if (consp_polynom(a))
323 {
324 erg += m_scalar_schur(S_PO_K(a),b);
325 goto endr_ende;
326 }
327 init(SCHUR,b); /* AK 080502 */
328 c = callocobject();
329 erg += t_POLYNOM_POWER(a,c);
330 erg += t_POWSYM_SCHUR(c,b);
331 erg += freeall(c);
332 ENDR("t_POLYNOM_SCHUR");
333 }
334
t_POLYNOM_ELMSYM(a,b)335 INT t_POLYNOM_ELMSYM(a,b) OP a,b;
336 /* assumes a is symmetric */
337 /* AK 120995 faster version */
338 /* AK 240603 a,b may be equal */
339 {
340 OP c,d,e,f,g;
341 INT erg = OK;
342 CTO(POLYNOM,"t_POLYNOM_ELMSYM(1)",a);
343 CE2(a,b,t_POLYNOM_ELMSYM);
344
345 erg += init(ELMSYM,b);
346 if (NULLP(a)) goto ee;
347
348 d = callocobject();
349 e = callocobject();
350 f = callocobject();
351 erg += numberofvariables(a,d);
352 erg += copy(a,f);
353 while (not NULLP(f))
354 {
355 c = callocobject();
356 g = callocobject();
357 erg += m_v_pa(S_PO_S(f),c);
358 erg += conjugate(c,c);
359 erg += compute_elmsym_with_alphabet(c,d,e);
360 erg += b_skn_e(c,callocobject(),NULL,g);
361 erg += copy(S_PO_K(f),S_S_K(g));
362 insert(g,b,NULL,NULL);
363 erg += mult_apply(S_PO_K(f),e);
364 erg += sub(f,e,f);
365 }
366
367 FREEALL(d);
368 FREEALL(e);
369 FREEALL(f);
370 ee:
371 ENDR("t_POLYNOM_ELMSYM");
372 }
373
c_m_w_a_vp(a,b,c)374 static INT c_m_w_a_vp(a,b,c) OP a,b,c;
375 /* AK 200891 V1.3 */
376 {
377 OP e,f,g;
378 INT erg = OK,i;
379 e = CALLOCOBJECT();
380 erg += first_permutation(b,e);
381 f = CALLOCOBJECT();
382 m_l_v(b,f);
383 for (i=(INT)0;i<S_I_I(b);i++)
384 if (i < S_PA_LI(a)) M_I_I(S_PA_II(a,i),S_V_I(f,i));
385 else M_I_I((INT)0,S_V_I(f,i));
386 /* f is vector */
387 do
388 {
389 g = CALLOCOBJECT();
390 b_skn_po(CALLOCOBJECT(),CALLOCOBJECT(),NULL,g);
391 M_I_I((INT)1,S_PO_K(g));
392 operate_perm_vector(e,f,S_PO_S(g));
393 insert(g,c,NULL,NULL);
394 } while(next_apply(e));
395
396 /* nur koeff mit 1 */
397 g = c;
398 while (g != NULL)
399 {
400 if (not einsp(S_PO_K(g)))
401 m_i_i((INT)1,S_PO_K(g));
402 g = S_PO_N(g);
403 }
404
405 FREEALL(f);
406 FREEALL(e);
407 ENDR("c_m_w_a_vp");
408 }
409
410
compute_monomial_with_alphabet(number,l,res)411 INT compute_monomial_with_alphabet(number,l,res) OP number,res,l;
412 /* l = length of alphabet */
413 /* AK 090790 V1.1 */ /* AK 090591 V1.2 */ /* AK 200891 V1.3 */
414 /* AK 060498 V2.0 */
415 {
416 INT erg = OK;
417 OP c,z;
418
419
420 CTO(INTEGER,"compute_monomial_with_alphabet(2)",l);
421 CE3(number,l,res,compute_monomial_with_alphabet);
422
423 erg += init(POLYNOM,res);
424 if (S_O_K(number) == PARTITION)
425 {
426 if (S_PA_K(number) != VECTOR)
427 {
428 OP c = callocobject();
429 erg += t_VECTOR_EXPONENT(number,c);
430 erg += compute_monomial_with_alphabet(c,l,res);
431 erg += freeall(c);
432 goto endr_ende;
433 }
434 /* number is VECTOR partition */
435 if (GR(S_PA_L(number),l))
436 goto endr_ende;
437 erg += c_m_w_a_vp(number,l,res);
438 goto endr_ende;
439 }
440 else if (S_O_K(number) == INTEGER)
441 {
442 c = callocobject();
443 erg += m_i_pa(number,c);
444 erg += compute_monomial_with_alphabet(c,l,res);
445 erg += freeall(c);
446 goto endr_ende;
447 }
448 else if (S_O_K(number) == MONOMIAL)
449 {
450 erg += init(POLYNOM,res);
451 if (S_L_S(number) == NULL)
452 goto endr_ende;
453 c = callocobject();
454 z = number;
455 while (z != NULL)
456 {
457 erg += compute_monomial_with_alphabet(S_S_S(z),l,c);
458 erg += mult_apply(S_S_K(z),c);
459 erg += add_apply(c,res);
460 z = S_S_N(z);
461 }
462 erg += freeall(c);
463 goto endr_ende;
464 }
465 else
466 return WTT("compute_monomial_with_alphabet",number,l);
467
468 ENDR("compute_monomial_with_alphabet");
469 }
470
471
compute_complete_with_alphabet(number,l,res)472 INT compute_complete_with_alphabet(number,l,res) OP number,res,l;
473 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 200891 V1.3 */
474 /* number may be INTEGER,PARTITION or HOM_SYM */
475 {
476 OP b,z;
477 INT erg=OK,i;
478 if (not EMPTYP(res))
479 erg += freeself(res);
480
481 if (S_O_K(number) == INTEGER) /* AK 080992 */
482 {
483 if (S_I_I(number) == (INT)0)
484 {
485 M_I_I((INT)1,res);
486 goto endr_ende;
487 }
488 else if (S_I_I(number) < (INT)0 )
489 {
490 M_I_I((INT)0,res);
491 goto endr_ende;
492 }
493
494 b = callocobject();
495 erg += m_i_pa(number,b);
496 erg += compute_schur_with_alphabet(b,l,res);
497 erg += freeall(b);
498 }
499 else if (S_O_K(number) == PARTITION) /* AK 080992 */
500 {
501 if (S_PA_K(number) != VECTOR)
502 return ERROR;
503 m_i_i((INT)1,res);
504 b = callocobject();
505 for (i=(INT)0;i<S_PA_LI(number);i++)
506 {
507 erg += compute_complete_with_alphabet(S_PA_I(number,i),l,b);
508 erg += mult_apply(b,res);
509 erg += freeself(b);
510 }
511 erg += freeall(b);
512 }
513 else if (S_O_K(number) == HOM_SYM)
514 {
515 m_i_i((INT)0,res);
516 b = callocobject();
517 z = number;
518 while (z != NULL)
519 {
520 erg += compute_complete_with_alphabet(S_S_S(z),l,b);
521 erg += mult_apply(S_S_K(z),b);
522 erg += add_apply(b,res);
523 z = S_S_N(z);
524 erg += freeself(b);
525 }
526 erg += freeall(b);
527 }
528 else
529 erg += ERROR;
530 ENDR("compute_complete_with_alphabet");
531 }
532
533
compute_elmsym_with_alphabet(label,l,result)534 INT compute_elmsym_with_alphabet(label,l,result) OP l,label,result;
535 /* AK 120391 V1.2 */ /* AK 200891 V1.3 */
536 {
537 INT erg = OK;
538 INT i;
539 OP zw,z;
540 CTTTO(INTEGER,ELMSYM,PARTITION,"compute_elmsym_with_alphabet(1)",label);
541 CTO(INTEGER,"compute_elmsym_with_alphabet(2)",l);
542 CE3(label,l,result,compute_elmsym_with_alphabet);
543
544 if (S_O_K(label) == INTEGER)
545 {
546 /*
547 erg += init(POLYNOM,result);
548 zw = callocobject();
549 erg += last_partition(label,zw);
550 erg += compute_monomial_with_alphabet(zw,l,result);
551 erg += freeall(zw);
552 */
553 if (S_I_I(label) > S_I_I(l)) {
554 erg += init(POLYNOM,result);
555 goto ende;
556 }
557 zw = CALLOCOBJECT();
558 erg += m_il_nv(S_I_I(l),zw);
559 for (i=0;i<S_I_I(label);i++) M_I_I(1,S_V_I(zw,S_V_LI(zw)-1-i));
560 erg += lehmercode(zw,zw);
561 erg += m_perm_schubert_monom_summe(zw,result);
562 FREEALL(zw);
563 }
564 else if (S_O_K(label) == PARTITION)
565 {
566 zw = callocobject();
567 erg += m_scalar_polynom(cons_eins,result);
568 for (i=(INT)0; i<S_PA_LI(label); i++)
569 {
570 erg += compute_elmsym_with_alphabet(S_PA_I(label,i),
571 l,zw);
572 erg += mult_apply(zw,result);
573 }
574 erg += freeall(zw);
575 }
576 else if (S_O_K(label) == ELM_SYM)
577 {
578 zw = callocobject();
579 m_i_i((INT)0,result);
580 z = label;
581 while (z != NULL)
582 {
583 erg += compute_elmsym_with_alphabet(S_S_S(z),l,zw);
584 erg += mult_apply(S_S_K(z),zw);
585 erg += add_apply(zw,result);
586 z = S_S_N(z);
587 erg += freeself(zw);
588 }
589 erg += freeall(zw);
590 }
591
592
593 ende:
594 ENDR("compute_elmsym_with_alphabet");
595 }
596
597
compute_power_with_alphabet(label,l,result)598 INT compute_power_with_alphabet(label,l,result) OP l,label,result;
599 /* AK 120391 V1.2 */ /* AK 200891 V1.3 */
600 {
601 INT erg = OK;
602 INT i;
603 OP zw,z;
604 CTTTO(INTEGER,PARTITION,POWSYM,"compute_power_with_alphabet(1)",label);
605 CTO(INTEGER,"compute_power_with_alphabet(2)",l);
606 FREESELF(result);
607
608 if (S_O_K(label) == INTEGER)
609 {
610 erg += init(POLYNOM,result);
611 for (i=(INT)0;i<S_I_I(l); i++)
612 {
613 zw = callocobject();
614 erg += m_iindex_iexponent_monom(i,S_I_I(label),zw);
615 insert(zw,result,NULL,NULL);
616 }
617 }
618 else if (S_O_K(label) == PARTITION)
619 {
620 zw = callocobject();
621 erg += m_scalar_polynom(cons_eins,result);
622 for (i=(INT)0; i<S_PA_LI(label); i++)
623 {
624 erg += compute_power_with_alphabet(S_PA_I(label,i),
625 l,zw);
626 erg += mult_apply(zw,result);
627 }
628 erg += freeall(zw);
629 }
630 else if (S_O_K(label) == POW_SYM)
631 {
632 zw = callocobject();
633 erg += init(POLYNOM,result);
634 z = label;
635 while (z != NULL)
636 {
637 erg += compute_power_with_alphabet(S_S_S(z),l,zw);
638 erg += mult_apply(S_S_K(z),zw);
639 erg += add_apply(zw,result);
640 z = S_S_N(z);
641 erg += freeself(zw);
642 }
643 erg += freeall(zw);
644 }
645 else {
646 printobjectkind(label);
647 erg = error("compute_power_with_alphabet:wrong kind of label");
648 }
649 ENDR("compute_power_with_alphabet");
650 }
651
652
compute_schur_with_alphabet(part,l,res)653 INT compute_schur_with_alphabet(part,l,res) OP part,res,l;
654 /* AK 101187 */
655 /* AK 161187 l ist die laenge des alphabets */
656 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 150591 V1.2 */
657 /* AK 200891 V1.3 */
658 /* AK 161195 much faster with m_umriss_tableaux etc. */
659 {
660 OP e;
661 INT erg = OK;
662 CE3(part,l,res,compute_schur_with_alphabet);
663 CTTTO(PARTITION,SCHUR,HASHTABLE,"compute_schur_with_alphabet(1)",part);
664
665 FREESELF(res);
666
667 if (S_O_K(part) == PARTITION)
668 {
669 if (GR(S_PA_L(part),l))
670 { m_scalar_polynom(cons_null,res); goto ende; }
671 if (S_PA_LI(part) == 0)
672 { m_scalar_polynom(cons_eins,res); goto ende; }
673 e=callocobject();
674 erg += m_umriss_tableaux(part,l,e);
675 erg += m_tableaux_polynom(e,res);
676 erg += freeall(e);
677 goto ende;
678 }
679 else /* SCHUR, HASHTABLE */
680 {
681 OP z,e;
682 init(POLYNOM,res);
683 FORALL(z,part, {
684 e = CALLOCOBJECT();
685 erg += compute_schur_with_alphabet(S_MO_S(z),l,e);
686 MULT_APPLY(S_MO_K(z),e);
687 erg += insert(e,res,add_koeff,comp_monomvector_monomvector);
688 });
689 goto ende;
690 }
691 ende:
692 CTO(POLYNOM,"compute_schur_with_alphabet(e3)",res);
693 ENDR("compute_schur_with_alphabet");
694 }
695
696
m_pa_s(part,schur)697 INT m_pa_s(part,schur) OP part, schur;
698 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
699 /* AK 151298 V2.0 */
700 /* part and schur may be equal */
701 {
702 INT erg = OK;
703 OP d;
704 COP("m_pa_s",schur);
705 CTO(PARTITION,"m_pa_s(1)",part);
706
707 d = CALLOCOBJECT();
708 erg += copy_partition(part,d);
709 erg += b_pa_s(d,schur);
710 ENDR("m_pa_s");
711 }
712
m_pa_mon(part,schur)713 INT m_pa_mon(part,schur) OP part, schur;
714 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
715 /* AK 151298 V2.0 */
716 /* part and schur may be equal */
717 {
718 INT erg = OK;
719 OP d;
720 COP("m_pa_mon",schur);
721 CTO(PARTITION,"m_pa_mon(1)",part);
722
723 d = CALLOCOBJECT();
724 erg += copy_partition(part,d);
725 erg += b_pa_s(d,schur);
726 C_O_K(schur,MONOMIAL);
727 ENDR("m_pa_mon");
728 }
729
m_pa_e(part,schur)730 INT m_pa_e(part,schur) OP part, schur;
731 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
732 /* AK 151298 V2.0 */
733 /* part and schur may be equal */
734 {
735 INT erg = OK;
736 OP d;
737 COP("m_pa_e",schur);
738 CTO(PARTITION,"m_pa_e(1)",part);
739
740 d = CALLOCOBJECT();
741 erg += copy_partition(part,d);
742 erg += b_pa_s(d,schur);
743 C_O_K(schur,ELMSYM);
744 ENDR("m_pa_e");
745 }
746
m_pa_h(part,schur)747 INT m_pa_h(part,schur) OP part, schur;
748 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
749 /* AK 151298 V2.0 */
750 /* part and schur may be equal */
751 {
752 INT erg = OK;
753 OP d;
754 COP("m_pa_h",schur);
755 CTO(PARTITION,"m_pa_h(1)",part);
756
757 d = CALLOCOBJECT();
758 erg += copy_partition(part,d);
759 erg += b_pa_s(d,schur);
760 C_O_K(schur,HOMSYM);
761 ENDR("m_pa_h");
762 }
763
m_pa_ps(part,schur)764 INT m_pa_ps(part,schur) OP part, schur;
765 /* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
766 /* AK 151298 V2.0 */
767 /* part and schur may be equal */
768 {
769 INT erg = OK;
770 OP d;
771 COP("m_pa_ps",schur);
772 CTO(PARTITION,"m_pa_ps(1)",part);
773
774 d = CALLOCOBJECT();
775 erg += copy_partition(part,d);
776 erg += b_pa_s(d,schur);
777 C_O_K(schur,POWSYM);
778 ENDR("m_pa_ps");
779 }
780
b_pa_mon(part,schur)781 INT b_pa_mon(part,schur) OP part, schur;
782 /* AK 140687 */
783 /* AK 110789 V1.0 */ /* AK 241189 V1.1 */ /* AK 200891 V1.3 */
784 /* AK 151298 V2.0 */
785 /* input: partition p
786 output: monomial symmetric function m_p with coefficient 1 */
787 /* input must be a partition object of vector type */
788 {
789 INT erg=OK;
790 OP d;
791 COP("m_pa_mon",schur);
792 CTO(PARTITION,"b_pa_mon(1)",part);
793 d = CALLOCOBJECT();
794 erg += copy_partition(part,d);
795 erg += b_pa_s(d,schur);
796 C_O_K(schur,MONOMIAL);
797 ENDR("b_pa_mon");
798 }
799
b_pa_s(part,schur)800 INT b_pa_s(part,schur) OP part, schur;
801 /* AK 140687 */
802 /* AK 110789 V1.0 */ /* AK 241189 V1.1 */ /* AK 200891 V1.3 */
803 /* AK 151298 V2.0 */
804 /* input: partition p
805 output: schur function s_p with coefficient 1 */
806 /* input must be a partition object of vector type */
807 {
808 INT erg=OK;
809 CTO(PARTITION,"b_pa_s(1)",part);
810 SYMCHECK(part == schur,"b_pa_s:identic objects");
811 SYMCHECK(S_PA_K(part) != VECTOR,"b_pa_s:partition must be of kind vector");
812 erg += b_skn_s(part,CALLOCOBJECT(),NULL,schur);
813 M_I_I(1,S_S_K(schur));
814 ENDR("b_pa_s");
815 }
816
817
818
m_v_s(vec,schur)819 INT m_v_s(vec,schur) OP vec, schur;
820 /* AK 110187 */
821 /* AK 110789 V1.0 */ /* AK 170590 V1.1 */ /* AK 200891 V1.3 */
822 {
823 INT erg=OK;
824 CE2(vec,schur,m_v_s);
825 erg += b_skn_s( CALLOCOBJECT(), CALLOCOBJECT(),
826 NULL, schur);
827 erg += m_v_pa(vec,S_S_S(schur));
828 M_I_I((INT)1,S_S_K(schur));
829 ENDR("m_v_s");
830 }
831
832
add_monomial_monomial(a,b,c)833 INT add_monomial_monomial(a,b,c) OP a, b, c;
834 {
835 return add_schur_schur_co(a,b,c,MONOMIAL);
836 }
add_elmsym_elmsym(a,b,c)837 INT add_elmsym_elmsym(a,b,c) OP a, b, c;
838 {
839 return add_schur_schur_co(a,b,c,ELM_SYM);
840 }
add_powsym_powsym(a,b,c)841 INT add_powsym_powsym(a,b,c) OP a, b, c;
842 {
843 return add_schur_schur_co(a,b,c,POW_SYM);
844 }
845
846
847
add_homsym_homsym(a,b,c)848 INT add_homsym_homsym(a,b,c) OP a, b, c;
849 /* AK 200891 V1.3 */
850 {
851 return add_schur_schur_co(a,b,c,HOM_SYM);
852 }
853
854
855
add_schur_schur(a,b,c)856 INT add_schur_schur(a,b,c) OP a, b, c;
857 /* AK 200891 V1.3 */
858 {
859 INT erg = OK;
860 CTTO(HASHTABLE,SCHUR,"add_schur_schur(1)",a);
861 CTTO(HASHTABLE,SCHUR,"add_schur_schur(2)",b);
862 CTTTO(EMPTY,HASHTABLE,SCHUR,"add_schur_schur(3)",c);
863 erg += add_schur_schur_co(a,b,c,SCHUR);
864 ENDR("add_schur_schur");
865 }
866
867
868
add_schur_schur_co(a,b,c,typ)869 static INT add_schur_schur_co(a,b,c,typ) OP a, b, c;OBJECTKIND typ;
870 /* AK 110789 V1.0 */ /* AK 201289 V1.1 */ /* AK 050891 V1.3 */
871 {
872 INT erg = OK;
873 CTTTTTO(SCHUR,POWSYM,ELMSYM,HOMSYM,MONOMIAL,"add_schur_schur_co(1)",a);
874 erg += add_polynom_polynom(a,b,c);
875 if (listp(c))
876 C_O_K(c,typ);
877 ENDR("internal routine:add_schur_schur_co");
878 }
879
880
881
m_skn_s(self,koeff,n,ergebnis)882 INT m_skn_s(self,koeff,n,ergebnis) OP self,koeff,n,ergebnis;
883 /* AK 200891 V1.3 */
884 {
885 INT erg = OK;
886 CTO(PARTITION,"m_skn_s(1)",self);
887 COP("m_skn_s(4)",ergebnis);
888 erg += m_skn_po(self,koeff,n,ergebnis);
889 C_O_K(ergebnis,SCHUR);
890 ENDR("m_skn_s");
891 }
892
893
b_skn_s(a,b,c,d)894 INT b_skn_s(a,b,c,d) OP a,b,c,d;
895 /* AK 110789 V1.0 */ /* AK 130391 V1.2 */
896 /* AK 130891 V1.3 */
897 {
898 INT erg = OK;
899 CTTO(EMPTY,PARTITION,"b_skn_s(1)",a);
900 COP("b_skn_s(4)",d);
901
902 erg += b_sn_l(CALLOCOBJECT(),c,d);
903 C_O_K(d,SCHUR);
904 erg += b_sk_mo(a,b,S_L_S(d));
905 ENDR("b_skn_s");
906 }
907
908
objectread_schur(filename,poly)909 INT objectread_schur(filename,poly) OP poly; FILE *filename;
910 /* AK 291086 */ /* AK 110789 V1.0 */ /* AK 221289 V1.1 */
911 /* AK 200891 V1.3 */
912 {
913 char antwort[2];
914 INT erg = OK; /* AK 040893 */
915 COP("objectread_schur(2)",poly);
916
917 erg += b_skn_s(callocobject(), callocobject(), callocobject(), poly);
918 erg += objectread(filename,PARTITION,S_S_S(poly));
919 erg += objectread(filename,INTEGER,S_S_K(poly));
920 fscanf(filename,"%s",antwort);
921 if (antwort[0] == 'j')
922 erg += objectread(filename,SCHUR,S_S_N(poly));
923 else if (antwort[0] == 'n') {
924 SYM_free(S_S_N(poly));
925 C_S_N(poly,NULL);
926 }
927 else
928 error("objectread_schur:wrong data");
929 ENDR("objectread_schur");
930 }
931
objectwrite_schur(filename,poly)932 INT objectwrite_schur(filename,poly) FILE *filename; OP poly;
933 /* AK 291086 */ /* AK 110789 V1.0 */ /* AK 221289 V1.1 */
934 /* AK 200891 V1.3 */
935 {
936 INT erg = OK;
937 COP("objectwrite_schur(2)",poly);
938 erg += objectwrite(filename,S_S_S(poly));
939 erg += objectwrite(filename,S_S_K(poly));
940 if (not lastp(poly))
941 {
942 fprintf(filename,"j\n");
943 erg += objectwrite(filename,S_S_N(poly));
944 }
945 else fprintf(filename,"n\n");
946 ENDR("objectwrite_schur");
947 }
948
scan_monomial(a)949 INT scan_monomial(a) OP a;
950 {
951 printeingabe("Input of a monomial symmetric function");
952 return scan_schur_co(a,MONOMIAL);
953 }
scan_elmsym(a)954 INT scan_elmsym(a) OP a;
955 {
956 printeingabe("Input of a elementary symmetric function");
957 return scan_schur_co(a,ELM_SYM);
958 }
scan_powsym(a)959 INT scan_powsym(a) OP a;
960 {
961 printeingabe("Input of a powersum symmetric function");
962 return scan_schur_co(a,POW_SYM);
963 }
scan_homsym(a)964 INT scan_homsym(a) OP a;
965 {
966 printeingabe("Input of a complete symmetric function");
967 return scan_schur_co(a,HOM_SYM);
968 }
scan_schur(a)969 INT scan_schur(a) OP a;
970 {
971 printeingabe("Input of a Schur function");
972 return scan_schur_co(a,SCHUR);
973 }
sscan_schur(t,a)974 INT sscan_schur(t,a) char *t; OP a;
975 /* AK 171296 */
976 {
977 INT i,n=1,erg = OK;
978 OP c,d,e;
979 char *v;
980 int SYM_isdigit();
981
982 COP("sscan_schur(2)",a);
983
984 c = callocobject();
985 d = callocobject();
986 e = callocobject();m_i_i(1L,e);
987 erg += init(SCHUR,a);
988 v = t;
989 again:
990 if (*v == '\0') goto sse;
991 while (*v == ' ') v++;
992 if (*v == '[') {
993 i = sscan(v,PARTITION,c);
994 if (i != OK) goto sse;
995 while (*v != ']') v++;
996 v++;
997 erg += m_skn_s(c,e,NULL,d);
998 erg += add_apply(d,a);
999 m_i_i(1L,e);
1000 goto again;
1001 }
1002 else if (*v == '+') {
1003 v++; n=1;
1004 goto again;
1005 }
1006 else if (*v == '-') {
1007 v++; n= -1;
1008 goto again;
1009 }
1010 else if (SYM_isdigit(*v))
1011 {
1012 i = sscan(v,INTEGER,e);
1013 if (i != OK) goto sse;
1014 while (SYM_isdigit(*v)) v++;
1015 v++;
1016 if (n == -1) addinvers_apply(e);
1017 n=1;
1018 goto again;
1019 }
1020
1021 sse:
1022 erg += freeall(c);
1023 erg += freeall(d);
1024 erg += freeall(e);
1025 ENDR("sscan_schur");
1026
1027 }
1028
sscan_homsym(t,a)1029 INT sscan_homsym(t,a) char *t; OP a;
1030 /* AK 050901 */
1031 {
1032 INT i,n=1,erg = OK;
1033 OP c,d,e;
1034 char *v;
1035 int SYM_isdigit();
1036 COP("sscan_homsym(1)",t);
1037 COP("sscan_homsym(2)",a);
1038
1039 c = callocobject();
1040 d = callocobject();
1041 e = callocobject();m_i_i(1L,e);
1042 erg += init(HOMSYM,a);
1043 v = t;
1044 again:
1045 if (*v == '\0') goto sse;
1046 while (*v == ' ') v++;
1047 if (*v == '[') {
1048 i = sscan(v,PARTITION,c);
1049 if (i != OK) goto sse;
1050 while (*v != ']') v++;
1051 v++;
1052 erg += m_skn_h(c,e,NULL,d);
1053 erg += add_apply(d,a);
1054 m_i_i(1L,e);
1055 goto again;
1056 }
1057 else if (*v == '+') {
1058 v++; n=1;
1059 goto again;
1060 }
1061 else if (*v == '-') {
1062 v++; n= -1;
1063 goto again;
1064 }
1065 else if (SYM_isdigit(*v))
1066 {
1067 i = sscan(v,INTEGER,e);
1068 if (i != OK) goto sse;
1069 while (SYM_isdigit(*v)) v++;
1070 v++;
1071 if (n == -1) addinvers_apply(e);
1072 n=1;
1073 goto again;
1074 }
1075
1076 sse:
1077 erg += freeall(c);
1078 erg += freeall(d);
1079 erg += freeall(e);
1080 ENDR("sscan_homsym");
1081 }
1082
sscan_elmsym(t,a)1083 INT sscan_elmsym(t,a) char *t; OP a;
1084 /* AK 050901 */
1085 {
1086 INT i,n=1,erg = OK;
1087 OP c,d,e;
1088 char *v;
1089 int SYM_isdigit();
1090 COP("sscan_elmsym(1)",t);
1091 CTO(EMPTY,"sscan_elmsym(2)",a);
1092
1093 c = callocobject();
1094 d = callocobject();
1095 e = callocobject();M_I_I(1L,e);
1096 erg += init_elmsym(a);
1097 v = t;
1098 again:
1099 if (*v == '\0') goto sse;
1100 while (*v == ' ') v++;
1101 if (*v == '[') {
1102 i = sscan(v,PARTITION,c);
1103 if (i != OK) goto sse;
1104 while (*v != ']') v++;
1105 v++;
1106 erg += m_skn_e(c,e,NULL,d);
1107 erg += add_apply(d,a);
1108 m_i_i(1L,e);
1109 goto again;
1110 }
1111 else if (*v == '+') {
1112 v++; n=1;
1113 goto again;
1114 }
1115 else if (*v == '-') {
1116 v++; n= -1;
1117 goto again;
1118 }
1119 else if (SYM_isdigit(*v))
1120 {
1121 i = sscan(v,INTEGER,e);
1122 if (i != OK) goto sse;
1123 while (SYM_isdigit(*v)) v++;
1124 v++;
1125 if (n == -1) addinvers_apply(e);
1126 n=1;
1127 goto again;
1128 }
1129
1130 sse:
1131 FREEALL(c);
1132 FREEALL(d);
1133 FREEALL(e);
1134 ENDR("sscan_elmsym");
1135 }
1136
1137
scan_schur_co(a,typ)1138 static INT scan_schur_co(a,typ) OP a; OBJECTKIND typ;
1139 /* AK for the input of a symmetric function (Schur etc.) */
1140 /* AK 110789 V1.0 */ /* AK 221289 V1.1 */ /* AK 050891 V1.3 */
1141
1142 {
1143 char antwort[2];
1144 OBJECTKIND kind;
1145 INT erg=OK;
1146 OP d;
1147
1148 COP("scan_schur_co(1)",a);
1149
1150 erg += b_skn_s( callocobject(), callocobject(), NULL, a);
1151 C_O_K(a,typ);
1152 erg += printeingabe("Input of a partition type monom");
1153 erg += scan(PARTITION,S_S_S(a));
1154 erg += printeingabe("Input of coefficient");
1155 kind = scanobjectkind();
1156 erg += scan(kind,S_S_K(a));
1157 erg += printeingabe("one more monom y/n");
1158 scanf("%s",antwort);
1159 if (antwort[0] == 'y')
1160 {
1161 d = callocobject();
1162 erg += scan_schur_co(d,typ);
1163 erg += insert(d,a,NULL,NULL); /* AK 091195 reihenfolge beliebig */
1164 }
1165 ENDR("scan_schur internal routine");
1166 }
1167
1168
s_s_s(a)1169 OP s_s_s(a) OP a;
1170 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1171 /* AK 200891 V1.3 */
1172 { return(s_mo_s(s_l_s(a))); }
1173
s_s_k(a)1174 OP s_s_k(a) OP a;
1175 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1176 /* AK 200891 V1.3 */
1177 { return(s_mo_k(s_l_s(a))); }
1178
s_s_n(a)1179 OP s_s_n(a) OP a;
1180 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1181 /* AK 200891 V1.3 */
1182 { return(s_l_n(a)); }
1183
s_s_si(a,i)1184 OP s_s_si(a,i) OP a; INT i;
1185 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1186 /* AK 200891 V1.3 */
1187 { return(s_pa_i(s_mo_s(s_l_s(a)),i)); }
1188
s_s_sl(a)1189 OP s_s_sl(a) OP a;
1190 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1191 /* AK 200891 V1.3 */
1192 { return(s_pa_l(s_mo_s(s_l_s(a)))); }
1193
s_s_ki(a)1194 INT s_s_ki(a) OP a;
1195 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1196 /* AK 200891 V1.3 */
1197 { return(s_mo_ki(s_l_s(a))); }
1198
s_s_sii(a,i)1199 INT s_s_sii(a,i) OP a; INT i;
1200 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1201 /* AK 200891 V1.3 */
1202 { return(s_pa_ii(s_mo_s(s_l_s(a)),i)); }
1203
1204
s_s_sli(a)1205 INT s_s_sli(a) OP a;
1206 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1207 /* AK 200891 V1.3 */
1208 { return(s_pa_li(s_mo_s(s_l_s(a)))); }
1209
c_s_n(a,b)1210 INT c_s_n(a,b) OP a,b;
1211 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
1212 /* AK 200891 V1.3 */
1213 {
1214 OBJECTSELF c;
1215 c = s_o_s(a);
1216 c.ob_list->l_next = b;
1217 return(OK);
1218 }
1219
1220
test_schur()1221 INT test_schur()
1222 /* AK 181289 V1.1 */ /* AK 020791 V1.2 */ /* AK 200891 V1.3 */
1223 {
1224 OP a = callocobject();
1225 OP b = callocobject();
1226 OP c = callocobject();
1227
1228 printeingabe("test_schur:scan(a)");
1229 scan(SCHUR,a);
1230 println(a);
1231 printeingabe("test_schur:copy(a,b)");
1232 copy(a,b);
1233 println(b);
1234 printeingabe("test_schur:add(a,b,b)");
1235 add(a,b,b);
1236 println(b);
1237 printeingabe("test_schur:mult(a,b,b)");
1238 mult(a,b,b);
1239 println(b);
1240 printeingabe("test_schur:addinvers(b,a)");
1241 addinvers(b,a);
1242 println(a);
1243 printeingabe("test_schur:mult_apply(b,a)");
1244 mult_apply(b,a);
1245 println(a);
1246
1247 freeall(a);
1248 freeall(b);
1249 freeall(c);
1250 return(OK);
1251 }
1252
1253
1254
1255
1256
1257
comp_colex_schurmonom(a,b)1258 INT comp_colex_schurmonom(a,b) OP a,b;
1259 /* AK 091189 */ /* AK V1.1 201189 */
1260 /* AK 200891 V1.3 */
1261 {
1262 INT erg = OK;
1263 CTO(MONOM,"comp_colex_schurmonom",a);
1264 CTO(MONOM,"comp_colex_schurmonom",b);
1265 return(comp_colex_part(S_MO_S(a),S_MO_S(b)));
1266 ENDR("comp_colex_schurmonom");
1267 }
1268
1269
comp_colex_part(a,b)1270 INT comp_colex_part(a,b) OP a,b;
1271 /* a,b partitions colex order */
1272 /* AK V1.1 151189 */ /* AK 200891 V1.3 */
1273 {
1274 INT i = S_PA_LI(a)-(INT)1;
1275 INT j = S_PA_LI(b)-(INT)1;
1276 INT erg;
1277
1278 if (S_O_K(a) != PARTITION)
1279 error("comp_colex_part:kind != PARTITION");
1280 if (S_O_K(b) != PARTITION)
1281 error("comp_colex_part:kind != PARTITION");
1282
1283
1284 for (;(i >= (INT)0) || (j>=(INT)0); i--,j--)
1285 {
1286 if (i<(INT)0) return((INT)1);
1287 if (j<(INT)0) return((INT)-1);
1288 erg = S_PA_II(a,i) - S_PA_II(b,j);
1289 if (erg <(INT)0) return((INT)1);
1290 if (erg >(INT)0) return((INT)-1);
1291 }
1292 return((INT)0);
1293 }
1294
1295
1296
1297
hall_littlewood_tafel(a,b)1298 INT hall_littlewood_tafel(a,b) OP a,b;
1299 /* AK 191289 a ist grad der sn b wird tafel */ /* AK 201289 V1.1 */
1300 /* AK 200891 V1.3 */
1301 {
1302 INT i,j;
1303 OP c = callocobject();
1304 OP d = callocobject();
1305 OP z,zz;
1306 INT erg = OK;
1307 CTO(INTEGER,"hall_littlewood_tafel",a);
1308 erg += makevectorofpart(a,c);
1309 erg += m_ilih_nm(S_V_LI(c),S_V_LI(c),b);
1310
1311
1312
1313 for (i=(INT)0;i<S_V_LI(c);i++)
1314 {
1315 erg += hall_littlewood(S_V_I(c,i),d);
1316 z = d;
1317 while (z != NULL) {
1318 zz = S_MO_S(S_L_S(z)); /* partition */
1319 for (j=0;j<S_V_LI(c);j++)
1320 if (EQ(zz,S_V_I(c,j))) break;
1321 erg += copy(S_MO_K(S_L_S(z)),S_M_IJ(b,i,j));
1322 /* koef sind polynom */
1323 z = S_L_N(z);
1324 }
1325 }
1326
1327 erg += freeall(c);
1328 erg += freeall(d);
1329 ENDR("hall_littlewood_tafel");
1330 }
1331
1332
hall_littlewood_alt(a,b)1333 INT hall_littlewood_alt(a,b) OP a,b;
1334 /* AK 191289 a ist partition
1335 b wird das zugehoerige hall littlewood polynom */
1336 /* mittels d_ij = langsam */ /* schneller morris mit skew schur */
1337 /* AK 201289 V1.1 */
1338 /* AK 200891 V1.3 */
1339 {
1340 INT i,j;
1341 OP c = callocobject();
1342
1343 if (not EMPTYP(b))
1344 freeself(b);
1345 init_hall_littlewood(a,c);
1346
1347 for (i = 0;i<S_PA_LI(a);i++)
1348 for (j = i+1;j<S_PA_LI(a);j++)
1349 hall_littlewood_dij(c,c,i,j);
1350
1351 reorder_hall_littlewood(c,b);
1352 return freeall(c);
1353 }
1354
1355
init_hall_littlewood(a,b)1356 INT init_hall_littlewood(a,b) OP a,b;
1357 /* AK 200891 V1.3 */
1358 {
1359 b_skn_s(callocobject(),callocobject(),NULL,b);
1360 copy_partition(a,S_S_S(b));
1361 m_skn_po(callocobject(),callocobject(),NULL,S_S_K(b));
1362 m_il_v((INT)1,S_PO_S(S_S_K(b)));
1363 M_I_I((INT)0,S_PO_SI(S_S_K(b),(INT)0));
1364 M_I_I((INT)1,S_PO_K(S_S_K(b)));
1365 return(OK);
1366 }
1367
1368
reorder_vector(a,b)1369 INT reorder_vector(a,b) OP a,b;
1370 /* AK 280901 */
1371 /* sorts the vector to a partition */
1372 /* return +1 , -1, 0 */
1373 /* return 0 means zero schur function */
1374 /* a is integervector */
1375 {
1376 INT erg = OK;
1377 CTO(INTEGERVECTOR,"reorder_vector(1)",a);
1378 CTO(EMPTY,"reorder_vector(2)",b);
1379 erg += copy_integervector(a,b);
1380 return reorder_vector_apply(b);
1381 ENDR("reorder_vector");
1382 }
1383
reorder_vector_apply(b)1384 INT reorder_vector_apply(b) OP b;
1385 /* AK 041201 */
1386 /* reorders a schur function partition
1387 return 0,+1,-1 */
1388 {
1389 INT erg = OK;
1390 INT i,res=1,t;
1391 CTO(INTEGERVECTOR,"reorder_vector_apply",b);
1392 i=1;
1393 while(i<S_V_LI(b))
1394 {
1395 if (i==0) i++;
1396 if (i==1)
1397 if (S_V_II(b,0) < 0) { return 0; }
1398 if (S_V_II(b,i) == S_V_II(b,i-1)-1) {
1399 return 0; }
1400 else if (S_V_II(b,i) < S_V_II(b,i-1)) {
1401 res = res * (-1);
1402 INC_INTEGER(S_V_I(b,i));
1403 DEC_INTEGER(S_V_I(b,i-1));
1404 t=S_V_II(b,i);
1405 M_I_I(S_V_II(b,i-1),S_V_I(b,i));
1406 M_I_I(t,S_V_I(b,i-1));
1407 i--;
1408 }
1409 else i++;
1410 }
1411
1412 /* nach links packen */
1413 for (i=0;i<S_V_LI(b);i++)
1414 if (S_V_II(b,i) != 0) break;
1415 for (t=0;i<S_V_LI(b);i++,t++)
1416 M_I_I(S_V_II(b,i),S_V_I(b,t));
1417 M_I_I(t,S_V_L(b));
1418 return res;
1419 ENDR("reorder_vector_apply");
1420 }
1421
1422
1423
reorder_schur(a,b)1424 INT reorder_schur(a,b) OP a,b;
1425 {
1426 INT erg = OK;
1427 INT i;
1428
1429 OP d,z,m;
1430 CTTO(SCHUR,HASHTABLE,"reorder_schur(1)",a);
1431 if ((S_O_K(b) != SCHUR) && (S_O_K(b) != HASHTABLE))
1432 {
1433 CE2(a,b,reorder_schur);
1434 }
1435 if (S_O_K(b) == EMPTY)
1436 {
1437 erg += init(SCHUR,b);
1438 }
1439 FORALL(z,a, {
1440 d = CALLOCOBJECT();
1441 i = reorder_vector(S_PA_S(S_MO_S(z)),d);
1442 if (i == 0) { FREEALL(d); }
1443 else {
1444 m = CALLOCOBJECT();
1445 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
1446 b_ks_pa(VECTOR,d,S_MO_S(m));
1447 if (i==1) COPY(S_MO_K(z),S_MO_K(m));
1448 else ADDINVERS(S_MO_K(z),S_MO_K(m));
1449
1450 if (S_O_K(b) == SCHUR)
1451 INSERT_LIST(m,b,add_koeff,comp_monomschur);
1452 else
1453 insert_scalar_hashtable(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
1454 }
1455 });
1456
1457
1458 ENDR("reorder_schur");
1459 }
1460
reorder_hall_littlewood(a,b)1461 INT reorder_hall_littlewood(a,b) OP a,b;
1462 /* AK 191289
1463 es werden die partitionen wieder neu sortiert
1464 in die ansteigende form */
1465 /* a is SCHUR */
1466 /* AK 200891 V1.3 */
1467 {
1468 OP z = a,d,e;
1469 OP zzz;
1470 INT i,j;
1471 INT erg = OK;
1472 CTO(SCHUR,"reorder_hall_littlewood",a);
1473 CE2(a,b,reorder_hall_littlewood);
1474
1475 init(SCHUR,b);
1476 while (z != NULL)
1477 {
1478 d = CALLOCOBJECT();
1479 erg += copy_monom(S_L_S(z),d);
1480 zzz = S_MO_S(d); /* zzz ist partition */
1481 re_again:
1482 for (i=1;i<S_PA_LI(zzz);i++)
1483 {
1484
1485 if (S_PA_II(zzz,(INT)0) < (INT)0)
1486 {
1487 FREEALL(d);
1488 goto re_while_ende;
1489 }
1490 else if (S_PA_II(zzz,i) == S_PA_II(zzz,i-1) -1)
1491 {
1492 FREEALL(d);
1493 goto re_while_ende;
1494 }
1495 else if (S_PA_II(zzz,i) < S_PA_II(zzz,i-1) )
1496 {
1497 ADDINVERS_APPLY(S_MO_K(d));
1498 INC_INTEGER(S_PA_I(zzz,i));
1499 DEC_INTEGER(S_PA_I(zzz,i-1));
1500 SWAP(S_PA_I(zzz,i),S_PA_I(zzz,i-1));
1501 goto re_again;
1502 }
1503 }
1504 for (i=(INT)0;i<S_PA_LI(zzz);i++)
1505 if (S_PA_II(zzz,i)>(INT)0) break;
1506 /* noch nach links schieben */
1507
1508 for (j=i;j<S_PA_LI(zzz);j++)
1509 M_I_I(S_PA_II(zzz,j),S_PA_I(zzz,j-i));
1510
1511 if ((S_PA_LI(zzz)-i) == (INT)0) /* AK 300197 */
1512 {
1513 j = S_PA_II(zzz,(INT)0);
1514 erg += m_il_v((INT)1,S_PA_S(zzz));
1515 C_O_K(S_PA_S(zzz),INTEGERVECTOR);
1516 M_I_I(j,S_PA_I(zzz,(INT)0));
1517 }
1518 else if ((S_PA_LI(zzz)-i) == (INT)1) /* AK 121093 */
1519 {
1520 j = S_PA_II(zzz,(INT)0);
1521 erg += m_il_v((INT)1,S_PA_S(zzz));
1522 C_O_K(S_PA_S(zzz),INTEGERVECTOR);
1523 M_I_I(j,S_PA_I(zzz,(INT)0));
1524 }
1525 else {
1526 M_I_I(S_PA_LI(zzz)-i,S_PA_L(zzz));
1527 }
1528
1529 e = CALLOCOBJECT();
1530 erg += b_sn_s(d,NULL,e);
1531 INSERT_LIST(e,b,add_koeff,comp_monomvector_monomvector);
1532 re_while_ende:
1533 z = S_L_N(z);
1534 }
1535 if (S_L_S(b) == NULL)
1536 FREESELF(b);
1537 ENDR("reorder_hall_littlewood");
1538 }
1539
1540
1541
hall_littlewood_dij(a,b,i,j)1542 INT hall_littlewood_dij(a,b,i,j) OP a,b; INT i,j;
1543 /* AK 181289
1544 bei der berechnung von hall littlewood polynomen benoetigt
1545 man die anwendung vomuliplikation mit
1546 (1 + t * d_ij + t^2 * d_ij^2 ... )
1547 eingabe: a = hall_littlewood polynom
1548 i<j indices
1549 ausgabe: b neues hall_littlewood polynom
1550 */
1551 /* hall littlewood polynome sind schurpolynome mit polynomen in t als koeff*/
1552 /* AK 201289 V1.1 */
1553 /* AK 200891 V1.3 */
1554 {
1555 INT k,tt;
1556 OP sp = callocobject();
1557 OP z,zz,zzz;
1558
1559 copy_list(a,sp); /* funktioniert auch beim
1560 aufruf mit gleichen variablen */
1561 copy_list(sp,b); /* die multiplikation mit 1 */
1562 for (k=1;;k++)
1563 {
1564 tt = (INT)0;
1565 z = sp;
1566 while (z != NULL)
1567 {
1568 zz = S_L_S(z);
1569 zzz = S_MO_S(zz);
1570 if (j <= S_PA_LI(zzz)) /* index j zulaessig */
1571 if (S_PA_II(zzz,i) >= (k-i) ) {
1572 OP d = callocobject();
1573 OP e = callocobject();
1574 tt = (INT)1;
1575 copy(zz,d);
1576 M_I_I(S_PA_II(zzz,i)-k,S_PA_I(S_MO_S(d),i));
1577 M_I_I(S_PA_II(zzz,j)+k,S_PA_I(S_MO_S(d),j));
1578 b_skn_po(callocobject(),callocobject(),NULL,e);
1579 m_il_v((INT)1,S_PO_S(e));
1580 M_I_I(k,S_PO_SI(e,(INT)0));
1581 M_I_I((INT)1,S_PO_K(e)); /* e = t^k */
1582 mult(e,S_MO_K(d),S_MO_K(d));
1583 insert(d,b,add_koeff,comp_monomvector_monomvector);
1584 /* add(d,b,b);*/
1585 freeall(e);
1586 }
1587 z = S_L_N(z);
1588 }
1589 if (tt == (INT)0) break; /* ende */
1590 }
1591 freeall(sp);
1592 return(OK);
1593 }
1594
1595
tex_hall_littlewood(a)1596 INT tex_hall_littlewood(a) OP a;
1597 /* AK 191289 tex ausgabe */
1598 /* AK 200891 V1.3 */
1599 {
1600 return tex(a);
1601 }
1602
1603
1604
1605
1606
hall_littlewood(a,b)1607 INT hall_littlewood(a,b) OP a,b;
1608 /* AK 221289 V1.1 die zweite methode, siehe morris 1963 */
1609 /* Math. Zeit 81 112-123 (1963) */
1610 /* AK 200891 V1.3 */
1611 {
1612 OP c,d,e,ff,g,z;
1613 INT erg = OK; /* AK 180893 */
1614 INT i;
1615 CE2(a,b,hall_littlewood);
1616 CTO(PARTITION,"hall_littlewood(1)",a);
1617 if (S_PA_LI(a) == (INT)1)
1618 {
1619 erg += b_skn_s(callocobject(),callocobject(),NULL,b);
1620 erg += copy(a,S_S_S(b));
1621 erg += b_skn_po(callocobject(),callocobject(),NULL,S_S_K(b));
1622 M_I_I((INT)1,S_PO_K(S_S_K(b)));
1623 erg += m_il_v((INT)1,S_PO_S(S_S_K(b)));
1624 M_I_I((INT)0,S_PO_SI(S_S_K(b),(INT)0));
1625 goto hl_ende;
1626 }
1627 /* wenn die laenge groesser 1 ist */
1628
1629 erg += init(SCHUR,b);
1630
1631 c = callocobject(); d = callocobject(); e = callocobject(); g = callocobject();
1632
1633 erg += copy_partition(a,c);
1634 erg += dec_partition(c);
1635 erg += hall_littlewood(c,d);
1636 erg += weight_partition(c,e);
1637 erg += copy(d,c);
1638 z = c;
1639 while (z != NULL)
1640 {
1641 erg += inc_partition(S_S_S(z));
1642 M_I_I( S_PA_II(a,S_PA_LI(a)-(INT)1), S_S_SI(z,S_S_SLI(z)-(INT)1));
1643 z = S_S_N(z);
1644 }
1645
1646 ff = callocobject();
1647 erg += reorder_hall_littlewood(c,ff);
1648 insert(ff,b,NULL,NULL);
1649
1650 erg += copy(d,c);
1651 for (i=(INT)1;i<=S_I_I(e); i++)
1652 {
1653 erg += m_i_pa(e,g);
1654 M_I_I(i,S_PA_I(g,(INT)0));
1655 z = c; /* c ist das ergebnis der rekursion */
1656 erg += init(SCHUR,d);
1657 while (z != NULL)
1658 {
1659 ff = callocobject();
1660 erg += part_part_skewschur(S_S_S(z),g,ff);
1661 if (not NULLP(ff))
1662 {
1663 MULT_APPLY(S_S_K(z),ff);
1664 INSERT_LIST(ff,d,add_koeff,comp_monomschur);
1665 }
1666 else
1667 erg += freeall(ff);
1668 z = S_S_N(z);
1669 }
1670 /* d ist nun die liste mit den expansion der skewpartition */
1671 z = d;
1672 /* nun noch die multiplikation mit t^i */
1673 erg += b_skn_po(callocobject(),callocobject(),NULL,g);
1674 M_I_I((INT)1,S_PO_K(g));
1675 erg += m_il_v((INT)1,S_PO_S(g));
1676 M_I_I(i,S_PO_SI(g,(INT)0));
1677 while (z != NULL)
1678 {
1679 erg += inc_partition(S_S_S(z));
1680 M_I_I(S_PA_II(a,S_PA_LI(a)-(INT)1)+i, S_S_SI(z,S_S_SLI(z)-(INT)1));
1681 erg += mult_apply(g,S_S_K(z));
1682 z = S_S_N(z);
1683 }
1684
1685 ff = callocobject();
1686 erg += reorder_hall_littlewood(d,ff);
1687 erg += insert(ff,b,NULL,NULL);
1688 }
1689 erg += freeall(e);
1690 erg += freeall(d);
1691 erg += freeall(c);
1692 erg += freeall(g);
1693 hl_ende:
1694 ENDR("hall_littlewood");
1695 }
1696
1697
1698
copy_monomial(a,b)1699 INT copy_monomial(a,b) OP a,b;
1700 /* AK 270901 */
1701 {
1702 INT erg = OK;
1703 CTO(MONOMIAL,"copy_monomial(1)",a);
1704 erg += transformlist(a,b,copy_monom);
1705 ENDR("copy_monomial");
1706 }
1707
copy_schur(a,b)1708 INT copy_schur(a,b) OP a,b;
1709 /* AK 270901 */
1710 {
1711 INT erg = OK;
1712 CTO(SCHUR,"copy_schur(1)",a);
1713 erg += transformlist(a,b,copy_monom);
1714 ENDR("copy_schur");
1715 }
1716
copy_homsym(a,b)1717 INT copy_homsym(a,b) OP a,b;
1718 /* AK 270901 */
1719 {
1720 INT erg = OK;
1721 CTO(HOMSYM,"copy_homsym(1)",a);
1722 erg += transformlist(a,b,copy_monom);
1723 ENDR("copy_homsym");
1724 }
1725
copy_elmsym(a,b)1726 INT copy_elmsym(a,b) OP a,b;
1727 /* AK 270901 */
1728 {
1729 INT erg = OK;
1730 CTO(ELMSYM,"copy_elmsym(1)",a);
1731 erg += transformlist(a,b,copy_monom);
1732 ENDR("copy_elmsym");
1733 }
1734
copy_powsym(a,b)1735 INT copy_powsym(a,b) OP a,b;
1736 /* AK 270901 */
1737 {
1738 INT erg = OK;
1739 CTO(POWSYM,"copy_powsym(1)",a);
1740 erg += transformlist(a,b,copy_monom);
1741 ENDR("copy_powsym");
1742 }
1743
add_apply_symfunc_symfunc(a,b)1744 INT add_apply_symfunc_symfunc(a,b) OP a,b;
1745 /* AK 200891 V1.3 */
1746 {
1747 OP c = callocobject();
1748 copy_polynom(a,c);
1749 return(insert(c,b,add_koeff,comp_monomvector_monomvector));
1750 }
1751
1752
1753
add_apply_symfunc(a,b)1754 INT add_apply_symfunc(a,b) OP a,b;
1755 /* result ist von typ b, falls beides sym func */
1756 {
1757 OP c;
1758 INT erg = OK;
1759
1760 if (S_O_K(a) == S_O_K(b))
1761 erg += add_apply_symfunc_symfunc(a,b);
1762 else {
1763 c = CALLOCOBJECT();
1764 SWAP(b,c);
1765 add(c,a,b);
1766 FREEALL(c);
1767 }
1768 ENDR("add_apply_symfunc");
1769 }
1770
1771
dimension_schur(a,b)1772 INT dimension_schur(a,b) OP a,b;
1773 /* AK 020890 V1.1 */ /* AK 200891 V1.3 */
1774 /* AK 260198 V2.0 */
1775 /*
1776 input: schur ( may be SCHUR or HASHTABLE )
1777 output: dimension of corresponding representation of sn
1778 */
1779 {
1780 OP z,res;
1781 INT erg = OK;
1782 CTTO(HASHTABLE,SCHUR,"dimension_schur(1)",a);
1783 CE2(a,b,dimension_schur);
1784
1785 /* b is freed */
1786
1787 res = CALLOCOBJECT();
1788 M_I_I(0,b);
1789 FORALL(z,a,
1790 {
1791 erg += dimension(S_MO_S(z),res);
1792 MULT_APPLY(S_MO_K(z),res);
1793 ADD_APPLY(res,b);
1794 } );
1795
1796 FREEALL(res);
1797 ENDR("dimension_schur");
1798 }
1799
1800
1801
1802
add_staircase_part(a,n,b)1803 INT add_staircase_part(a,n,b) OP a,n,b;
1804 /* adds the vector 0,1,...,n-1 to the partition a */
1805 /* AK 050990 V1.1 */
1806 /* AK 200891 V1.3 */
1807 {
1808 OP c = callocobject();
1809 INT i,j;
1810 m_l_v(n,c);
1811 for (i=S_V_LI(c)-(INT)1,j=S_PA_LI(a)-(INT)1;i>=(INT)0;i--,j--)
1812 if (j>=(INT)0) M_I_I(S_PA_II(a,j)+i,S_V_I(c,i));
1813 else M_I_I(i,S_V_I(c,i));
1814
1815 b_ks_pa(VECTOR,c,b);
1816 return OK;
1817 }
1818
1819
1820
mod_part(a,b,c)1821 INT mod_part(a,b,c) OP a,b,c;
1822 /* the single parts of partition a mod b gives c */
1823 /* AK 050990 V1.1 */
1824 /* AK 200891 V1.3 */
1825 {
1826 INT i;
1827 if (a != c) copy(a,c);
1828 for (i=0;i<S_PA_LI(c);i++)
1829 M_I_I(S_PA_II(c,i) % S_I_I(b), S_PA_I(c,i));
1830 return OK;
1831 }
1832
1833
1834
p_root_schur(a,n,p,b)1835 INT p_root_schur(a,n,p,b) OP a,n,p,b;
1836 /* a ist schur n ist integer p ist integer b wird schur */
1837 /* AK 050990 V1.1 */
1838 /* wie folgt wird gerechnet: addiere 0,..,n-2,n-1 zu den
1839 partitionen, die die laenger als n sind werden gestrichen,
1840 dann die partition modulo p, dann wieder zu aufsteigenden
1841 partitionen um sortieren */
1842 /*dies entspricht dem einsetzen von p-ten einheitswurzeln */
1843 /* AK 200891 V1.3 */
1844 {
1845 OP z,c,d;
1846 if (a == b ) { c = callocobject(); copy(a,c);
1847 p_root_schur(c,n,p,b); freeall(c); return OK; }
1848
1849 z = a;
1850 if (not EMPTYP(b) )
1851 freeself(b);
1852 b_sn_s(NULL,NULL,b);
1853
1854 while (z != NULL)
1855 {
1856 if (S_S_SLI(z) <= S_I_I(n))
1857 {
1858 c = callocobject();
1859 d = callocobject();
1860 p_root_part(S_S_S(z),n,p,c);
1861 b_skn_s(c,callocobject(),NULL,d);
1862 copy(S_S_K(z),S_S_K(d));
1863 insert(d,b,NULL,NULL);
1864 }
1865 z = S_S_N(z);
1866 }
1867 reorder_hall_littlewood(b,b);
1868 return OK;
1869 }
1870
1871
1872
p_root_part(a,n,p,b)1873 INT p_root_part(a,n,p,b) OP a,n,p,b;
1874 /* a ist part, n ist integer, p ist integer */
1875 /* AK 050990 V1.1 */
1876 /* AK 200891 V1.3 */
1877 {
1878 INT i;
1879 OP c = callocobject();
1880 m_l_v(n,c);
1881 for (i=(INT)0; i<S_V_LI(c); i++) M_I_I(i,S_V_I(c,i));
1882 add_staircase_part(a,n,b);
1883 mod_part(b,p,b);
1884 sub(S_PA_S(b),c,S_PA_S(b));
1885 freeall(c); return OK;
1886 }
1887
1888
1889
m_int_qelm(a,b)1890 static INT m_int_qelm(a,b) INT a; OP b;
1891 {
1892 INT erg = OK;
1893 COP("m_int_qelm(1)",b);
1894 erg += b_skn_e(callocobject(),callocobject(),NULL,b);
1895 erg += m_i_i(1L , S_S_K(b));
1896 erg += m_int_pa(a,S_S_S(b));
1897 ENDR("m_int_qelm");
1898 }
1899
m_int_int_qelm(a,b,d)1900 static INT m_int_int_qelm(a,b,d) INT a,b; OP d;
1901 {
1902 OP c = callocobject();
1903 INT erg = OK;
1904 COP("m_int_int_qelm(3)",d);
1905 SYMCHECK( (a>b) , "m_int_int_qelm: para1 > para2");
1906
1907 erg += b_ks_pa(VECTOR,callocobject(),c);
1908 erg += m_il_v(2L,S_PA_S(c));
1909 C_O_K(S_PA_S(c),INTEGERVECTOR);
1910 erg += m_i_i(a,S_PA_I(c,0));
1911 erg += m_i_i(b,S_PA_I(c,1));
1912 erg += m_part_qelm(c,d);
1913 erg += freeall(c);
1914 ENDR("m_int_int_qelm");
1915
1916 }
1917
m_part_qelm(a,b)1918 INT m_part_qelm(a,b) OP a,b;
1919 /* AK 060995 */
1920 /* computes q polynomial as elmsym */
1921 {
1922 INT i,j;
1923 OP c,d,e;
1924 INT erg = OK;
1925
1926 CTO(PARTITION,"m_part_qelm",a);
1927 if (S_PA_LI(a) == 1)
1928 {
1929 erg += m_int_qelm(S_PA_II(a,0),b);
1930 }
1931 else if (S_PA_LI(a) == 2)
1932 {
1933 c = callocobject();
1934 erg += m_int_qelm(S_PA_II(a,0),c);
1935 d = callocobject();
1936 erg += m_int_qelm(S_PA_II(a,1),d);
1937 erg += mult(c,d,b);
1938 e = callocobject();
1939 for (i=1;i<=S_PA_II(a,0);i++)
1940 {
1941 erg += m_int_qelm(S_PA_II(a,0)-i,c);
1942 erg += m_int_qelm(S_PA_II(a,1)+i,d);
1943 erg += mult(c,d,e);
1944 erg += mult_apply(cons_zwei,e);
1945 if (i%2 == 1)
1946 erg += mult_apply(cons_negeins,e);
1947 erg += add_apply(e,b);
1948 }
1949 erg += freeall(c);
1950 erg += freeall(d);
1951 erg += freeall(e);
1952 }
1953 else if (S_PA_LI(a) %2 == 0)
1954 {
1955 c = callocobject();
1956 erg += m_ilih_m(S_PA_LI(a), S_PA_LI(a),c);
1957 for (i=0;i<S_M_HI(c);i++)
1958 for (j=i+1;j<S_M_LI(c);j++)
1959 {
1960 m_int_int_qelm(S_PA_II(a,S_PA_LI(a)-1-j),
1961 S_PA_II(a,S_PA_LI(a)-1-i),S_M_IJ(c,i,j));
1962 }
1963 pfaffian_matrix(c,b);
1964 erg += freeall(c);
1965 }
1966 else {
1967 d = callocobject();
1968 b_ks_pa(VECTOR,callocobject(),d);
1969 m_il_nv(S_PA_LI(a)+1,S_PA_S(d));
1970 C_O_K(S_PA_S(d),INTEGERVECTOR);
1971 for (i=0;i<S_PA_LI(a);i++)
1972 M_I_I(S_PA_II(a,i),S_PA_I(d,i+1));
1973
1974 c = callocobject();
1975 erg += m_ilih_m(S_PA_LI(d), S_PA_LI(d),c);
1976 for (i=0;i<S_M_HI(c);i++)
1977 for (j=i+1;j<S_M_LI(c);j++)
1978 {
1979 m_int_int_qelm(S_PA_II(d,S_PA_LI(d)-1-j),
1980 S_PA_II(d,S_PA_LI(d)-1-i),S_M_IJ(c,i,j));
1981 }
1982 pfaffian_matrix(c,b);
1983 erg += freeall(c);
1984 freeall(d);
1985 }
1986 ENDR("m_part_qelm");
1987 }
1988
m_i_powsym(a,b)1989 INT m_i_powsym(a,b) INT a; OP b;
1990 /* changes a INT into a POWSYMpolynomial with this INT as
1991 koeffizent and labeled by the part with one zero part */
1992 {
1993 OP c;
1994 INT erg = OK;
1995 COP("m_i_powsym(2)",b);
1996 c = callocobject();
1997 erg += m_i_i(a,c);
1998 erg += m_scalar_powsym(c,b);
1999 erg += freeall(c);
2000 ENDR("m_i_elmsym");
2001 }
2002
m_i_elmsym(a,b)2003 INT m_i_elmsym(a,b) INT a; OP b;
2004 /* changes a INT into a ELMSYMpolynomial with this INT as
2005 koeffizent and labeled by the part with one zero part */
2006 /* AK 060995 */
2007 {
2008 OP c;
2009 INT erg = OK;
2010 COP("m_i_elmsym(2)",b);
2011 NEW_INTEGER(c,a);
2012 erg += m_scalar_elmsym(c,b);
2013 FREEALL(c);
2014 ENDR("m_i_elmsym");
2015 }
2016
m_i_schur(a,b)2017 INT m_i_schur(a,b) INT a; OP b;
2018 /* changes a INT into a SCHURpolynomial with this INT as
2019 koeffizent and labeled by the part with one zero part */
2020 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2021 /* AK 060498 V2.0 */
2022 {
2023 OP c = callocobject();
2024 INT erg = OK;
2025 erg += m_i_i(a,c);
2026 erg += m_scalar_schur(c,b);
2027 FREEALL(c);
2028 ENDR("m_i_schur");
2029 }
2030
2031
2032
m_scalar_powsym(a,b)2033 INT m_scalar_powsym(a,b) OP a,b;
2034 /* changes a scalar into a POWSYMpolynomial with this scalar as
2035 koeffizent and labeled by the part with zero length self part */
2036 /* AK 060995 */
2037 /* AK 060498 V2.0 */
2038 {
2039 INT erg = OK;
2040 CE2(a,b,m_scalar_powsym);
2041 erg += b_skn_ps(callocobject(),callocobject(),NULL,b);
2042 COPY(a,S_S_K(b));
2043 erg += first_partition(cons_null,S_S_S(b));
2044 ENDR("m_scalar_powsym");
2045 }
2046
m_scalar_homsym(a,b)2047 INT m_scalar_homsym(a,b) OP a,b;
2048 /* changes a scalar into a HOMSYMpolynomial with this scalar as
2049 koeffizent and labeled by the part with zero length self part */
2050 /* AK 060995 */
2051 /* AK 060498 V2.0 */
2052 {
2053 INT erg = OK;
2054 CE2(a,b,m_scalar_homsym);
2055 erg += b_skn_h(callocobject(),callocobject(),NULL,b);
2056 COPY(a,S_S_K(b));
2057 erg += first_partition(cons_null,S_S_S(b));
2058 ENDR("m_scalar_homsym");
2059 }
2060
m_scalar_elmsym(a,b)2061 INT m_scalar_elmsym(a,b) OP a,b;
2062 /* changes a scalar into a ELMSYMpolynomial with this scalar as
2063 koeffizent and labeled by the part with zero length self part */
2064 /* AK 060995 */
2065 /* AK 060498 V2.0 */
2066 {
2067 INT erg = OK;
2068 CE2(a,b,m_scalar_elmsym);
2069 erg += b_skn_e(callocobject(),callocobject(),NULL,b);
2070 COPY(a,S_S_K(b));
2071 erg += first_partition(cons_null,S_S_S(b));
2072 ENDR("m_scalar_elmsym");
2073 }
2074
m_scalar_schur(a,b)2075 INT m_scalar_schur(a,b) OP a,b;
2076 /* changes a scalar into a SCHURpolynomial with this scalar as
2077 coefficient and labeled by the part of zero length */
2078 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2079 /* AK 030498 V2.0 */ /* AK 210704 V3.0 */
2080 {
2081 INT erg = OK;
2082 CE2(a,b,m_scalar_schur);
2083 {
2084 erg += b_skn_s(CALLOCOBJECT(),CALLOCOBJECT(),NULL,b);
2085 COPY(a,S_S_K(b));
2086 erg += first_partition(cons_null,S_S_S(b));
2087 }
2088 ENDR("m_scalar_schur");
2089 }
2090
b_scalar_schur(a,b)2091 INT b_scalar_schur(a,b) OP a,b;
2092 /* changes a scalar into a SCHURpolynomial with this scalar as
2093 koeffizent and labeled by the part with zero length self part */
2094 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2095 /* AK 030498 V2.0 */
2096 {
2097 INT erg = OK;
2098 if (a == b) {
2099 erg += error("b_scalar_schur:identical objects");
2100 goto endr_ende;
2101 }
2102 erg += b_skn_s(CALLOCOBJECT(),a,NULL,b);
2103 erg += first_partition(cons_null,S_S_S(b));
2104 ENDR("b_scalar_schur");
2105 }
2106
b_scalar_powsym(a,b)2107 INT b_scalar_powsym(a,b) OP a,b;
2108 /* changes a scalar into a POWSYM with this scalar as
2109 koeffizent and labeled by the part with zero length self part */
2110 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2111 /* AK 030498 V2.0 */
2112 {
2113 INT erg = OK;
2114 if (a == b) {
2115 erg += error("b_scalar_powsym:identical objects");
2116 goto endr_ende;
2117 }
2118 erg += b_skn_ps(CALLOCOBJECT(),a,NULL,b);
2119 erg += first_partition(cons_null,S_S_S(b));
2120 ENDR("b_scalar_powsym");
2121 }
2122
b_scalar_homsym(a,b)2123 INT b_scalar_homsym(a,b) OP a,b;
2124 /* changes a scalar into a HOMSYM with this scalar as
2125 koeffizent and labeled by the part with zero length self part */
2126 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2127 /* AK 030498 V2.0 */
2128 {
2129 INT erg = OK;
2130 if (a == b) {
2131 erg += error("b_scalar_homsym:identical objects");
2132 goto endr_ende;
2133 }
2134 erg += b_skn_h(CALLOCOBJECT(),a,NULL,b);
2135 erg += first_partition(cons_null,S_S_S(b));
2136 ENDR("b_scalar_homsym");
2137 }
2138
b_scalar_elmsym(a,b)2139 INT b_scalar_elmsym(a,b) OP a,b;
2140 /* changes a scalar into a ELMSYM with this scalar as
2141 koeffizent and labeled by the part with zero length self part */
2142 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2143 /* AK 030498 V2.0 */
2144 {
2145 INT erg = OK;
2146 if (a == b) {
2147 erg += error("b_scalar_elmsym:identical objects");
2148 goto endr_ende;
2149 }
2150 erg += b_skn_e(CALLOCOBJECT(),a,NULL,b);
2151 erg += first_partition(cons_null,S_S_S(b));
2152 ENDR("b_scalar_elmsym");
2153 }
2154
b_scalar_monomial(a,b)2155 INT b_scalar_monomial(a,b) OP a,b;
2156 /* changes a scalar into a MONOMIAL with this scalar as
2157 koeffizent and labeled by the part with zero length self part */
2158 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2159 /* AK 030498 V2.0 */
2160 {
2161 INT erg = OK;
2162 if (a == b) {
2163 erg += error("b_scalar_monomial:identical objects");
2164 goto endr_ende;
2165 }
2166 erg += b_skn_mon(CALLOCOBJECT(),a,NULL,b);
2167 erg += first_partition(cons_null,S_S_S(b));
2168 ENDR("b_scalar_monomial");
2169 }
2170
2171
m_scalar_monomial(a,b)2172 INT m_scalar_monomial(a,b) OP a,b;
2173 /* changes a scalar into a MONOMIAL with this scalar as
2174 koeffizent and labeled by the part with zero length self part */
2175 /* AK 181290 V1.1 */ /* AK 200891 V1.3 */
2176 /* AK 030498 V2.0 */
2177 {
2178 INT erg = OK;
2179 CE2(a,b,m_scalar_monomial);
2180 erg += b_skn_mon(callocobject(),callocobject(),NULL,b);
2181 COPY(a,S_S_K(b));
2182 erg += first_partition(cons_null,S_S_S(b));
2183 ENDR("m_scalar_monomial");
2184 }
2185
2186
mult_schur_powsym(a,b,c)2187 INT mult_schur_powsym(a,b,c) OP a,b,c;
2188 /* AK 031001 */
2189 {
2190 OP d;
2191 INT erg = OK;
2192 CTTO(SCHUR,PARTITION,"mult_schur_powsym(1)",a);
2193 CTTO(POWSYM,PARTITION,"mult_schur_powsym(2)",b);
2194 CTO(EMPTY,"mult_schur_powsym(3)",c);
2195
2196 d = CALLOCOBJECT();
2197 erg += t_SCHUR_POWSYM(a,d);
2198 erg += mult_powsym_powsym(d,b,c);
2199 FREEALL(d);
2200 ENDR("mult_schur_powsym");
2201 }
2202
mult_powsym_monomial(a,b,c)2203 INT mult_powsym_monomial(a,b,c) OP a,b,c;
2204 /* AK 081001 */
2205 {
2206 OP d;
2207 INT erg = OK;
2208 CTTO(POWSYM,PARTITION,"mult_powsym_monomial(1)",a);
2209 CTTO(MONOMIAL,PARTITION,"mult_powsym_monomial(2)",b);
2210 CTO(EMPTY,"mult_powsym_monomial(3)",c);
2211
2212 d = callocobject();
2213 erg += t_POWSYM_MONOMIAL(a,d);
2214 erg += mult_monomial_monomial(d,b,c);
2215 erg += freeall(d);
2216 ENDR("mult_powsym_monomial");
2217 }
2218
mult_powsym_homsym(a,b,c)2219 INT mult_powsym_homsym(a,b,c) OP a,b,c;
2220 /* AK 081001 */
2221 {
2222 OP d;
2223 INT erg = OK;
2224 CTTO(POWSYM,PARTITION,"mult_powsym_homsym",a);
2225 CTTO(HOMSYM,PARTITION,"mult_powsym_homsym",b);
2226 CTO(EMPTY,"mult_powsym_homsym",c);
2227
2228 d = callocobject();
2229 erg += t_POWSYM_HOMSYM(a,d);
2230 erg += mult_homsym_homsym(d,b,c);
2231 erg += freeall(d);
2232 ENDR("mult_powsym_homsym");
2233 }
2234
mult_elmsym_homsym(a,b,c)2235 INT mult_elmsym_homsym(a,b,c) OP a,b,c;
2236 /* AK 081001 */
2237 {
2238 OP d;
2239 INT erg = OK;
2240 CTTTO(HASHTABLE,ELMSYM,PARTITION,"mult_elmsym_homsym(1)",a);
2241 CTTTO(HASHTABLE,HOMSYM,PARTITION,"mult_elmsym_homsym(2)",b);
2242 CTTTO(HOMSYM,HASHTABLE,EMPTY,"mult_elmsym_homsym(3)",c);
2243
2244 NEW_HASHTABLE(d);
2245 erg += t_ELMSYM_HOMSYM(a,d);
2246 erg += mult_homsym_homsym(d,b,c);
2247 FREEALL(d);
2248 ENDR("mult_elmsym_homsym");
2249 }
2250
mult_monomial_homsym(a,b,c)2251 INT mult_monomial_homsym(a,b,c) OP a,b,c;
2252 /* AK 081001 */
2253 {
2254 OP d;
2255 INT erg = OK;
2256 CTTO(MONOMIAL,PARTITION,"mult_monomial_homsym(1)",a);
2257 CTTO(HOMSYM,PARTITION,"mult_monomial_homsym(2)",b);
2258 CTO(EMPTY,"mult_monomial_homsym",c);
2259
2260 d = callocobject();
2261 erg += t_MONOMIAL_HOMSYM(a,d);
2262 erg += mult_homsym_homsym(d,b,c);
2263 erg += freeall(d);
2264 ENDR("mult_monomial_homsym");
2265 }
2266
2267
mult_powsym_elmsym(a,b,c)2268 INT mult_powsym_elmsym(a,b,c) OP a,b,c;
2269 /* AK 081001 */
2270 {
2271 OP d;
2272 INT erg = OK;
2273 CTTO(POWSYM,PARTITION,"mult_powsym_elmsym",a);
2274 CTTO(ELMSYM,PARTITION,"mult_powsym_elmsym",b);
2275 CTO(EMPTY,"mult_powsym_elmsym",c);
2276
2277 d = callocobject();
2278 erg += t_POWSYM_ELMSYM(a,d);
2279 erg += mult_elmsym_elmsym(d,b,c);
2280 erg += freeall(d);
2281 ENDR("mult_powsym_elmsym");
2282 }
2283
mult_monomial_elmsym(a,b,c)2284 INT mult_monomial_elmsym(a,b,c) OP a,b,c;
2285 /* AK 081001 */
2286 {
2287 OP d;
2288 INT erg = OK;
2289 CTTO(MONOMIAL,PARTITION,"mult_monomial_elmsym",a);
2290 CTTO(ELMSYM,PARTITION,"mult_monomial_elmsym",b);
2291 CTO(EMPTY,"mult_monomial_elmsym",c);
2292
2293 d = CALLOCOBJECT();init_hashtable(d);
2294 erg += t_MONOMIAL_ELMSYM(a,d);
2295 erg += mult_elmsym_elmsym(d,b,c);
2296 erg += freeall(d);
2297 ENDR("mult_monomial_elmsym");
2298 }
2299
2300
2301
2302
2303
2304
mult_elmsym_powsym(a,b,c)2305 INT mult_elmsym_powsym(a,b,c) OP a,b,c;
2306 /* AK 081001 */
2307 {
2308 OP d;
2309 INT erg = OK;
2310 CTTO(ELMSYM,PARTITION,"mult_elmsym_powsym",a);
2311 CTTO(POWSYM,PARTITION,"mult_elmsym_powsym",b);
2312 CTO(EMPTY,"mult_elmsym_powsym",c);
2313
2314 d = callocobject();
2315 erg += t_ELMSYM_POWSYM(a,d);
2316 erg += mult_powsym_powsym(d,b,c);
2317 erg += freeall(d);
2318 ENDR("mult_elmsym_powsym");
2319 }
2320
mult_monomial_powsym(a,b,c)2321 INT mult_monomial_powsym(a,b,c) OP a,b,c;
2322 /* AK 081001 */
2323 {
2324 OP d;
2325 INT erg = OK;
2326 CTTO(MONOMIAL,PARTITION,"mult_monomial_powsym",a);
2327 CTTO(POWSYM,PARTITION,"mult_monomial_powsym",b);
2328 CTO(EMPTY,"mult_monomial_powsym",c);
2329
2330 d = callocobject();
2331 erg += t_MONOMIAL_POWSYM(a,d);
2332 erg += mult_powsym_powsym(d,b,c);
2333 erg += freeall(d);
2334 ENDR("mult_monomial_powsym");
2335 }
2336
2337 #define ADDINVERS_APPLY_SF(a) \
2338 { \
2339 OP z; \
2340 FORALL(z,a,ADDINVERS_APPLY(S_MO_K(z))); \
2341 }
2342
addinvers_apply_schur(a)2343 INT addinvers_apply_schur(a) OP a;
2344 /* AK 290402 */
2345 {
2346 INT erg = OK;
2347 CTTO(SCHUR,HASHTABLE,"addinvers_apply_schur(1)",a);
2348 ADDINVERS_APPLY_SF(a);
2349 ENDR("addinvers_apply_schur");
2350 }
2351
addinvers_apply_homsym(a)2352 INT addinvers_apply_homsym(a) OP a;
2353 /* AK 290402 */
2354 {
2355 INT erg = OK;
2356 CTTO(HOMSYM,HASHTABLE,"addinvers_apply_homsym(1)",a);
2357 ADDINVERS_APPLY_SF(a);
2358 ENDR("addinvers_apply_homsym");
2359 }
2360
addinvers_apply_powsym(a)2361 INT addinvers_apply_powsym(a) OP a;
2362 /* AK 290402 */
2363 {
2364 INT erg = OK;
2365 CTTO(POWSYM,HASHTABLE,"addinvers_apply_powsym(1)",a);
2366 ADDINVERS_APPLY_SF(a);
2367 ENDR("addinvers_apply_powsym");
2368 }
2369
addinvers_apply_elmsym(a)2370 INT addinvers_apply_elmsym(a) OP a;
2371 /* AK 290402 */
2372 {
2373 INT erg = OK;
2374 CTTO(ELMSYM,HASHTABLE,"addinvers_apply_elmsym(1)",a);
2375 ADDINVERS_APPLY_SF(a);
2376 ENDR("addinvers_apply_elmsym");
2377 }
2378
addinvers_apply_monomial(a)2379 INT addinvers_apply_monomial(a) OP a;
2380 /* AK 290402 */
2381 {
2382 INT erg = OK;
2383 CTTO(MONOMIAL,HASHTABLE,"addinvers_apply_monomial(1)",a);
2384 ADDINVERS_APPLY_SF(a);
2385 ENDR("addinvers_apply_monomial");
2386 }
2387
2388
2389
2390 #define ADD_SF(a,b,c,typ,cf,addf) \
2391 switch((int)S_O_K(b)) {\
2392 case typ: erg += addf(a,b,c); goto ende;\
2393 default: {\
2394 OP add_sf_c;\
2395 add_sf_c = CALLOCOBJECT();\
2396 cf(b,add_sf_c); \
2397 erg += addf(a,add_sf_c,c); \
2398 FREEALL(add_sf_c);\
2399 goto ende; }\
2400 }\
2401 ende:
2402
add_schur(a,b,c)2403 INT add_schur(a,b,c) OP a,b,c;
2404 /* AK 080102 */
2405 {
2406 INT erg = OK;
2407 CTO(SCHUR,"add_schur(1)",a);
2408 CTO(EMPTY,"add_schur(3)",c);
2409 ADD_SF(a,b,c,SCHUR,cast_schur,add_schur_schur);
2410 CTO(SCHUR,"add_schur(e3)",c);
2411 ENDR("add_schur");
2412 }
2413
add_monomial(a,b,c)2414 INT add_monomial(a,b,c) OP a,b,c;
2415 /* AK 080102 */
2416 {
2417 INT erg = OK;
2418 CTO(MONOMIAL,"add_monomial(1)",a);
2419 CTO(EMPTY,"add_monomial(3)",c);
2420 ADD_SF(a,b,c,MONOMIAL,cast_monomial,add_monomial_monomial);
2421 CTO(MONOMIAL,"add_monomial(e3)",c);
2422 ENDR("add_monomial");
2423 }
add_homsym(a,b,c)2424 INT add_homsym(a,b,c) OP a,b,c;
2425 /* AK 080102 */
2426 {
2427 INT erg = OK;
2428 CTO(HOMSYM,"add_homsym(1)",a);
2429 CTO(EMPTY,"add_homsym(3)",c);
2430 ADD_SF(a,b,c,HOMSYM,cast_homsym,add_homsym_homsym);
2431 CTO(HOMSYM,"add_homsym(e3)",c);
2432 ENDR("add_homsym");
2433 }
add_powsym(a,b,c)2434 INT add_powsym(a,b,c) OP a,b,c;
2435 /* AK 080102 */
2436 {
2437 INT erg = OK;
2438 CTO(POWSYM,"add_powsym(1)",a);
2439 CTO(EMPTY,"add_powsym(3)",c);
2440 ADD_SF(a,b,c,POWSYM,cast_powsym,add_powsym_powsym);
2441 CTO(POWSYM,"add_powsym(e3)",c);
2442 ENDR("add_powsym");
2443 }
add_elmsym(a,b,c)2444 INT add_elmsym(a,b,c) OP a,b,c;
2445 /* AK 080102 */
2446 {
2447 INT erg = OK;
2448 CTO(ELMSYM,"add_elmsym(1)",a);
2449 CTO(EMPTY,"add_elmsym(3)",c);
2450 ADD_SF(a,b,c,ELMSYM,cast_elmsym,add_elmsym_elmsym);
2451 CTO(ELMSYM,"add_elmsym(e3)",c);
2452 ENDR("add_elmsym");
2453 }
2454
2455
2456
2457
2458
mult_apply_monomial_monomial(a,b)2459 INT mult_apply_monomial_monomial(a,b) OP a,b;
2460 /* platzhalter */
2461 /* b = b*a */
2462 {
2463 INT erg = OK;
2464 OP c;
2465 CTTO(HASHTABLE,MONOMIAL,"mult_apply_monomial_monomial",a);
2466 CTTO(HASHTABLE,MONOMIAL,"mult_apply_monomial_monomial",b);
2467
2468 c = CALLOCOBJECT();
2469 if (S_O_K(b) == HASHTABLE) erg += init_hashtable(c);
2470 erg += mult_monomial_monomial(a,b,c);
2471 SWAP(c,b);
2472 FREEALL(c);
2473
2474 ENDR("mult_apply_monomial_monomial");
2475 }
2476 INT mapp_hashtable_hashtable_();
2477
mult_apply_powsym_powsym(a,b)2478 INT mult_apply_powsym_powsym(a,b) OP a,b;
2479 /* AK 060901 */
2480 /* a and b of equal type */
2481 /* b := a * b */
2482 /* AK 160603 case of empty lists */
2483 {
2484 INT erg = OK;
2485 OP z,y;
2486 CTTO(HASHTABLE,POWSYM,"mult_apply_powsym_powsym(1)",a);
2487 CTTO(HASHTABLE,POWSYM,"mult_apply_powsym_powsym(2)",b);
2488
2489 if (S_O_K(a) == HASHTABLE) {
2490 erg += mapp_hashtable_hashtable_(a,b,cons_eins);
2491 goto ende;
2492 }
2493
2494 if (S_O_K(b) == HASHTABLE) {
2495 erg += mapp_hashtable_hashtable_(a,b,cons_eins);
2496 goto ende;
2497 }
2498
2499 if (S_L_S(b) == NULL) goto endr_ende; /* AK 160603 */
2500 if (S_L_S(a) == NULL) { init(POWSYM,b); goto endr_ende; } /* AK 160603 */
2501
2502 z = a;
2503 if (S_S_N(z) == NULL) /* only one summand in a */
2504 {
2505 y = b;
2506 while (y != NULL)
2507 {
2508 MULT_APPLY(S_S_K(z),S_S_K(y));
2509 erg += append_apply_part(S_S_S(y),S_S_S(z)); /* y = y+z */
2510 y = S_S_N(y);
2511 }
2512 goto endr_ende;
2513 }
2514
2515
2516 /* the function b must be copied */
2517 z = CALLOCOBJECT();
2518 *z = *b;
2519 C_O_K(b,EMPTY);
2520 erg += mult_powsym_powsym(a,z,b);
2521 FREEALL(z);
2522 ende:
2523 ENDR("mult_apply_powsym_powsym");
2524 }
2525
2526
mult_apply_elmsym_elmsym(a,b)2527 INT mult_apply_elmsym_elmsym(a,b) OP a,b;
2528 /* b := a * b */
2529 /* AK 161001 */
2530 {
2531 INT erg = OK;
2532 OP z,y;
2533 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mult_apply_elmsym_elmsym(1)",a);
2534 CTTO(ELMSYM,HASHTABLE,"mult_apply_elmsym_elmsym(2)",b);
2535 if (NULLP(b)) goto ende;
2536 if (NULLP(a)) {
2537 if (S_O_K(b) == HASHTABLE) CLEAR_HASHTABLE(b);
2538 else erg += init(ELMSYM,b);
2539 goto ende;
2540 }
2541
2542 if (
2543 (S_O_K(b) == HASHTABLE) ||
2544 (S_O_K(a) == HASHTABLE)
2545 )
2546 {
2547 z = CALLOCOBJECT();
2548 *z = *b;
2549 C_O_K(b,EMPTY);
2550 init(S_O_K(z),b);
2551 erg += mult_elmsym_elmsym(a,z,b);
2552 FREEALL(z);
2553 goto endr_ende;
2554 }
2555 if (S_O_K(a) == PARTITION)
2556 {
2557 y = b;
2558 while (y != NULL)
2559 {
2560 erg += append_apply_part(S_S_S(y),a); /* y = y+a */
2561 y = S_S_N(y);
2562 }
2563 goto endr_ende;
2564 }
2565 /* a is ELMSYM */
2566 z = a;
2567 if (S_S_N(z) == NULL) /* only one summand in a */
2568 {
2569 y = b;
2570 while (y != NULL)
2571 {
2572 erg += mult_apply(S_S_K(z),S_S_K(y));
2573 erg += append_apply_part(S_S_S(y),S_S_S(z)); /* y = y+z */
2574 y = S_S_N(y);
2575 }
2576 goto endr_ende;
2577 }
2578 /* the function b must be copied */
2579 z = CALLOCOBJECT();
2580 *z = *b;
2581 C_O_K(b,EMPTY);
2582 erg += mult_elmsym_elmsym(a,z,b);
2583 erg += freeall(z);
2584 ende:
2585 ENDR("mult_apply_elmsym_elmsym");
2586 }
2587
mult_apply_homsym_schur(a,b)2588 INT mult_apply_homsym_schur(a,b) OP a,b;
2589 /* b := a * b */
2590 /* AK 221001 */
2591 {
2592 INT erg = OK;
2593 OP c;
2594
2595 CTTTO(HASHTABLE,PARTITION,HOMSYM,"mult_apply_homsym_schur(1)",a);
2596 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_apply_homsym_schur(2)",b);
2597 c = CALLOCOBJECT();
2598 *c = *b;
2599 C_O_K(b,EMPTY);
2600
2601 if (S_O_K(c) == HASHTABLE) init_hashtable(b);
2602 else init_schur(b);
2603
2604 erg += mult_homsym_schur(a,c,b);
2605 FREEALL(c);
2606 ENDR("mult_apply_homsym_schur");
2607 }
2608
mahh_partition_hashtable_(a,b,f)2609 INT mahh_partition_hashtable_(a,b,f) OP a,b;OP f;
2610 /* AK 240102 */
2611 {
2612 INT erg = OK;
2613 OP z,m;
2614 if (mahh_h==NULL) {
2615 NEW_HASHTABLE(mahh_h);
2616 }
2617
2618 TCTO(PARTITION,"mahh_partition_hashtable_(1)",a);
2619 TCTO(HASHTABLE,"mahh_partition_hashtable_(2)",b);
2620 TCTO(HASHTABLE,"mahh_partition_hashtable_(i3)",mahh_h);
2621 FORALL(z,b, {
2622 m = CALLOCOBJECT();
2623 *m = *z;
2624 C_O_K(z,EMPTY);
2625 append_apply_part(S_MO_S(m),a); /* m = m + a */
2626 MULT_APPLY(f,S_MO_K(m));
2627 insert_scalar_hashtable(m,mahh_h,add_koeff,eq_monomsymfunc,hash_monompartition);
2628 DEC_INTEGER(S_V_I(b,S_V_LI(b)));
2629 });
2630 TCTO(HASHTABLE,"mahh_partition_hashtable_(i2)",b);
2631 SYMCHECK(WEIGHT_HASHTABLE(b) != 0,"mahh_partition_hashtable_:i1");
2632 SWAP(mahh_h,b);
2633
2634 ENDR("mahh_partition_hashtable_");
2635 }
2636
2637
mahh_hashtable_hashtable_(a,b,f)2638 INT mahh_hashtable_hashtable_(a,b,f) OP a,b,f;
2639 /* AK 240102 */
2640 {
2641 INT erg = OK;
2642 OP c;
2643 INT mhh_partition_partition_();
2644 CTTO(HOMSYM,HASHTABLE,"mahh_hashtable_hashtable_(1)",a);
2645 CTO(HASHTABLE,"mahh_hashtable_hashtable_(2)",b);
2646 NEW_HASHTABLE(c);
2647 SWAP(b,c);
2648 M_FORALL_MONOMIALS_IN_AB(a,c,b,f,mhh_partition_partition_);
2649 FREEALL(c);
2650 ENDR("mahh_hashtable_hashtable_");
2651 }
2652
mapp_hashtable_hashtable_(a,b,f)2653 INT mapp_hashtable_hashtable_(a,b,f) OP a,b,f;
2654 /* AK 240102 */
2655 {
2656 INT erg = OK;
2657 OP c;
2658 INT mpp_partition_partition_();
2659 CTTO(POWSYM,HASHTABLE,"mapp_hashtable_hashtable_(1)",a);
2660 CTTO(HASHTABLE,POWSYM,"mapp_hashtable_hashtable_(2)",b);
2661 NEW_HASHTABLE(c);
2662 SWAP(b,c);
2663 M_FORALL_MONOMIALS_IN_AB(a,c,b,f,mpp_partition_partition_);
2664 FREEALL(c);
2665 ENDR("mapp_hashtable_hashtable_");
2666 }
2667
2668
mahh_integer_homsym_(a,b,f)2669 INT mahh_integer_homsym_(a,b,f) OP a,b,f;
2670 /* AK 290102 */
2671 {
2672 INT erg = OK;
2673 OP z;
2674 CTO(INTEGER,"mahh_integer_homsym_(1)",a);
2675 CTO(HOMSYM,"mahh_integer_homsym_(2)",b);
2676 FORALL(z,b,{
2677 erg += append_apply_part(S_MO_S(z),a);
2678 if (not EINSP(f)) {
2679 MULT_APPLY(f,S_MO_K(z));
2680 }
2681 });
2682 ENDR("mahh_integer_homsym_");
2683 }
2684
mult_apply_homsym_homsym(a,b)2685 INT mult_apply_homsym_homsym(a,b) OP a,b;
2686 /* b := a * b */
2687 /* AK 161001 */
2688 {
2689 INT erg = OK;
2690 OP z,y;
2691 CTTTTO(INTEGER,HASHTABLE,PARTITION,HOMSYM,"mult_apply_homsym_homsym(1)",a);
2692 CTTO(HASHTABLE,HOMSYM,"mult_apply_homsym_homsym(2)",b);
2693
2694 if (S_O_K(a) == INTEGER)
2695 {
2696 OP c;
2697 if (S_O_K(b) == HOMSYM)
2698 {
2699 erg += mahh_integer_homsym_(a,b,cons_eins);
2700 goto ende;
2701 }
2702 else {
2703 c = CALLOCOBJECT();
2704 m_i_pa(a,c);
2705 erg += mult_apply_homsym_homsym(c,b);
2706 FREEALL(c);
2707 goto ende;
2708 }
2709 }
2710 if (S_O_K(b) == HASHTABLE)
2711 {
2712 if (S_O_K(a) == PARTITION) erg += mahh_partition_hashtable_(a,b,cons_eins);
2713 else erg+=mahh_hashtable_hashtable_(a,b,cons_eins);
2714 goto ende;
2715 }
2716 if (S_O_K(a) == HASHTABLE)
2717 {
2718 z = CALLOCOBJECT();
2719 init_homsym(z);
2720 SWAP(z,b);
2721 erg += mult_homsym_homsym(a,z,b);
2722 FREEALL(z);
2723 goto endr_ende;
2724 }
2725 /* no more hashtables */
2726 if (S_L_S(b) == NULL) { /* null */
2727 goto endr_ende;
2728 }
2729 if (S_O_K(a) == PARTITION)
2730 {
2731 y = b;
2732 while (y != NULL)
2733 {
2734 erg += append_apply_part(S_S_S(y),a); /* y = y+a */
2735 y = S_S_N(y);
2736 }
2737 goto endr_ende;
2738 }
2739 /* a is HOMSYM */
2740
2741 if (NULLP(a)) {
2742 erg += init(HOMSYM,b);
2743 goto endr_ende;
2744 }
2745
2746 z = a;
2747 if (S_S_N(z) == NULL) /* only one summand in a */
2748 {
2749 y = b;
2750 while (y != NULL)
2751 {
2752 MULT_APPLY(S_S_K(z),S_S_K(y));
2753 erg += append_apply_part(S_S_S(y),S_S_S(z)); /* y = y+z */
2754 y = S_S_N(y);
2755 }
2756 goto endr_ende;
2757 }
2758
2759 /* the function b must be copied */
2760 z = callocobject();
2761 *z = *b;
2762 C_O_K(b,EMPTY);
2763 erg += mult_homsym_homsym(a,z,b);
2764 erg += freeall(z);
2765 ende:
2766 ENDR("mult_apply_homsym_homsym");
2767 }
2768
mult_apply_homsym(a,b)2769 INT mult_apply_homsym(a,b) OP a,b;
2770 /* AK 311001 */
2771 {
2772 INT erg = OK;
2773 CTO(HOMSYM,"mult_apply_homsym(1)",a);
2774 if (S_O_K(b) == HOMSYM)
2775 erg += mult_apply_homsym_homsym(a,b);
2776 else if (S_O_K(b) == SCHUR)
2777 erg += mult_apply_homsym_schur(a,b);
2778 else
2779 {
2780 OP c = CALLOCOBJECT();
2781 *c = *b;
2782 C_O_K(b,EMPTY);
2783 erg += mult_homsym(a,c,b);
2784 FREEALL(c);
2785 }
2786 ENDR("mult_apply_homsym");
2787 }
2788
mult_apply_powsym(a,b)2789 INT mult_apply_powsym(a,b) OP a,b;
2790 /* AK 311001 */
2791 {
2792 INT erg = OK;
2793 CTO(POWSYM,"mult_apply_powsym(1)",a);
2794 if (S_O_K(b) == POWSYM)
2795 erg += mult_apply_powsym_powsym(a,b);
2796 else
2797 {
2798 OP c = CALLOCOBJECT();
2799 *c = *b;
2800 C_O_K(b,EMPTY);
2801 erg += mult_powsym(a,c,b);
2802 FREEALL(c);
2803 }
2804 ENDR("mult_apply_powsym");
2805 }
2806
mult_apply_elmsym(a,b)2807 INT mult_apply_elmsym(a,b) OP a,b;
2808 /* AK 311001 */
2809 {
2810 INT erg = OK;
2811 CTO(ELMSYM,"mult_apply_elmsym(1)",a);
2812 if (S_O_K(b) == ELMSYM)
2813 erg += mult_apply_elmsym_elmsym(a,b);
2814 else
2815 {
2816 OP c = CALLOCOBJECT();
2817 *c = *b;
2818 C_O_K(b,EMPTY);
2819 erg += mult_elmsym(a,c,b);
2820 FREEALL(c);
2821 }
2822 ENDR("mult_apply_elmsym");
2823 }
2824
mult_apply_schur(a,b)2825 INT mult_apply_schur(a,b) OP a,b;
2826 /* AK 311001 */
2827 /* b = a*b */
2828 {
2829 INT erg = OK;
2830 CTO(SCHUR,"mult_apply_schur(1)",a);
2831 if (S_O_K(b) == SCHUR)
2832 erg += mult_apply_schur_schur(a,b);
2833 else
2834 {
2835 OP c = CALLOCOBJECT();
2836 *c = *b;
2837 C_O_K(b,EMPTY);
2838 erg += mult_schur(a,c,b);
2839 FREEALL(c);
2840 }
2841 ENDR("mult_apply_schur");
2842 }
2843
mult_apply_monomial(a,b)2844 INT mult_apply_monomial(a,b) OP a,b;
2845 /* AK 270901 */
2846 /* a is monomial
2847 b is unknown
2848 they are different */
2849 {
2850 INT erg = OK;
2851 OP c;
2852 CTO(MONOMIAL,"mult_apply_monomial(1)",a);
2853 c = callocobject();
2854 erg += swap(b,c);
2855 erg += mult_monomial(a,c,b);
2856 erg += freeall(c);
2857 ENDR("mult_apply_monomial");
2858 }
2859
2860
2861 #define MULT_SF_SCALAR(a,b,c) \
2862 {\
2863 OP z;\
2864 if (NULLP(b)) init(S_O_K(a),c);\
2865 else {\
2866 COPY(a,c);\
2867 FORALL(z,c,MULT_APPLY(b,S_MO_K(z)));\
2868 }\
2869 }
2870
mult_schur_scalar(a,b,c)2871 INT mult_schur_scalar(a,b,c) OP a,b,c;
2872 /* AK 080102 */
2873 {
2874 INT erg = OK;
2875 CTO(SCHUR,"mult_schur_scalar(1)",a);
2876 CTO(EMPTY,"mult_schur_scalar(3)",c);
2877 MULT_SF_SCALAR(a,b,c);
2878 ENDR("mult_schur_scalar");
2879 }
mult_monomial_scalar(a,b,c)2880 INT mult_monomial_scalar(a,b,c) OP a,b,c;
2881 /* AK 080102 */
2882 {
2883 INT erg = OK;
2884 CTO(MONOMIAL,"mult_monomial_scalar(1)",a);
2885 CTO(EMPTY,"mult_monomial_scalar(3)",c);
2886 MULT_SF_SCALAR(a,b,c);
2887 ENDR("mult_monomial_scalar");
2888 }
mult_homsym_scalar(a,b,c)2889 INT mult_homsym_scalar(a,b,c) OP a,b,c;
2890 /* AK 080102 */
2891 {
2892 INT erg = OK;
2893 CTO(HOMSYM,"mult_homsym_scalar(1)",a);
2894 CTO(EMPTY,"mult_homsym_scalar(3)",c);
2895 MULT_SF_SCALAR(a,b,c);
2896 ENDR("mult_homsym_scalar");
2897 }
mult_powsym_scalar(a,b,c)2898 INT mult_powsym_scalar(a,b,c) OP a,b,c;
2899 /* AK 080102 */
2900 {
2901 INT erg = OK;
2902 CTO(POWSYM,"mult_powsym_scalar(1)",a);
2903 CTO(EMPTY,"mult_powsym_scalar(3)",c);
2904 MULT_SF_SCALAR(a,b,c);
2905 ENDR("mult_powsym_scalar");
2906 }
mult_elmsym_scalar(a,b,c)2907 INT mult_elmsym_scalar(a,b,c) OP a,b,c;
2908 /* AK 080102 */
2909 {
2910 INT erg = OK;
2911 CTO(ELMSYM,"mult_elmsym_scalar(1)",a);
2912 CTO(EMPTY,"mult_elmsym_scalar(3)",c);
2913 MULT_SF_SCALAR(a,b,c);
2914 ENDR("mult_elmsym_scalar");
2915 }
2916
2917 #define MULT_SF(a,b,c,scalarf,schurf,homsymf,monomialf,elmsymf,powsymf,t)\
2918 switch(S_O_K(b)) \
2919 {\
2920 case INTEGER:\
2921 case LONGINT:\
2922 case FF:\
2923 case CYCLOTOMIC:\
2924 case SQ_RADICAL:\
2925 case POLYNOM:\
2926 case BRUCH: erg += scalarf(a,b,c); goto endr_ende;\
2927 case SCHUR: erg += schurf(a,b,c); goto endr_ende;\
2928 case HOMSYM: erg += homsymf(a,b,c); goto endr_ende;\
2929 case MONOMIAL: erg += monomialf(a,b,c); goto endr_ende;\
2930 case ELMSYM: erg += elmsymf(a,b,c); goto endr_ende;\
2931 case POWSYM: erg += powsymf(a,b,c); goto endr_ende;\
2932 default: erg += WTO(t,b); goto endr_ende;\
2933 }
2934
mult_schur(a,b,c)2935 INT mult_schur(a,b,c) OP a,b,c;
2936 /* AK 080102 */
2937 {
2938 INT erg = OK;
2939 CTO(SCHUR,"mult_schur(1)",a);
2940 CTO(EMPTY,"mult_schur(3)",c);
2941 MULT_SF(a,b,c,mult_schur_scalar,mult_schur_schur,mult_schur_homsym,
2942 mult_schur_monomial,mult_schur_elmsym,mult_schur_powsym,
2943 "mult_schur(2)");
2944 ENDR("mult_schur");
2945 }
2946
mult_homsym(a,b,c)2947 INT mult_homsym(a,b,c) OP a,b,c;
2948 /* AK 080102 */
2949 {
2950 INT erg = OK;
2951 CTO(HOMSYM,"mult_homsym(1)",a);
2952 CTO(EMPTY,"mult_homsym(3)",c);
2953 MULT_SF(a,b,c,mult_homsym_scalar,mult_homsym_schur,mult_homsym_homsym,
2954 mult_homsym_monomial,mult_homsym_elmsym,mult_homsym_powsym,
2955 "mult_homsym(2)");
2956 ENDR("mult_homsym");
2957 }
mult_powsym(a,b,c)2958 INT mult_powsym(a,b,c) OP a,b,c;
2959 /* AK 080102 */
2960 {
2961 INT erg = OK;
2962 CTO(POWSYM,"mult_powsym(1)",a);
2963 CTO(EMPTY,"mult_powsym(3)",c);
2964 MULT_SF(a,b,c,mult_powsym_scalar,mult_powsym_schur,mult_powsym_homsym,
2965 mult_powsym_monomial,mult_powsym_elmsym,mult_powsym_powsym,
2966 "mult_powsym(2)");
2967 ENDR("mult_powsym");
2968 }
mult_elmsym(a,b,c)2969 INT mult_elmsym(a,b,c) OP a,b,c;
2970 /* AK 080102 */
2971 {
2972 INT erg = OK;
2973 CTO(ELMSYM,"mult_elmsym(1)",a);
2974 CTO(EMPTY,"mult_elmsym(3)",c);
2975 MULT_SF(a,b,c,mult_elmsym_scalar,mult_elmsym_schur,mult_elmsym_homsym,
2976 mult_elmsym_monomial,mult_elmsym_elmsym,mult_elmsym_powsym,
2977 "mult_elmsym(2)");
2978 ENDR("mult_elmsym");
2979 }
mult_monomial(a,b,c)2980 INT mult_monomial(a,b,c) OP a,b,c;
2981 /* AK 080102 */
2982 {
2983 INT erg = OK;
2984 CTO(MONOMIAL,"mult_monomial(1)",a);
2985 CTO(EMPTY,"mult_monomial(3)",c);
2986 MULT_SF(a,b,c,mult_monomial_scalar,mult_monomial_schur,mult_monomial_homsym,
2987 mult_monomial_monomial,mult_monomial_elmsym,mult_monomial_powsym,
2988 "mult_monomial(2)");
2989 ENDR("mult_monomial");
2990 }
2991
2992
2993
2994
number_nat_matrices(a,b,c)2995 INT number_nat_matrices(a,b,c) OP a,b,c;
2996 /* AK 180901 */
2997 /* number of matrices of rowsum a
2998 coulmnsum b
2999 of the non negative numbers */
3000 /* computed using the kostka number of skew shape */
3001 {
3002 INT erg = OK;
3003 INT i,w;
3004 OP inner,outer,spa;
3005 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"number_nat_matrices",a);
3006 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"number_nat_matrices",b);
3007 if (S_O_K(a) == VECTOR) {
3008 for (i=0;i<S_V_LI(a);i++)
3009 if (S_O_K(S_V_I(a,i)) != INTEGER) {
3010 error("number_nat_matrices:no integer vector");
3011 goto endr_ende;
3012 }
3013 }
3014 if (S_O_K(b) == VECTOR) {
3015 for (i=0;i<S_V_LI(b);i++)
3016 if (S_O_K(S_V_I(b,i)) != INTEGER) {
3017 error("number_nat_matrices:no integer vector");
3018 goto endr_ende;
3019 }
3020 }
3021 if (S_O_K(a) == PARTITION) {
3022 if (S_PA_K(a) != VECTOR)
3023 {
3024 erg += error("number_nat_matrices:only for vector type partitions");
3025 goto endr_ende;
3026 }
3027 erg += number_nat_matrices(S_PA_S(a),b,c);
3028 goto endr_ende;
3029 }
3030 if (S_O_K(b) == PARTITION) {
3031 if (S_PA_K(b) != VECTOR)
3032 {
3033 erg += error("number_nat_matrices:only for vector type partitions");
3034 goto endr_ende;
3035 }
3036 erg += number_nat_matrices(a,S_PA_S(b),c);
3037 goto endr_ende;
3038 }
3039
3040 for (i=0,w=0;i<S_V_LI(a);i++)
3041 w += S_V_II(a,i);
3042 inner = callocobject();
3043 outer = callocobject();
3044
3045 erg += m_il_v(S_V_LI(a),outer);
3046 erg += m_il_v(S_V_LI(a)-1,inner);
3047
3048 for (i=S_V_LI(a)-1;i>0;i--)
3049 {
3050 M_I_I(w,S_V_I(outer,i));
3051 w = w - S_V_II(a,i);
3052 M_I_I(w,S_V_I(inner,i-1));
3053 }
3054 M_I_I(w,S_V_I(outer,i));
3055 erg += m_v_pa(inner,inner);
3056 erg += m_v_pa(outer,outer);
3057
3058 spa = callocobject();
3059 erg += m_gk_spa(outer,inner,spa);
3060 erg += freeall(inner);
3061 erg += freeall(outer);
3062
3063 erg += kostka_number_skewpartition(b,spa,c);
3064 erg += freeall(spa);
3065 ENDR("number_nat_matrices");
3066 }
3067
t_ELMSYM_MONOMIAL(a,b)3068 INT t_ELMSYM_MONOMIAL(a,b) OP a,b;
3069 /* AK 270901 */
3070 /* using multiplication e_I * m_0 -> \sum m_J */
3071 /* fastest up to now */
3072 {
3073 INT erg = OK;
3074 OP m;
3075 CTTTTO(HASHTABLE,INTEGER,PARTITION,ELMSYM,"t_ELMSYM_MONOMIAL",a);
3076 TCE2(a,b,t_ELMSYM_MONOMIAL,MONOMIAL);
3077
3078 m=CALLOCOBJECT();
3079
3080 erg += first_partition(cons_null,m);
3081 erg += m_pa_mon(m,m);
3082 erg += mult_elmsym_monomial(a,m,b);
3083
3084 FREEALL(m);
3085 ENDR("t_ELMSYM_MONOMIAL");
3086 }
3087
all_01_matrices_rek_160802(a,c,d,i,b)3088 static INT all_01_matrices_rek_160802(a,c,d,i,b) OP a,b,c,d; INT i;
3089 /* AK 160802 */
3090 {
3091 INT erg=OK;
3092 if (i>=S_V_LI(a)) {
3093 INC(b);
3094 COPY(d,S_V_I(b,S_V_LI(b)-1));
3095 }
3096 else {
3097 OP e;
3098 INT j;
3099 erg = ERROR;
3100 e = callocobject();
3101 first_subset(S_V_L(c),S_V_I(a,i), e);
3102 do {
3103 for (j=0;j<S_V_LI(c);j++)
3104 {
3105 if ((S_V_II(e,j) == 1) &&
3106 (S_V_II(c,j) == 0) )
3107 goto stop;
3108 }
3109 /* the composition is ok */
3110 for (j=0;j<S_V_LI(c);j++)
3111 {
3112 if (S_V_II(e,j) == 1)
3113 {
3114 M_I_I(1,S_M_IJ(d,i,j));
3115 DEC_INTEGER(S_V_I(c,j));
3116 }
3117 }
3118 /* now recursion */
3119 erg = all_01_matrices_rek_160802(a,c,d,i+1,b);
3120 for (j=0;j<S_V_LI(c);j++)
3121 {
3122 if (S_V_II(e,j) == 1)
3123 {
3124 M_I_I(0,S_M_IJ(d,i,j));
3125 INC_INTEGER(S_V_I(c,j));
3126 }
3127 }
3128 stop: ;
3129 } while(next_apply(e));
3130 freeall(e);
3131 }
3132 ENDR("internal routine:all_01_matrices_rek_160802");
3133 }
3134
all_01_matrices(a,b,c)3135 INT all_01_matrices(a,b,c) OP a,b,c;
3136 /* AK 160802 */
3137 /* generates a vector of 01 matrices */
3138 {
3139 INT erg = OK;
3140 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"all_01_matrices(1)",a);
3141 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"all_01_matrices(2)",b);
3142
3143 CE3(a,b,c,all_01_matrices);
3144 if (S_O_K(a) == PARTITION) a = S_PA_S(a);
3145 if (S_O_K(b) == PARTITION) b = S_PA_S(b);
3146 if (S_O_K(a) == VECTOR) {
3147 INT i;
3148 for (i=0;i<S_V_LI(a);i++)
3149 if (S_O_K(S_V_I(a,i)) != INTEGER) {
3150 error("all_01_matrices:no integer vector");
3151 goto endr_ende;
3152 }
3153 }
3154 if (S_O_K(b) == VECTOR) {
3155 INT i;
3156 for (i=0;i<S_V_LI(b);i++)
3157 if (S_O_K(S_V_I(b,i)) != INTEGER) {
3158 error("all_01_matrices:no integer vector");
3159 goto endr_ende;
3160 }
3161 }
3162
3163 {
3164 OP d;
3165 d = CALLOCOBJECT();
3166 erg += m_il_v(0,c);
3167 erg += m_lh_nm(S_V_L(b),S_V_L(a),d);
3168 C_O_K(d,INTEGERMATRIX);
3169 erg += all_01_matrices_rek_160802(a,b,d,0,c);
3170 FREEALL(d);
3171 }
3172 ENDR("all_01_matrices");
3173 }
3174
number_01_matrices(a,b,c)3175 INT number_01_matrices(a,b,c) OP a,b,c;
3176 /* number of 01 matrices of rowsum a
3177 coulmnsum b */
3178 /* computed using the kostka number of skew shape */
3179 /* AK 180901 */
3180 {
3181 INT erg = OK;
3182 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"number_01_matrices(1)",a);
3183 CTTTO(PARTITION,VECTOR,INTEGERVECTOR,"number_01_matrices(1)",b);
3184
3185 if (S_O_K(a) == PARTITION) a = S_PA_S(a);
3186 if (S_O_K(b) == PARTITION) b = S_PA_S(b);
3187 if (S_O_K(a) == VECTOR) {
3188 INT i;
3189 for (i=0;i<S_V_LI(a);i++)
3190 if (S_O_K(S_V_I(a,i)) != INTEGER) {
3191 error("number_01_matrices:no integer vector");
3192 goto endr_ende;
3193 }
3194 }
3195 if (S_O_K(b) == VECTOR) {
3196 INT i;
3197 for (i=0;i<S_V_LI(b);i++)
3198 if (S_O_K(S_V_I(b,i)) != INTEGER) {
3199 error("number_nat_matrices:no integer vector");
3200 goto endr_ende;
3201 }
3202 }
3203
3204 {
3205 INT i,w;
3206 OP inner,outer,spa;
3207 for (i=0,w=0;i<S_V_LI(a);i++)
3208 w += S_V_II(a,i);
3209 inner = callocobject();
3210 outer = callocobject();
3211
3212 erg += m_il_v(S_V_LI(a),outer);
3213 erg += m_il_v(S_V_LI(a)-1,inner);
3214
3215 for (i=S_V_LI(a)-1;i>0;i--)
3216 {
3217 M_I_I(w,S_V_I(outer,i));
3218 w = w - S_V_II(a,i);
3219 M_I_I(w,S_V_I(inner,i-1));
3220 }
3221 M_I_I(w,S_V_I(outer,i));
3222 erg += m_v_pa(inner,inner);
3223 erg += m_v_pa(outer,outer);
3224
3225 spa = callocobject();
3226 erg += m_gk_spa(outer,inner,spa);
3227 FREEALL(inner);
3228 FREEALL(outer);
3229 erg += conjugate(spa,spa);
3230
3231 erg += kostka_number(b,spa,c);
3232 FREEALL(spa);
3233 }
3234 ENDR("number_01_matrices");
3235 }
3236
t_SCHUR_SCHUR(a,b)3237 INT t_SCHUR_SCHUR(a,b) OP a,b; { return copy(a,b); }
t_ELMSYM_ELMSYM(a,b)3238 INT t_ELMSYM_ELMSYM(a,b) OP a,b; { return copy(a,b); }
t_POWSYM_POWSYM(a,b)3239 INT t_POWSYM_POWSYM(a,b) OP a,b; { return copy(a,b); }
t_HOMSYM_HOMSYM(a,b)3240 INT t_HOMSYM_HOMSYM(a,b) OP a,b; { return copy(a,b); }
t_MONOMIAL_MONOMIAL(a,b)3241 INT t_MONOMIAL_MONOMIAL(a,b) OP a,b; { return copy(a,b); }
3242
3243 #define CAST_SF(a,b,scalarf,partf,schurf,homsymf,powsymf,monomialf,elmsymf,t,t2)\
3244 COP(t,a);\
3245 COP(t2,b);\
3246 switch(S_O_K(a)) \
3247 {\
3248 case INTEGER:\
3249 case LONGINT:\
3250 case FF:\
3251 case CYCLOTOMIC:\
3252 case SQ_RADICAL:\
3253 case POLYNOM:\
3254 case BRUCH: erg += scalarf(a,b); goto ende;\
3255 case PARTITION: erg += partf(a,b); goto ende;\
3256 case SCHUR: erg += schurf(a,b); goto ende;\
3257 case HOMSYM: erg += homsymf(a,b); goto ende;\
3258 case MONOMIAL: erg += monomialf(a,b); goto ende;\
3259 case ELMSYM: erg += elmsymf(a,b); goto ende;\
3260 case POWSYM: erg += powsymf(a,b); goto ende;\
3261 default: erg += WTO(t,a); goto ende;\
3262 }\
3263 ende:
3264
3265 #define CAST_APPLY_SF(a,scalarf,partf,schurf,homsymf,powsymf,monomialf,elmsymf,t)\
3266 CAST_SF(a,a,scalarf,partf,schurf,homsymf,powsymf,monomialf,elmsymf,t,t)
3267
cast_apply_schur(a)3268 INT cast_apply_schur(a) OP a;
3269 /* AK 080102 */
3270 {
3271 INT erg = OK;
3272 CAST_APPLY_SF(a,m_scalar_schur,m_pa_s,t_SCHUR_SCHUR,t_HOMSYM_SCHUR,
3273 t_POWSYM_SCHUR,t_MONOMIAL_SCHUR,
3274 t_ELMSYM_SCHUR, "cast_apply_schur(1)");
3275 CTO(SCHUR,"cast_apply_schur(e1)",a);
3276 ENDR("cast_apply_schur");
3277 }
cast_apply_elmsym(a)3278 INT cast_apply_elmsym(a) OP a;
3279 /* AK 080102 */
3280 {
3281 INT erg = OK;
3282 CAST_APPLY_SF(a,m_scalar_elmsym,m_pa_e,t_SCHUR_ELMSYM,t_HOMSYM_ELMSYM,
3283 t_POWSYM_ELMSYM,t_MONOMIAL_ELMSYM,
3284 t_ELMSYM_ELMSYM, "cast_apply_elmsym(1)");
3285 CTO(ELMSYM,"cast_apply_elmsym(e1)",a);
3286 ENDR("cast_apply_elmsym");
3287 }
cast_apply_homsym(a)3288 INT cast_apply_homsym(a) OP a;
3289 /* AK 080102 */
3290 {
3291 INT erg = OK;
3292 CAST_APPLY_SF(a,m_scalar_homsym,m_pa_h,t_SCHUR_HOMSYM,t_HOMSYM_HOMSYM,
3293 t_POWSYM_HOMSYM,t_MONOMIAL_HOMSYM,
3294 t_ELMSYM_HOMSYM, "cast_apply_homsym(1)");
3295 CTO(HOMSYM,"cast_apply_homsym(e1)",a);
3296 ENDR("cast_apply_homsym");
3297 }
cast_apply_powsym(a)3298 INT cast_apply_powsym(a) OP a;
3299 /* AK 080102 */
3300 {
3301 INT erg = OK;
3302 CAST_APPLY_SF(a,m_scalar_powsym,m_pa_ps,t_SCHUR_POWSYM,t_HOMSYM_POWSYM,
3303 t_POWSYM_POWSYM,t_MONOMIAL_POWSYM,
3304 t_ELMSYM_POWSYM, "cast_apply_powsym(1)");
3305 CTO(POWSYM,"cast_apply_powsym(e1)",a);
3306 ENDR("cast_apply_powsym");
3307 }
cast_apply_monomial(a)3308 INT cast_apply_monomial(a) OP a;
3309 /* AK 080102 */
3310 {
3311 INT erg = OK;
3312 CAST_APPLY_SF(a,m_scalar_monomial,m_pa_mon,t_SCHUR_MONOMIAL,t_HOMSYM_MONOMIAL,
3313 t_POWSYM_MONOMIAL,t_MONOMIAL_MONOMIAL,
3314 t_ELMSYM_MONOMIAL, "cast_apply_monomial(1)");
3315 CTO(MONOMIAL,"cast_apply_monomial(e1)",a);
3316 ENDR("cast_apply_monomial");
3317 }
3318
cast_schur(a,b)3319 INT cast_schur(a,b) OP a,b;
3320 /* AK 080102 */
3321 {
3322 INT erg = OK;
3323 CAST_SF(a,b,m_scalar_schur,m_pa_s,t_SCHUR_SCHUR,t_HOMSYM_SCHUR,
3324 t_POWSYM_SCHUR,t_MONOMIAL_SCHUR,
3325 t_ELMSYM_SCHUR, "cast_schur(1)","cast_schur(2)");
3326 CTO(SCHUR,"cast_schur(e2)",b);
3327 ENDR("cast_schur");
3328 }
cast_elmsym(a,b)3329 INT cast_elmsym(a,b) OP a,b;
3330 /* AK 080102 */
3331 {
3332 INT erg = OK;
3333 CAST_SF(a,b,m_scalar_elmsym,m_pa_e,t_SCHUR_ELMSYM,t_HOMSYM_ELMSYM,
3334 t_POWSYM_ELMSYM,t_MONOMIAL_ELMSYM,
3335 t_ELMSYM_ELMSYM, "cast_elmsym(1)","cast_elmsym(2)");
3336 CTO(ELMSYM,"cast_elmsym(e2)",b);
3337 ENDR("cast_elmsym");
3338 }
cast_homsym(a,b)3339 INT cast_homsym(a,b) OP a,b;
3340 /* AK 080102 */
3341 {
3342 INT erg = OK;
3343 CAST_SF(a,b,m_scalar_homsym,m_pa_h,t_SCHUR_HOMSYM,t_HOMSYM_HOMSYM,
3344 t_POWSYM_HOMSYM,t_MONOMIAL_HOMSYM,
3345 t_ELMSYM_HOMSYM, "cast_homsym(1)","cast_homsym(2)");
3346 CTO(HOMSYM,"cast_homsym(e2)",b);
3347 ENDR("cast_homsym");
3348 }
cast_powsym(a,b)3349 INT cast_powsym(a,b) OP a,b;
3350 /* AK 080102 */
3351 {
3352 INT erg = OK;
3353 CAST_SF(a,b,m_scalar_powsym,m_pa_ps,t_SCHUR_POWSYM,t_HOMSYM_POWSYM,
3354 t_POWSYM_POWSYM,t_MONOMIAL_POWSYM,
3355 t_ELMSYM_POWSYM, "cast_powsym(1)", "cast_powsym(2)");
3356 CTO(POWSYM,"cast_powsym(e2)",b);
3357 ENDR("cast_powsym");
3358 }
cast_monomial(a,b)3359 INT cast_monomial(a,b) OP a,b;
3360 /* AK 080102 */
3361 {
3362 INT erg = OK;
3363 CAST_SF(a,b,m_scalar_monomial,m_pa_mon,t_SCHUR_MONOMIAL,t_HOMSYM_MONOMIAL,
3364 t_POWSYM_MONOMIAL,t_MONOMIAL_MONOMIAL,
3365 t_ELMSYM_MONOMIAL, "cast_monomial(1)","cast_monomial(2)");
3366 CTO(MONOMIAL,"cast_monomial(e2)",b);
3367 ENDR("cast_monomial");
3368 }
3369
frobenius_elmsym(a,b)3370 INT frobenius_elmsym(a,b) OP a,b;
3371 /* result is n basis of elmsym */
3372 {
3373 INT erg = OK;
3374 OP z;
3375 CTTTO(PARTITION,ELMSYM,HASHTABLE,"frobenius_elmsym(1)",a);
3376 CTTTO(EMPTY,ELMSYM,HASHTABLE,"frobenius_elmsym(2)",b);
3377 if (S_O_K(b) == EMPTY) erg += init(ELMSYM,b);
3378 if (S_O_K(a) == PARTITION) {
3379 erg += t_HOMSYM_ELMSYM(a,b);
3380 goto ende;
3381 }
3382 else if (S_O_K(a) == HASHTABLE) {
3383 erg += t_HOMSYM_ELMSYM(a,b);
3384 goto ende;
3385 }
3386 else { /* ELMSYM */
3387 z = a; while (z != NULL) { C_O_K(z,HOMSYM); z = S_L_N(z); }
3388 erg += t_HOMSYM_ELMSYM(a,b);
3389 z = a; while (z != NULL) { C_O_K(z,HOMSYM); z = S_L_N(z); }
3390 goto ende;
3391 }
3392 ende:
3393 ENDR("frobenius_elmsym");
3394 }
3395
frobenius_schur(a,b)3396 INT frobenius_schur(a,b) OP a,b;
3397 /* result is n basis of schur */
3398 {
3399 INT erg = OK;
3400 CTTTO(PARTITION,SCHUR,HASHTABLE,"frobenius_schur(1)",a);
3401 CTTTO(EMPTY,SCHUR,HASHTABLE,"frobenius_schur(2)",b);
3402 if (S_O_K(b) == EMPTY) erg += init(SCHUR,b);
3403 if (S_O_K(a) == PARTITION) {
3404 OP d = CALLOCOBJECT();
3405 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
3406 M_I_I(1,S_MO_K(d));
3407 erg += conjugate_partition(a,S_MO_S(d));
3408 INSERT_SCHURMONOM_(d,b);
3409 goto ende;
3410 }
3411 else { /* SCHUR */ /* HASHTABLE */
3412 erg += conjugate_schur(a,b);
3413 goto ende;
3414 }
3415 ende:
3416 ENDR("frobenius_schur");
3417 }
3418
3419
frobenius_powsym(a,b)3420 INT frobenius_powsym(a,b) OP a,b;
3421 /* result is n basis of powsym */
3422 {
3423 INT erg = OK;
3424 INT sig,i;
3425 OP z,d;
3426 CTTTO(PARTITION,POWSYM,HASHTABLE,"frobenius_powsym(1)",a);
3427 CTTTO(EMPTY,POWSYM,HASHTABLE,"frobenius_powsym(2)",b);
3428 if (S_O_K(b) == EMPTY) erg += init(POWSYM,b);
3429 if (S_O_K(a) == PARTITION) {
3430 d = CALLOCOBJECT();
3431 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
3432 for (sig=1,i=0;i<S_PA_LI(a);i++)
3433 if ( (S_PA_II(a,i) % 2) == 0 ) sig *= (-1);
3434 M_I_I(sig,S_MO_K(d));
3435 erg += copy_partition(a,S_MO_S(d));
3436 INSERT_POWSYMMONOM_(d,b);
3437 goto ende;
3438 }
3439 else { /* POWSYM */ /* HASHTABLE */
3440 FORALL(z,a, {
3441 d = CALLOCOBJECT();
3442 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
3443 for (sig=1,i=0;i<S_PA_LI(S_MO_S(z));i++)
3444 if ( (S_PA_II(S_MO_S(z),i) % 2) == 0 ) sig *= (-1);
3445 if (sig == 1)
3446 COPY(S_MO_K(z),S_MO_K(d));
3447 else
3448 ADDINVERS(S_MO_K(z),S_MO_K(d));
3449 erg += copy_partition(S_MO_S(z),S_MO_S(d));
3450 INSERT_POWSYMMONOM_(d,b);
3451 });
3452 goto ende;
3453 }
3454 ende:
3455 ENDR("frobenius_powsym");
3456 }
3457
3458
frobenius_homsym(a,b)3459 INT frobenius_homsym(a,b) OP a,b;
3460 /* result is n basis of homsym */
3461 {
3462 INT erg = OK;
3463 OP z;
3464 CTTTO(PARTITION,HOMSYM,HASHTABLE,"frobenius_homsym(1)",a);
3465 CTTTO(EMPTY,HOMSYM,HASHTABLE,"frobenius_homsym(2)",b);
3466 if (S_O_K(b) == EMPTY) erg += init(HOMSYM,b);
3467 if (S_O_K(a) == PARTITION) {
3468 erg += t_ELMSYM_HOMSYM(a,b);
3469 goto ende;
3470 }
3471 else if (S_O_K(a) == HASHTABLE) {
3472 erg += t_ELMSYM_HOMSYM(a,b);
3473 goto ende;
3474 }
3475 else { /* ELMSYM */
3476 z = a; while (z != NULL) { C_O_K(z,ELMSYM); z = S_L_N(z); }
3477 erg += t_ELMSYM_HOMSYM(a,b);
3478 z = a; while (z != NULL) { C_O_K(z,ELMSYM); z = S_L_N(z); }
3479 goto ende;
3480 }
3481 ende:
3482 ENDR("frobenius_homsym");
3483 }
3484
frobenius_monomial(a,b)3485 INT frobenius_monomial(a,b) OP a,b;
3486 /* result is n basis of monomial */
3487 {
3488 INT erg = OK;
3489 OP z,y;
3490 CTTTO(PARTITION,MONOMIAL,HASHTABLE,"frobenius_monomial(1)",a);
3491 CTTTO(EMPTY,MONOMIAL,HASHTABLE,"frobenius_monomial(2)",b);
3492
3493 /* via powsym */
3494 z = CALLOCOBJECT();
3495 t_MONOMIAL_POWSYM(a,z);
3496 y = CALLOCOBJECT();
3497 erg += frobenius_powsym(z,y);
3498 FREEALL(z);
3499 erg += t_POWSYM_MONOMIAL(y,b);
3500 FREEALL(y);
3501 ENDR("frobenius_monomial");
3502 }
3503
3504
3505
3506
3507
3508
scalarproduct_schur_schur(a,b,c)3509 INT scalarproduct_schur_schur(a,b,c) OP a,b,c;
3510 /* <S_I,S_J> = delta_I,J */
3511 {
3512 OP za,zb;
3513 OP d;
3514 INT res;
3515 INT erg = OK;
3516 CTTO(PARTITION,SCHUR,"scalarproduct_schur_schur(1)",a);
3517 CTTO(PARTITION,SCHUR,"scalarproduct_schur_schur(2)",b);
3518 CTO(EMPTY,"scalarproduct_schur_schur(3)",c);
3519 if (S_O_K(a) == PARTITION) {
3520 d = CALLOCOBJECT();
3521 erg += m_pa_s(a,d);
3522 erg += scalarproduct_schur_schur(d,b,c);
3523 FREEALL(d);
3524 goto ende;
3525 }
3526 if (S_O_K(b) == PARTITION) {
3527 d = CALLOCOBJECT();
3528 erg += m_pa_s(b,d);
3529 erg += scalarproduct_schur_schur(a,d,c);
3530 FREEALL(d);
3531 goto ende;
3532 }
3533
3534
3535 d = CALLOCOBJECT();
3536 za = a;
3537 zb = b;
3538 M_I_I((INT)0,c);
3539 do {
3540 if (za == NULL) goto preende;
3541 if (zb == NULL) goto preende;
3542 res = comp(S_S_S(za),S_S_S(zb));
3543 if (res == (INT)0)
3544 {
3545 FREESELF(d);
3546 MULT(S_S_K(za),S_S_K(zb),d);
3547 ADD_APPLY(d,c);
3548 za = S_S_N(za);
3549 zb = S_S_N(zb);
3550 }
3551 else if (res < (INT)0)
3552 {
3553 za = S_S_N(za);
3554 }
3555 else
3556 {
3557 zb = S_S_N(zb);
3558 }
3559 } while(1);
3560 preende:
3561 FREEALL(d);
3562 ende:
3563 ENDR("scalarproduct_schur_schur");
3564 }
3565
scalarproduct_powsym_powsym(a,b,c)3566 INT scalarproduct_powsym_powsym(a,b,c) OP a,b,c;
3567 /* <P_I,P_J> = ordcen() delta_I,J */
3568 {
3569 OP za,zb;
3570 OP d,e;
3571 INT res;
3572 INT erg = OK;
3573 CTTO(PARTITION,POWSYM,"scalarproduct_powsym_powsym(1)",a);
3574 CTTO(PARTITION,POWSYM,"scalarproduct_powsym_powsym(2)",b);
3575 CTO(EMPTY,"scalarproduct_powsym_powsym(3)",c);
3576 if (S_O_K(a) == PARTITION) {
3577 d = CALLOCOBJECT();
3578 erg += m_pa_ps(a,d);
3579 erg += scalarproduct_powsym_powsym(d,b,c);
3580 FREEALL(d);
3581 goto ende;
3582 }
3583 if (S_O_K(b) == PARTITION) {
3584 d = CALLOCOBJECT();
3585 erg += m_pa_ps(b,d);
3586 erg += scalarproduct_powsym_powsym(a,d,c);
3587 FREEALL(d);
3588 goto ende;
3589 }
3590
3591 d = CALLOCOBJECT();
3592 e = CALLOCOBJECT();
3593 za = a;
3594 zb = b;
3595 M_I_I((INT)0,c);
3596 do {
3597 if (za == NULL) goto preende;
3598 if (zb == NULL) goto preende;
3599 res = comp(S_S_S(za),S_S_S(zb));
3600 if (res == (INT)0)
3601 {
3602 FREESELF(d);
3603 MULT(S_S_K(za),S_S_K(zb),d);
3604 ordcen(S_S_S(za),e);
3605 MULT_APPLY(e,d);
3606 ADD_APPLY(d,c);
3607 za = S_S_N(za);
3608 zb = S_S_N(zb);
3609 }
3610 else if (res < (INT)0)
3611 {
3612 za = S_S_N(za);
3613 }
3614 else
3615 {
3616 zb = S_S_N(zb);
3617 }
3618 } while(1);
3619 preende:
3620 FREEALL(d);
3621 FREEALL(e);
3622 ende:
3623 ENDR("scalarproduct_powsym_powsym");
3624 }
3625
3626
3627
scalarproduct_homsym_monomial(a,b,c)3628 INT scalarproduct_homsym_monomial(a,b,c) OP a,b,c;
3629 /* <H_I,M_J> = delta_I,J */
3630 {
3631 OP za,zb;
3632 OP d;
3633 INT res;
3634 INT erg = OK;
3635 CTTO(PARTITION,HOMSYM,"scalarproduct_homsym_monomial(1)",a);
3636 CTTO(PARTITION,MONOMIAL,"scalarproduct_homsym_monomial(2)",b);
3637 CTO(EMPTY,"scalarproduct_homsym_monomial(3)",c);
3638 if (S_O_K(a) == PARTITION) {
3639 d = CALLOCOBJECT();
3640 erg += m_pa_h(a,d);
3641 erg += scalarproduct_homsym_monomial(d,b,c);
3642 FREEALL(d);
3643 goto ende;
3644 }
3645 if (S_O_K(b) == PARTITION) {
3646 d = CALLOCOBJECT();
3647 erg += m_pa_mon(b,d);
3648 erg += scalarproduct_homsym_monomial(a,d,c);
3649 FREEALL(d);
3650 goto ende;
3651 }
3652
3653
3654 d = CALLOCOBJECT();
3655 za = a;
3656 zb = b;
3657 M_I_I((INT)0,c);
3658 do {
3659 if (za == NULL) goto preende;
3660 if (zb == NULL) goto preende;
3661 res = comp(S_S_S(za),S_S_S(zb));
3662 if (res == (INT)0)
3663 {
3664 FREESELF(d);
3665 MULT(S_S_K(za),S_S_K(zb),d);
3666 ADD_APPLY(d,c);
3667 za = S_S_N(za);
3668 zb = S_S_N(zb);
3669 }
3670 else if (res < (INT)0)
3671 {
3672 za = S_S_N(za);
3673 }
3674 else
3675 {
3676 zb = S_S_N(zb);
3677 }
3678 } while(1);
3679 preende:
3680 FREEALL(d);
3681 ende:
3682 ENDR("scalarproduct_homsym_monomial");
3683 }
3684
scalarproduct_schur(a,b,c)3685 INT scalarproduct_schur(a,b,c) OP a,b,c;
3686 {
3687 INT erg = OK;
3688 CTO(SCHUR,"scalarproduct_schur(1)",a);
3689 CTO(EMPTY,"scalarproduct_schur(3)",c);
3690 if (S_O_K(b) == SCHUR)
3691 {
3692 erg += scalarproduct_schur_schur(a,b,c);
3693 }
3694 else if (S_O_K(b) == HOMSYM)
3695 {
3696 OP d;
3697 d = CALLOCOBJECT();
3698 t_HOMSYM_SCHUR(b,d);
3699 erg += scalarproduct_schur_schur(a,d,c);
3700 FREEALL(d);
3701 }
3702 else if (S_O_K(b) == ELMSYM)
3703 {
3704 OP d;
3705 d = CALLOCOBJECT();
3706 t_ELMSYM_SCHUR(b,d);
3707 erg += scalarproduct_schur_schur(a,d,c);
3708 FREEALL(d);
3709 }
3710 else if (S_O_K(b) == POWSYM)
3711 {
3712 OP d;
3713 d = CALLOCOBJECT();
3714 t_POWSYM_SCHUR(b,d);
3715 erg += scalarproduct_schur_schur(a,d,c);
3716 FREEALL(d);
3717 }
3718 else if (S_O_K(b) == MONOMIAL)
3719 {
3720 OP d;
3721 d = CALLOCOBJECT();
3722 t_MONOMIAL_SCHUR(b,d);
3723 erg += scalarproduct_schur_schur(a,d,c);
3724 FREEALL(d);
3725 }
3726 else
3727 WTO("scalarproduct_schur(2)",b);
3728 ENDR("scalarproduct_schur");
3729 }
3730
scalarproduct_powsym(a,b,c)3731 INT scalarproduct_powsym(a,b,c) OP a,b,c;
3732 {
3733 INT erg = OK;
3734 CTO(POWSYM,"scalarproduct_powsym(1)",a);
3735 CTO(EMPTY,"scalarproduct_powsym(3)",c);
3736 if (S_O_K(b) == POWSYM)
3737 {
3738 erg += scalarproduct_powsym_powsym(a,b,c);
3739 goto sppende;
3740 }
3741 else if (S_O_K(b) == HOMSYM)
3742 {
3743 OP d;
3744 d = CALLOCOBJECT();
3745 t_HOMSYM_POWSYM(b,d);
3746 erg += scalarproduct_powsym_powsym(a,d,c);
3747 FREEALL(d);
3748 goto sppende;
3749 }
3750 else if (S_O_K(b) == ELMSYM)
3751 {
3752 OP d;
3753 d = CALLOCOBJECT();
3754 t_ELMSYM_POWSYM(b,d);
3755 erg += scalarproduct_powsym_powsym(a,d,c);
3756 FREEALL(d);
3757 goto sppende;
3758 }
3759 else if (S_O_K(b) == SCHUR)
3760 {
3761 OP d;
3762 d = CALLOCOBJECT();
3763 t_SCHUR_POWSYM(b,d);
3764 erg += scalarproduct_powsym_powsym(a,d,c);
3765 FREEALL(d);
3766 goto sppende;
3767 }
3768 else if (S_O_K(b) == MONOMIAL)
3769 {
3770 OP d;
3771 d = CALLOCOBJECT();
3772 t_MONOMIAL_POWSYM(b,d);
3773 erg += scalarproduct_powsym_powsym(a,d,c);
3774 FREEALL(d);
3775 goto sppende;
3776 }
3777 else
3778 WTO("scalarproduct_powsym(2)",b);
3779 sppende:
3780 ENDR("scalarproduct_powsym");
3781 }
3782
3783
scalarproduct_homsym(a,b,c)3784 INT scalarproduct_homsym(a,b,c) OP a,b,c;
3785 {
3786 INT erg = OK;
3787 CTO(HOMSYM,"scalarproduct_homsym(1)",a);
3788 CTO(EMPTY,"scalarproduct_homsym(3)",c);
3789 if (S_O_K(b) == MONOMIAL)
3790 {
3791 erg += scalarproduct_homsym_monomial(a,b,c);
3792 }
3793 else if (S_O_K(b) == HOMSYM)
3794 {
3795 OP d;
3796 d = CALLOCOBJECT();
3797 t_HOMSYM_MONOMIAL(b,d);
3798 erg += scalarproduct_homsym_monomial(a,d,c);
3799 FREEALL(d);
3800 }
3801 else if (S_O_K(b) == ELMSYM)
3802 {
3803 OP d;
3804 d = CALLOCOBJECT();
3805 t_ELMSYM_MONOMIAL(b,d);
3806 erg += scalarproduct_homsym_monomial(a,d,c);
3807 FREEALL(d);
3808 }
3809 else if (S_O_K(b) == POWSYM)
3810 {
3811 OP d;
3812 d = CALLOCOBJECT();
3813 t_POWSYM_MONOMIAL(b,d);
3814 erg += scalarproduct_homsym_monomial(a,d,c);
3815 FREEALL(d);
3816 }
3817 else if (S_O_K(b) == SCHUR)
3818 {
3819 OP d;
3820 d = CALLOCOBJECT();
3821 t_SCHUR_MONOMIAL(b,d);
3822 erg += scalarproduct_homsym_monomial(a,d,c);
3823 FREEALL(d);
3824 }
3825 else
3826 WTO("scalarproduct_homsym(2)",b);
3827 ENDR("scalarproduct_homsym");
3828 }
3829
scalarproduct_monomial(a,b,c)3830 INT scalarproduct_monomial(a,b,c) OP a,b,c;
3831 {
3832 INT erg = OK;
3833 CTO(MONOMIAL,"scalarproduct_monomial(1)",a);
3834 CTO(EMPTY,"scalarproduct_monomial(3)",c);
3835 if (S_O_K(b) == HOMSYM)
3836 {
3837 erg += scalarproduct_homsym_monomial(b,a,c);
3838 }
3839 else if (S_O_K(b) == MONOMIAL)
3840 {
3841 OP d;
3842 d = CALLOCOBJECT();
3843 t_MONOMIAL_HOMSYM(b,d);
3844 erg += scalarproduct_homsym_monomial(d,a,c);
3845 FREEALL(d);
3846 }
3847 else if (S_O_K(b) == ELMSYM)
3848 {
3849 OP d;
3850 d = CALLOCOBJECT();
3851 t_ELMSYM_HOMSYM(b,d);
3852 erg += scalarproduct_homsym_monomial(d,a,c);
3853 FREEALL(d);
3854 }
3855 else if (S_O_K(b) == POWSYM)
3856 {
3857 OP d;
3858 d = CALLOCOBJECT();
3859 t_POWSYM_HOMSYM(b,d);
3860 erg += scalarproduct_homsym_monomial(d,a,c);
3861 FREEALL(d);
3862 }
3863 else if (S_O_K(b) == SCHUR)
3864 {
3865 OP d;
3866 d = CALLOCOBJECT();
3867 t_SCHUR_HOMSYM(b,d);
3868 erg += scalarproduct_homsym_monomial(d,a,c);
3869 FREEALL(d);
3870 }
3871 else
3872 WTO("scalarproduct_monomial(2)",b);
3873 ENDR("scalarproduct_monomial");
3874 }
3875
scalarproduct_elmsym(a,b,c)3876 INT scalarproduct_elmsym(a,b,c) OP a,b,c;
3877 {
3878 INT erg = OK;
3879 OP e;
3880 CTO(ELMSYM,"scalarproduct_elmsym(1)",a);
3881 CTO(EMPTY,"scalarproduct_elmsym(3)",c);
3882 e = CALLOCOBJECT();
3883 if (S_O_K(b) == HOMSYM)
3884 {
3885 OP d;
3886 t_ELMSYM_SCHUR(a,e);
3887 d = CALLOCOBJECT();
3888 t_HOMSYM_SCHUR(b,d);
3889 erg += scalarproduct_schur_schur(d,e,c);
3890 FREEALL(d);
3891 }
3892 else if (S_O_K(b) == MONOMIAL)
3893 {
3894 OP d;
3895 t_ELMSYM_SCHUR(a,e);
3896 d = CALLOCOBJECT();
3897 t_MONOMIAL_SCHUR(b,d);
3898 erg += scalarproduct_schur_schur(d,e,c);
3899 FREEALL(d);
3900 }
3901 else if (S_O_K(b) == ELMSYM)
3902 {
3903 OP d;
3904 t_ELMSYM_SCHUR(a,e);
3905 d = CALLOCOBJECT();
3906 t_ELMSYM_SCHUR(b,d);
3907 erg += scalarproduct_schur_schur(d,e,c);
3908 FREEALL(d);
3909 }
3910 else if (S_O_K(b) == POWSYM)
3911 {
3912 OP d;
3913 t_ELMSYM_SCHUR(a,e);
3914 d = CALLOCOBJECT();
3915 t_POWSYM_SCHUR(b,d);
3916 erg += scalarproduct_schur_schur(d,e,c);
3917 FREEALL(d);
3918 }
3919 else if (S_O_K(b) == SCHUR)
3920 {
3921 t_ELMSYM_SCHUR(a,e);
3922 erg += scalarproduct_schur_schur(b,e,c);
3923 }
3924 else
3925 WTO("scalarproduct_elmsym(2)",b);
3926 FREEALL(e);
3927 ENDR("scalarproduct_elmsym");
3928 }
3929
3930
3931
3932
co_1611(a,b)3933 static INT co_1611(a,b) OP a,b;
3934 /* transform polynom to vector of monoms */
3935 {
3936 OP z;
3937 INT i=0,j;
3938 z = a;
3939 while (z != NULL)
3940 {
3941 i += S_PO_KI(z);
3942 z = S_PO_N(z);
3943 }
3944
3945 m_il_v(i,b);
3946 z = a;
3947 for (i=0;i<S_V_LI(b);)
3948 {
3949 if (z == NULL) error("");
3950 for (j=0;j<S_PO_KI(z);j++)
3951 {
3952 m_skn_po(S_PO_S(z),cons_eins,NULL,S_V_I(b,i));
3953 i++;
3954 }
3955 z = S_PO_N(z);
3956 }
3957 return OK;
3958 }
3959
plet_schur_schur_pol(parta,partb,len,res)3960 INT plet_schur_schur_pol(parta,partb, len, res)
3961 OP parta,partb, len, res;
3962 /* plethysm of schur polynomials S_b(S_a(A_len)) */
3963 /* res is polynom */
3964 /* parameters may be equal */
3965 {
3966 OP c ,e;
3967 INT erg = OK;
3968 CTO(PARTITION,"plet_schur_schur_pol(1)",parta);
3969 CTO(PARTITION,"plet_schur_schur_pol(2)",partb);
3970 CTO(INTEGER,"plet_schur_schur_pol(3)",len);
3971 c = CALLOCOBJECT();
3972 e = CALLOCOBJECT();
3973 erg += compute_schur_with_alphabet(parta,len,c);
3974 erg += co_1611(c,e);
3975 erg += compute_schur_with_alphabet(partb,S_V_L(e),c);
3976 erg += eval_polynom(c,e,res);
3977 erg += freeall(c);
3978 erg += freeall(e);
3979 CTO(POLYNOM,"plet_schur_schur_pol(4-end)",res);
3980 ENDR("plet_schur_schur_pol");
3981 }
3982
3983
3984
3985 static OP ll=NULL;
co111(a)3986 static INT co111(a) OP a;
3987 {
3988 return S_PA_LI(S_MO_S(a)) <= S_I_I(ll);
3989 }
co222(a)3990 static INT co222(a) OP a;
3991 {
3992 return S_PA_LI(S_MO_S(a)) == S_I_I(ll);
3993 }
3994
put_length_limit_schur(i,a)3995 INT put_length_limit_schur(i,a) OP a; INT i;
3996 /* i ist the max length for part */
3997 {
3998 INT erg = OK;
3999 CTTO(SCHUR,HASHTABLE,"put_length_limit_schur(2)",a);
4000 ll = CALLOCOBJECT(); M_I_I(i,ll);
4001 if (S_O_K(a) == SCHUR)
4002 erg += filter_apply_list(a,co111);
4003 else /*HASHTABLE */
4004 erg += filter_apply_hashtable(a,co111);
4005 FREEALL(ll); ll = NULL;
4006 ENDR("put_length_limit_schur");
4007 }
put_exactlength_limit_schur(i,a)4008 INT put_exactlength_limit_schur(i,a) OP a; INT i;
4009 /* i ist the exact length for part */
4010 {
4011 INT erg = OK;
4012 CTTO(SCHUR,HASHTABLE,"put_length_limit_schur(2)",a);
4013 ll = CALLOCOBJECT(); M_I_I(i,ll);
4014 if (S_O_K(a) == SCHUR)
4015 erg += filter_apply_list(a,co222);
4016 else /*HASHTABLE */
4017 erg += filter_apply_hashtable(a,co222);
4018 FREEALL(ll); ll = NULL;
4019 ENDR("put_exactlength_limit_schur");
4020 }
4021
4022
m_int_Qelm(a,b)4023 static INT m_int_Qelm(a,b) INT a; OP b;
4024 {
4025 INT erg = OK;
4026 OP c,d,e;
4027
4028 COP("m_int_Qelm(2)",b);
4029 c = callocobject();
4030 d = callocobject();
4031 if (a == (INT)0)
4032 {
4033 m_i_i(1,b);
4034 goto ee;
4035 }
4036 m_i_i(a,c);
4037 init(MONOMIAL,b);
4038 first_partition(c,d);
4039 do {
4040 e = callocobject();
4041 erg += m_skn_mon(d,callocobject(),NULL,e);
4042 hoch(cons_zwei,S_PA_L(d),S_S_K(e));
4043 insert(e,b,NULL,NULL);
4044 } while (next(d,d));
4045 ee:
4046 freeall(c);
4047 freeall(d);
4048 ENDR("m_int_Qelm");
4049 }
m_int_int_Qelm(a,b,d)4050 static INT m_int_int_Qelm(a,b,d) INT a,b; OP d;
4051 {
4052 OP c;
4053 INT erg = OK;
4054 COP("m_int_int_Qelm(3)",d);
4055 c = callocobject();
4056 if (a>b) error("::");
4057 erg += b_ks_pa(VECTOR,callocobject(),c);
4058 erg += m_il_v(2L,S_PA_S(c));
4059 erg += m_i_i(a,S_PA_I(c,0));
4060 erg += m_i_i(b,S_PA_I(c,1));
4061 erg += m_part_Qschur(c,d);
4062 erg += freeall(c);
4063 ENDR("m_int_int_qelm");
4064
4065 }
4066
m_part_Qschur(a,b)4067 INT m_part_Qschur(a,b) OP a,b;
4068 /* AK 291295 */
4069 /* computes Q schur polynomial as monomial sym */
4070 {
4071 INT i,j;
4072 OP c,d,e;
4073 INT erg = OK;
4074
4075 CTO(PARTITION,"m_part_Qschur",a);
4076 if (S_PA_LI(a) == 1)
4077 {
4078 erg += m_int_Qelm(S_PA_II(a,0),b);
4079 }
4080 else if (S_PA_LI(a) == 2)
4081 {
4082 c = callocobject();
4083 erg += m_int_Qelm(S_PA_II(a,0),c);
4084 d = callocobject();
4085 erg += m_int_Qelm(S_PA_II(a,1),d);
4086 erg += mult(c,d,b);
4087 e = callocobject();
4088 for (i=1;i<=S_PA_II(a,0);i++)
4089 {
4090 erg += m_int_Qelm(S_PA_II(a,0)-i,c);
4091 erg += m_int_Qelm(S_PA_II(a,1)+i,d);
4092 erg += mult(c,d,e);
4093 erg += mult_apply(cons_zwei,e);
4094 if (i%2 == 1)
4095 erg += mult_apply(cons_negeins,e);
4096 erg += add_apply(e,b);
4097 }
4098 erg += freeall(c);
4099 erg += freeall(d);
4100 erg += freeall(e);
4101 }
4102 else if (S_PA_LI(a) %2 == 0)
4103 {
4104 c = callocobject();
4105 erg += m_ilih_m(S_PA_LI(a), S_PA_LI(a),c);
4106 for (i=0;i<S_M_HI(c);i++)
4107 for (j=i+1;j<S_M_LI(c);j++)
4108 {
4109 m_int_int_Qelm(S_PA_II(a,S_PA_LI(a)-1-j),
4110 S_PA_II(a,S_PA_LI(a)-1-i),S_M_IJ(c,i,j));
4111 }
4112 pfaffian_matrix(c,b);
4113 erg += freeall(c);
4114 }
4115 else {
4116 d = callocobject();
4117 b_ks_pa(VECTOR,callocobject(),d);
4118 m_il_nv(S_PA_LI(a)+1,S_PA_S(d));
4119 for (i=0;i<S_PA_LI(a);i++)
4120 M_I_I(S_PA_II(a,i),S_PA_I(d,i+1));
4121
4122 c = callocobject();
4123 erg += m_ilih_m(S_PA_LI(d), S_PA_LI(d),c);
4124 for (i=0;i<S_M_HI(c);i++)
4125 for (j=i+1;j<S_M_LI(c);j++)
4126 {
4127 m_int_int_Qelm(S_PA_II(d,S_PA_LI(d)-1-j),
4128 S_PA_II(d,S_PA_LI(d)-1-i),S_M_IJ(c,i,j));
4129 }
4130 pfaffian_matrix(c,b);
4131 erg += freeall(c);
4132 freeall(d);
4133 }
4134 ENDR("m_part_Qschur");
4135 }
4136
4137
4138 #ifdef UNDEF
4139 static dec_step();
4140 static dec_step_2();
4141 static dec_step_co();
4142
4143 /* fehlerhafte werte 180901 */
4144 static OP dd,ee,ff;
old_number_01_matrices(a,b,c)4145 INT old_number_01_matrices(a,b,c) OP a,b,c;
4146 /* zeilen und spaltensumme in vector schreibweise als VECTOR */
4147 /* a = zeilen, b = spalten */
4148 {
4149 INT erg = OK;
4150 OP d,e;
4151 if (S_O_K(a) == PARTITION) a = S_PA_S(a);
4152 if (S_O_K(b) == PARTITION) b = S_PA_S(b);
4153 CTTO(VECTOR,INTEGERVECTOR,"old_number_01_matrices",a);
4154 CTTO(VECTOR,INTEGERVECTOR,"old_number_01_matrices",b);
4155 CE3(a,b,c,old_number_01_matrices);
4156
4157 dd = callocobject();
4158 ee = callocobject();
4159 ff = callocobject();
4160 d = callocobject();
4161 e = callocobject();
4162 erg += m_ilih_nm(S_V_LI(a)+1,S_V_LI(b)+1,ff);
4163 erg += m_ks_pa(VECTOR,b,ee);
4164 erg += t_VECTOR_EXPONENT(ee,e);
4165 erg += freeself(ee);
4166 erg += dec_step(e,b,d);
4167 if (S_L_S(d) != NULL)
4168 erg += copy(S_S_K(d),c);
4169 else
4170 erg += m_i_i(0,c);
4171 erg += freeall(d);
4172 erg += freeall(dd);
4173 erg += freeall(ee);
4174 erg += freeall(ff);
4175 erg += freeall(e);
4176 ENDR("number_01_matrices");
4177 }
4178
4179
my_binom(a,b,c)4180 static my_binom(a,b,c) OP a,b,c;
4181 {
4182 OP z;
4183 INT ai=S_I_I(a), bi=S_I_I(b);
4184 INT j=1;
4185 z = s_m_ij(ff,ai,bi);
4186 if (not nullp(z))
4187 copy(z,c);
4188 else {
4189 m_i_i(1,c);
4190 m_i_i(1,ee);
4191 while (ai > bi)
4192 {
4193 M_I_I(ai,dd); MULT_APPLY_INTEGER(dd,c);
4194 ai--;
4195 M_I_I(j,dd); MULT_APPLY_INTEGER(dd,ee);
4196 j++;
4197 }
4198 ganzdiv_apply(ee,c);
4199 copy(c,z);
4200 }
4201 }
4202
dec_step(a,b,c)4203 static dec_step(a,b,c) OP a,b,c;
4204 {
4205 INT erg = OK;
4206 CE3(a,b,c,dec_step);
4207 if (S_O_K(b) == VECTOR || S_O_K(b) == INTEGERVECTOR)
4208 {
4209 INT i;
4210 dec_step_2(a,S_V_I(b,0),c);
4211 for (i=1;i<S_V_LI(b);i++)
4212 {
4213 dec_step_2(c,S_V_I(b,i),c);
4214 }
4215 }
4216 else
4217 dec_step_2(a,b,c);
4218 ENDR("dec_step");
4219 }
4220
my_comp(a,b)4221 static INT my_comp(a,b) OP a,b; {
4222 return (INT)memcmp(
4223 (char *) S_V_S(S_PA_S(S_MO_S(a))),
4224 (char *) S_V_S(S_PA_S(S_MO_S(b))),
4225 sizeof(struct object) * S_PA_LI(S_MO_S(a)));
4226 }
4227
dec_step_2(a,b,c)4228 static dec_step_2(a,b,c) OP a,b,c;
4229 {
4230 INT erg = OK;
4231 CE3(a,b,c,dec_step_2);
4232 if ( (S_O_K(a) == PARTITION) && (S_O_K(b) == INTEGER) )
4233 {
4234 dec_step_co(a,b,c,cons_eins);
4235 }
4236 else if ( (S_O_K(a) == SCHUR) && (S_O_K(b) == INTEGER) )
4237 {
4238 OP z;
4239 z = a;
4240 init(SCHUR,c);
4241 if (S_L_S(z) != NULL)
4242 do {
4243 OP d = callocobject();
4244 dec_step_co(S_S_S(z),b,d, S_S_K(z) );
4245 insert(d,c,add_koeff,my_comp);
4246 z = S_S_N(z);
4247 } while (z != NULL);
4248 }
4249 ENDR("dec_step");
4250 }
4251
4252
dec_step_co(a,b,c,faktor)4253 static dec_step_co(a,b,c,faktor) OP a,b,c; OP faktor;
4254 {
4255 OP e,f,g,d = callocobject();
4256 INT i,j;
4257 OP anzahl,indexvec;
4258 init(BINTREE,c);
4259 g = callocobject();
4260 for (i=0,j=0;i<S_PA_LI(a);i++)
4261 if (S_PA_II(a,i)>0) j++;
4262 /* j ist die anzahl der teile != 0 */
4263 anzahl = callocobject();
4264 indexvec = callocobject();
4265 M_I_I(j,anzahl);
4266 b_l_v(anzahl,indexvec);
4267 for (i=0,j=0;i<S_PA_LI(a);i++)
4268 if (S_PA_II(a,i)>0)
4269 { M_I_I(i,S_V_I(indexvec,j)); j++; }
4270 /* der j-te eintrag in indexvec
4271 ist der index des j-ten eintrag != 0 in a */
4272
4273 first_composition(b,S_V_L(indexvec),d);
4274 do {
4275 for (i=0;i<S_V_LI(indexvec);i++)
4276 if ( S_PA_II(a,S_V_II(indexvec,i) ) < S_V_II(d,i) )
4277 goto next_step;
4278 e = callocobject();
4279 init(MONOM,e);
4280 copy_partition(a,S_MO_S(e));
4281 for (i=0;i<S_V_LI(indexvec);i++)
4282 M_I_I(S_PA_II(S_MO_S(e),S_V_II(indexvec,i))
4283 -S_V_II(d,i),
4284 S_PA_I(S_MO_S(e),S_V_II(indexvec,i))
4285 );
4286
4287
4288 copy(faktor, S_MO_K(e));
4289 for (i=0;i<S_V_LI(d);i++)
4290 if (S_V_II(d,i) != 0)
4291 {
4292 if (S_V_II(indexvec,i) > 0)
4293 M_I_I(S_PA_II(S_MO_S(e),S_V_II(indexvec,i)-1)+S_V_II(d,i),
4294 S_PA_I(S_MO_S(e),S_V_II(indexvec,i)-1));
4295 if (S_PA_II(a,S_V_II(indexvec,i)) != S_V_II(d,i) )
4296 {
4297 my_binom(S_PA_I(a,S_V_II(indexvec,i)), S_V_I(d,i), g);
4298 mult_apply(g,S_MO_K(e));
4299 }
4300 }
4301 insert(e,c,add_koeff,my_comp);
4302 next_step: ;
4303 } while(next_apply(d));
4304 t_BINTREE_SCHUR(c,c); println(c);
4305 freeall(d);
4306 freeall(indexvec);
4307 freeall(g);
4308 }
4309
4310 #endif
4311
4312
4313 #ifdef UNDEF
class_mult_schurmonom(OP a,OP b,OP c)4314 INT class_mult_schurmonom(OP a, OP b, OP c)
4315 {
4316 INT erg = OK;
4317 OP e,d;
4318 CE3(a,b,c,class_mult_schurmonom);
4319 CTO(MONOM,"class_mult_schurmonom(1)",a);
4320 CTO(MONOM,"class_mult_schurmonom",b);
4321 CTO(PARTITION,"class_mult_schurmonom-selfpart",S_MO_S(a));
4322 CTO(PARTITION,"class_mult_schurmonom-selfpart",S_MO_S(b));
4323
4324 e = callocobject();
4325 d = callocobject();
4326 erg += weight(S_MO_S(a),e);
4327 erg += weight(S_MO_S(b),d);
4328 if (neq(e,d))
4329 {
4330 erg += error("class_mult_schurmonom:different weights of partitions");
4331 goto ee;
4332 }
4333 C2R(S_MO_S(a),S_MO_S(b),"class_mult_part",c);
4334 erg += init(SCHUR,c);
4335 erg += first_partition(e,d);
4336 do {
4337 erg += c_ijk_sn(S_MO_S(a),S_MO_S(b),d,e);
4338 if (not NULLP(e))
4339 {
4340 OP f,g;
4341 f = callocobject();
4342 g = callocobject();
4343 erg += copy_partition(d,g);
4344 erg += b_skn_s(g,callocobject(),NULL,f);
4345 erg += mult(S_MO_K(a),S_MO_K(b),S_S_K(f));
4346 erg += mult_apply(e,S_S_K(f));
4347 insert(f,c,NULL,NULL);
4348 }
4349
4350 } while(next(d,d));
4351 S2R(S_MO_S(a),S_MO_S(b),"class_mult_part",c);
4352 ee:
4353 erg += freeall(e);
4354 erg += freeall(d);
4355 ENDR("class_mult_schurmonom");
4356 }
4357 #endif
4358
class_mult_schur(OP a,OP b,OP c)4359 INT class_mult_schur(OP a, OP b, OP c)
4360 {
4361 #ifdef UNDEF
4362 INT erg = OK;
4363 OP z1,z2;
4364 CTO(SCHUR,"class_mult_schur",a);
4365 CTO(SCHUR,"class_mult_schur",b);
4366 CE3(a,b,c,class_mult_schur);
4367 erg += init(SCHUR,c);
4368 z1 = a;
4369 while (z1 != NULL)
4370 {
4371 z2 = b;
4372 while (z2 != NULL)
4373 {
4374 OP e;
4375 e = callocobject();
4376 if (le(S_S_S(z1), S_S_S(z2)))
4377 erg += class_mult_schurmonom(S_L_S(z1),S_L_S(z2),e);
4378 else
4379 erg += class_mult_schurmonom(S_L_S(z2),S_L_S(z1),e);
4380 insert(e,c,NULL,NULL);
4381 z2 = S_S_N(z2);
4382 };
4383 z1 = S_S_N(z1);
4384 }
4385 ENDR("class_mult_schur");
4386 #endif
4387 return class_mult(a,b,c);
4388 }
4389
4390
4391
4392
init_elmsym(a)4393 INT init_elmsym(a) OP a;
4394 {
4395 INT erg = OK;
4396 CTO(EMPTY,"init_elmsym",a);
4397 erg += b_sn_e(NULL,NULL,a);
4398 ENDR("init_elmsym");
4399 }
init_homsym(a)4400 INT init_homsym(a) OP a;
4401 {
4402 INT erg = OK;
4403 CTO(EMPTY,"init_homsym",a);
4404 erg += b_sn_h(NULL,NULL,a);
4405 ENDR("init_homsym");
4406 }
init_powsym(a)4407 INT init_powsym(a) OP a;
4408 {
4409 INT erg = OK;
4410 CTO(EMPTY,"init_powsym",a);
4411 erg += b_sn_ps(NULL,NULL,a);
4412 ENDR("init_powsym");
4413 }
init_schur(a)4414 INT init_schur(a) OP a;
4415 {
4416 INT erg = OK;
4417 CTO(EMPTY,"init_schur",a);
4418 erg += b_sn_s(NULL,NULL,a);
4419 ENDR("init_schur");
4420 }
4421
init_monomial(a)4422 INT init_monomial(a) OP a;
4423 {
4424 INT erg = OK;
4425 CTO(EMPTY,"init_monomial",a);
4426 erg += b_sn_mon(NULL,NULL,a);
4427 ENDR("init_monomial");
4428 }
4429
conjugate_schur(a,b)4430 INT conjugate_schur(a,b) OP a,b;
4431 /* AK 111001 */
4432 {
4433 INT erg=OK,t=0;
4434 OP z;
4435 CTTO(HASHTABLE,SCHUR,"conjugate_schur(1)",a);
4436 CTTTO(EMPTY,SCHUR,HASHTABLE,"conjugate_schur(2)",b);
4437
4438 if (S_O_K(b) == EMPTY) {
4439 init_hashtable(b); t=1; }
4440
4441 FORALL(z,a,{
4442 OP d = CALLOCOBJECT();
4443 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
4444 COPY(S_MO_K(z),S_MO_K(d));
4445 erg += conjugate_partition(S_MO_S(z),S_MO_S(d));
4446
4447 if (S_O_K(b) == SCHUR)
4448 insert_list(d,b,NULL,comp_monomschur);
4449 else
4450 insert_hashtable(d,b,NULL,NULL,hash_monompartition);
4451 } );
4452
4453 if (t==1) t_HASHTABLE_SCHUR(b,b);
4454
4455 ENDR("conjugate_schur");
4456 }
4457
conjugate_elmsym(a,b)4458 INT conjugate_elmsym(a,b) OP a,b;
4459 /* AK 111001 */
4460 {
4461 INT erg=OK,t=0;
4462 OP z;
4463 CTTO(HASHTABLE,ELMSYM,"conjugate_elmsym(1)",a);
4464 CTTTO(EMPTY,ELMSYM,HASHTABLE,"conjugate_elmsym(2)",b);
4465
4466 if (S_O_K(b) == EMPTY)
4467 {
4468 init_hashtable(b);
4469 t=1;
4470 }
4471
4472 FORALL(z,a,{
4473 OP d = CALLOCOBJECT();
4474 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
4475 COPY(S_MO_K(z),S_MO_K(d));
4476 erg += conjugate_partition(S_MO_S(z),S_MO_S(d));
4477
4478 if (S_O_K(b) == ELMSYM)
4479 insert_list(d,b,NULL,comp_monomelmsym);
4480 else
4481 insert_hashtable(d,b,NULL,NULL,hash_monompartition);
4482 } );
4483
4484 if (t==1) t_HASHTABLE_ELMSYM(b,b);
4485
4486 ENDR("conjugate_elmsym");
4487 }
4488
conjugate_homsym(a,b)4489 INT conjugate_homsym(a,b) OP a,b;
4490 /* AK 111001 */
4491 {
4492 INT erg=OK,t=0;
4493 OP z;
4494 CTTO(HASHTABLE,HOMSYM,"conjugate_homsym(1)",a);
4495 CTTTO(EMPTY,HOMSYM,HASHTABLE,"conjugate_homsym(2)",b);
4496
4497 if (S_O_K(b) == EMPTY)
4498 {
4499 init_hashtable(b);
4500 t=1;
4501 }
4502
4503 FORALL(z,a,{
4504 OP d = CALLOCOBJECT();
4505 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
4506 COPY(S_MO_K(z),S_MO_K(d));
4507 erg += conjugate_partition(S_MO_S(z),S_MO_S(d));
4508
4509 if (S_O_K(b) == HOMSYM)
4510 insert_list(d,b,NULL,comp_monomhomsym);
4511 else
4512 insert_hashtable(d,b,NULL,NULL,hash_monompartition);
4513 } );
4514
4515 if (t==1) t_HASHTABLE_HOMSYM(b,b);
4516
4517 ENDR("conjugate_homsym");
4518 }
4519
conjugate_powsym(a,b)4520 INT conjugate_powsym(a,b) OP a,b;
4521 /* AK 111001 */
4522 {
4523 INT erg=OK,t=0;
4524 OP z;
4525 CTTO(HASHTABLE,POWSYM,"conjugate_powsym(1)",a);
4526 CTTTO(EMPTY,POWSYM,HASHTABLE,"conjugate_powsym(2)",b);
4527
4528 if (S_O_K(b) == EMPTY)
4529 {
4530 init_hashtable(b);
4531 t=1;
4532 }
4533
4534 FORALL(z,a,{
4535 OP d = CALLOCOBJECT();
4536 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
4537 COPY(S_MO_K(z),S_MO_K(d));
4538 erg += conjugate_partition(S_MO_S(z),S_MO_S(d));
4539
4540 if (S_O_K(b) == POWSYM)
4541 insert_list(d,b,NULL,comp_monompowsym);
4542 else
4543 insert_hashtable(d,b,NULL,NULL,hash_monompartition);
4544 } );
4545
4546 if (t==1) t_HASHTABLE_POWSYM(b,b);
4547
4548 ENDR("conjugate_powsym");
4549 }
4550
conjugate_monomial(a,b)4551 INT conjugate_monomial(a,b) OP a,b;
4552 /* AK 111001 */
4553 {
4554 INT erg=OK,t=0;
4555 OP z;
4556 CTTO(HASHTABLE,MONOMIAL,"conjugate_monomial(1)",a);
4557 CTTTO(EMPTY,MONOMIAL,HASHTABLE,"conjugate_monomial(2)",b);
4558
4559 if (S_O_K(b) == EMPTY)
4560 {
4561 init_hashtable(b);
4562 t=1;
4563 }
4564
4565 FORALL(z,a,{
4566 OP d = CALLOCOBJECT();
4567 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
4568 COPY(S_MO_K(z),S_MO_K(d));
4569 erg += conjugate_partition(S_MO_S(z),S_MO_S(d));
4570
4571 if (S_O_K(b) == MONOMIAL)
4572 insert_list(d,b,NULL,comp_monommonomial);
4573 else
4574 insert_hashtable(d,b,NULL,NULL,hash_monompartition);
4575 } );
4576
4577 if (t==1) t_HASHTABLE_MONOMIAL(b,b);
4578
4579 ENDR("conjugate_monomial");
4580 }
4581
4582
4583
4584
find_schur(a,b)4585 OP find_schur(a,b) OP a,b;
4586 /* AK 161001 */
4587 /* return OP pointer to SCHUR element
4588 with partition eq b, b is monom or partition */
4589 {
4590 INT erg = OK;
4591 OP z,p;
4592 CTO(SCHUR,"find_schur(1)",a);
4593 CTTO(PARTITION,MONOM,"find_schur(2)",b);
4594 if (S_O_K(b) == MONOM)
4595 {
4596 CTO(PARTITION,"find_schur(2b)",S_MO_S(b));
4597 p = S_MO_S(b);
4598 }
4599 else p = b;
4600
4601 z = a;
4602 while (z != NULL)
4603 {
4604 if (EQ(p,S_S_S(z))) return S_L_S(z);
4605 z = S_S_N(z);
4606 }
4607 return NULL;
4608 ENDO("find_schur");
4609 }
4610
find_monomial(a,b)4611 OP find_monomial(a,b) OP a,b;
4612 /* AK 161001 */
4613 /* return OP pointer to MONOMIAL element
4614 with partition eq b, b is monom or partition */
4615 {
4616 INT erg = OK;
4617 OP z,p;
4618 CTO(MONOMIAL,"find_monomial(1)",a);
4619 CTTO(PARTITION,MONOM,"find_monomial(2)",b);
4620 if (S_O_K(b) == MONOM)
4621 {
4622 CTO(PARTITION,"find_monomial(2b)",S_MO_S(b));
4623 p = S_MO_S(b);
4624 }
4625 else p = b;
4626
4627 z = a;
4628 while (z != NULL)
4629 {
4630 if (EQ(p,S_S_S(z))) return S_L_S(z);
4631 z = S_S_N(z);
4632 }
4633 return NULL;
4634 ENDO("find_monomial");
4635 }
4636
4637
4638
4639
4640
4641 #define FINDMAX_SF(a,cf)\
4642 {\
4643 OP z,res=NULL;\
4644 if (cf == NULL) cf = comp;\
4645 FORALL(z,a, {\
4646 if (res ==NULL) res = z;\
4647 else if ( (*cf)(S_MO_S(z),S_MO_S(res)) > 0 ) res = z;\
4648 } );\
4649 return res;\
4650 }
4651
findmax_schur(a,cf)4652 OP findmax_schur(a,cf) OP a; INT (*cf)();
4653 /* AK 161001 */
4654 /* returns maximum according to comp function */
4655 /* comp function operates on PARTITIONS */
4656 /* if cf == NULL comp is used */
4657 {
4658 INT erg = OK;
4659 CTTO(SCHUR,HASHTABLE,"findmax_schur(1)",a);
4660 FINDMAX_SF(a,cf);
4661 ENDO("findmax_schur");
4662 }
4663
4664
findmax_monomial(a,cf)4665 OP findmax_monomial(a,cf) OP a; INT (*cf)();
4666 /* AK 161001 */
4667 /* returns maximum according to comp function */
4668 /* comp function operates on PARTITIONS */
4669 /* if cf == NULL comp is used */
4670 {
4671 INT erg = OK;
4672 CTTO(HASHTABLE,MONOMIAL,"find_monomial",a);
4673 FINDMAX_SF(a,cf);
4674 ENDO("findmax_monomial");
4675 }
4676
findmax_powsym(a,cf)4677 OP findmax_powsym(a,cf) OP a; INT (*cf)();
4678 /* AK 161001 */
4679 /* returns maximum according to comp function */
4680 /* comp function operates on PARTITIONS */
4681 /* if cf == NULL comp is used */
4682 {
4683 INT erg = OK;
4684 CTTO(HASHTABLE,POWSYM,"find_powsym",a);
4685 FINDMAX_SF(a,cf);
4686 ENDO("findmax_powsym");
4687 }
4688
findmax_elmsym(a,cf)4689 OP findmax_elmsym(a,cf) OP a; INT (*cf)();
4690 /* AK 161001 */
4691 /* returns maximum according to comp function */
4692 /* comp function operates on PARTITIONS */
4693 /* if cf == NULL comp is used */
4694 {
4695 INT erg = OK;
4696 CTTO(HASHTABLE,ELMSYM,"find_elmsym",a);
4697 FINDMAX_SF(a,cf);
4698 ENDO("findmax_elmsym");
4699 }
4700
findmax_homsym(a,cf)4701 OP findmax_homsym(a,cf) OP a; INT (*cf)();
4702 /* AK 161001 */
4703 /* returns maximum according to comp function */
4704 /* comp function operates on PARTITIONS */
4705 /* if cf == NULL comp is used */
4706 {
4707 INT erg = OK;
4708 CTTO(HASHTABLE,HOMSYM,"find_homsym",a);
4709 FINDMAX_SF(a,cf);
4710 ENDO("findmax_homsym");
4711 }
4712
4713 #define FINDMIN_SF(a,cf)\
4714 {\
4715 OP z,res=NULL;\
4716 if (cf == NULL) cf = comp;\
4717 FORALL(z,a,\
4718 {\
4719 if (res ==NULL) res = z;\
4720 else if ( (*cf)(S_MO_S(z),S_MO_S(res)) < 0 ) res = z;\
4721 });\
4722 return res;\
4723 }
4724
findmin_monomial(a,cf)4725 OP findmin_monomial(a,cf) OP a; INT (*cf)();
4726 /* AK 161001 */
4727 /* returns minimum according to comp function */
4728 /* comp function operates on PARTITIONS */
4729 /* if cf == NULL comp is used */
4730 {
4731 INT erg = OK;
4732 CTTO(HASHTABLE,MONOMIAL,"findmin_monomial(1)",a);
4733 FINDMIN_SF(a,cf);
4734 ENDO("findmin_monomial");
4735 }
4736
findmin_schur(a,cf)4737 OP findmin_schur(a,cf) OP a; INT (*cf)();
4738 /* AK 161001 */
4739 /* returns minimum according to comp function */
4740 /* comp function operates on PARTITIONS */
4741 /* if cf == NULL comp is used */
4742 {
4743 INT erg = OK;
4744 CTTO(HASHTABLE,SCHUR,"findmin_schur(1)",a);
4745 FINDMIN_SF(a,cf);
4746 ENDO("findmin_schur");
4747 }
4748
findmin_elmsym(a,cf)4749 OP findmin_elmsym(a,cf) OP a; INT (*cf)();
4750 /* AK 161001 */
4751 /* returns minimum according to comp function */
4752 /* comp function operates on PARTITIONS */
4753 /* if cf == NULL comp is used */
4754 {
4755 INT erg = OK;
4756 CTTO(HASHTABLE,ELMSYM,"findmin_elmsym(1)",a);
4757 FINDMIN_SF(a,cf);
4758 ENDO("findmin_elmsym");
4759 }
4760
findmin_homsym(a,cf)4761 OP findmin_homsym(a,cf) OP a; INT (*cf)();
4762 /* AK 161001 */
4763 /* returns minimum according to comp function */
4764 /* comp function operates on PARTITIONS */
4765 /* if cf == NULL comp is used */
4766 {
4767 INT erg = OK;
4768 CTTO(HASHTABLE,HOMSYM,"findmin_homsym(1)",a);
4769 FINDMIN_SF(a,cf);
4770 ENDO("findmin_homsym");
4771 }
4772
findmin_powsym(a,cf)4773 OP findmin_powsym(a,cf) OP a; INT (*cf)();
4774 /* AK 161001 */
4775 /* returns minimum according to comp function */
4776 /* comp function operates on PARTITIONS */
4777 /* if cf == NULL comp is used */
4778 {
4779 INT erg = OK;
4780 CTTO(HASHTABLE,POWSYM,"findmin_powsym(1)",a);
4781 FINDMIN_SF(a,cf);
4782 ENDO("findmin_powsym");
4783 }
4784
m_forall_monomials_in_a(a,b,c,f,partf)4785 INT m_forall_monomials_in_a(a,b,c,f,partf) OP a,b,c,f; INT (*partf)();
4786 /* basic routine for multiplication */
4787 {
4788 INT erg = OK;
4789 OP ff,z;
4790 ff = CALLOCOBJECT();
4791
4792 FORALL (z,a, {
4793 if (EINSP(f))
4794 erg += (*partf)(S_MO_S(z),b,c,S_MO_K(z));
4795 else {
4796 FREESELF(ff);
4797 MULT(f,S_MO_K(z),ff);
4798 erg += (*partf)(S_MO_S(z),b,c,ff);
4799 }
4800 } );
4801 FREEALL(ff);
4802
4803 ENDR("m_forall_monomials_in_a");
4804 }
4805
4806
t_forall_monomials_in_a(a,b,f,partf)4807 INT t_forall_monomials_in_a(a,b,f,partf) OP a,b,f; INT (*partf)();
4808 /* basic routine for multiplication */
4809 {
4810 INT erg = OK;
4811 OP ff,z;
4812 ff = CALLOCOBJECT();
4813
4814 FORALL (z,a, {
4815 if (EINSP(f))
4816 erg += (*partf)(S_MO_S(z),b,S_MO_K(z));
4817 else {
4818 FREESELF(ff);
4819 MULT(f,S_MO_K(z),ff);
4820 erg += (*partf)(S_MO_S(z),b,ff);
4821 }
4822 } );
4823 FREEALL(ff);
4824
4825 ENDR("t_forall_monomials_in_a");
4826 }
4827
4828
4829
m_forall_monomials_in_b(a,b,c,f,partf)4830 INT m_forall_monomials_in_b(a,b,c,f,partf) OP a,b,c,f; INT (*partf)();
4831 /* basic routine for multiplication */
4832 {
4833 INT erg = OK;
4834 OP ff,z;
4835 ff = CALLOCOBJECT();
4836
4837 FORALL (z,b, {
4838 CTO(ANYTYPE,"m_forall_monomials_in_b(i4)",f);
4839 CTO(MONOM,"m_forall_monomials_in_b(z)",z);
4840 if (EINSP(f))
4841 {
4842 erg += (*partf)(a,S_MO_S(z),c,S_MO_K(z));
4843 }
4844 else {
4845 FREESELF(ff);
4846 MULT(f,S_MO_K(z),ff);
4847 erg += (*partf)(a,S_MO_S(z),c,ff);
4848 }
4849 } );
4850 FREEALL(ff);
4851
4852 ENDR("m_forall_monomials_in_b");
4853 }
4854
m_forall_monomials_in_ab(a,b,c,f,partf)4855 INT m_forall_monomials_in_ab(a,b,c,f,partf) OP a,b,c,f; INT (*partf)();
4856 /* basic routine for multiplication */
4857 {
4858 INT erg = OK;
4859 OP ff,z,y;
4860 ff = CALLOCOBJECT();
4861
4862 FORALL (y,a, {
4863 FORALL (z,b, {
4864 FREESELF(ff);
4865 MULT(S_MO_K(z),S_MO_K(y),ff);
4866 if (not EINSP(f)) {
4867 MULT_APPLY(f,ff);
4868 }
4869 erg += (*partf)(S_MO_S(y),S_MO_S(z),c,ff);
4870 } );
4871 } );
4872 FREEALL(ff);
4873
4874 ENDR("m_forall_monomials_in_b");
4875 }
4876
t_loop_partition(a,b,f,intf,multf,multapplyf)4877 INT t_loop_partition(a,b,f,intf,multf,multapplyf) OP a,b,f;
4878 INT (*intf)(); INT (*multf)(); INT (*multapplyf)();
4879 /* computes the decomposition of a partition by looping over all
4880 parts of the partition and multiplying */
4881 {
4882 INT erg = OK;
4883 CTO(PARTITION,"t_loop_partition(1)",a);
4884 CTTTTTTO(HASHTABLE,POWSYM,SCHUR,HOMSYM,ELMSYM,MONOMIAL,"t_loop_partition(2)",b);
4885 if (S_PA_LI(a) == 0) {
4886 OP m;
4887 m = CALLOCOBJECT();
4888 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
4889 erg += first_partition(cons_null,S_MO_S(m));
4890 COPY(f,S_MO_K(m));
4891 INSERT_HOMSYMMONOM_(m,b); /* also for other types working */
4892 goto ende;
4893 }
4894 else if (S_PA_LI(a) == 1)
4895 {
4896 (*intf)(S_PA_I(a,0),b,f);
4897 goto ende;
4898 }
4899 else {
4900 OP l,d;
4901 INT i;
4902 l = CALLOCOBJECT();
4903 d = CALLOCOBJECT();
4904 init_hashtable(l);
4905 init_hashtable(d);
4906
4907 erg += (*intf)(S_PA_I(a,0),d,f);
4908
4909 for (i=1;i<S_PA_LI(a)-1;i++)
4910 {
4911 erg += (*intf)(S_PA_I(a,i),l,cons_eins);
4912 (*multapplyf)(l,d);
4913 CLEAR_HASHTABLE(l);
4914 }
4915
4916 erg += (*intf)(S_PA_I(a,S_PA_LI(a)-1),l,cons_eins);
4917 erg += (*multf)(d,l,b);
4918 FREEALL(d);
4919 FREEALL(l);
4920 }
4921
4922
4923 ende:
4924 ENDR("t_loop_partition");
4925 }
4926
4927
4928
4929
t_splitpart(a,b,f,tf,mf)4930 INT t_splitpart(a,b,f,tf,mf) OP a,b,f; INT (*tf)(), (*mf)();
4931 /* to trans using spliting of partition */
4932 /* both parts are transferred to the new basis and
4933 multiplication afterwards */
4934 {
4935 INT erg = OK;
4936 OP m1,m2,h1,h2;
4937 CTO(PARTITION,"t_splitpart(1)",a);
4938 SYMCHECK((S_PA_LI(a) <2),"t_splitpart:partition with < 2 parts ");
4939
4940 m1 = CALLOCOBJECT();
4941 m2 = CALLOCOBJECT();
4942 erg += splitpart(a,m1,m2);
4943 NEW_HASHTABLE(h1);
4944 NEW_HASHTABLE(h2);
4945 erg += (*tf)(m1,h1,cons_eins);
4946 erg += (*tf)(m2,h2,cons_eins);
4947 erg += (*mf)(h1,h2,b,f);
4948 FREEALL(m1);
4949 FREEALL(m2);
4950 FREEALL(h1);
4951 FREEALL(h2);
4952 ENDR("t_splitpart");
4953 }
4954
p_splitpart(a,b,c,f,tf,mf)4955 INT p_splitpart(a,b,c,f,tf,mf) OP a,b,c,f; INT (*tf)(), (*mf)();
4956 /* to compute plethysm using spliting of partition */
4957 /* for both parts the plethysm is computed
4958 multiplication afterwards */
4959 /* works for outer homsym/powsym or elmsym
4960 H_ab [C] = H_a [C] * H_b[C] */
4961 /* AK 061201 */
4962 {
4963 INT erg = OK;
4964 CTO(PARTITION,"p_splitpart(1)",a);
4965 SYMCHECK((S_PA_LI(a) <2),"p_splitpart:partition with < 2 parts ");
4966
4967 if (S_PA_II(a,0) == S_PA_II(a,S_PA_LI(a)-1) )
4968 {
4969 INT i,l = S_PA_LI(a);
4970 OP h1,h2;
4971 h1 = CALLOCOBJECT();init_hashtable(h1);
4972 h2 = CALLOCOBJECT();
4973 M_I_I(1,S_PA_L(a));
4974 erg += (*tf)(a,b,h1,cons_eins);
4975 M_I_I(l,S_PA_L(a));
4976 COPY(h1,h2);
4977
4978 for (i=2;i<l;i++)
4979 {
4980 OP h3;
4981 h3 = CALLOCOBJECT();init_hashtable(h3);
4982 SWAP(h3,h2);
4983 erg += (*mf)(h1,h3,h2,cons_eins);
4984 FREEALL(h3);
4985 }
4986
4987 erg += (*mf)(h1,h2,c,f);
4988 FREEALL(h1);
4989 FREEALL(h2);
4990 goto ende;
4991 }
4992 else {
4993 OP m1,m2,h1,h2;
4994 m1 = CALLOCOBJECT();
4995 m2 = CALLOCOBJECT();
4996 splitpart(a,m1,m2);
4997 NEW_HASHTABLE(h1);
4998 NEW_HASHTABLE(h2);
4999 erg += (*tf)(m1,b,h1,cons_eins);
5000 erg += (*tf)(m2,b,h2,cons_eins);
5001 erg += (*mf)(h1,h2,c,f);
5002 FREEALL(m1);
5003 FREEALL(m2);
5004 FREEALL(h1);
5005 FREEALL(h2);
5006 goto ende;
5007 }
5008 ende:
5009 ENDR("p_splitpart");
5010 }
5011
5012
p_splitpart2(a,b,c,f,tf,mf)5013 INT p_splitpart2(a,b,c,f,tf,mf) OP a,b,c,f; INT (*tf)(), (*mf)();
5014 /* to compute plethysm using spliting of partition */
5015 /* for both parts the plethysm is computed
5016 multiplication afterwards */
5017 /* works for outer powsym
5018 P_I [h_ab] = P_I [h_a] * P_I[h_b] */
5019 /* AK 061201 */
5020 {
5021 INT erg = OK;
5022 OP m1,m2,h1,h2;
5023 CTO(PARTITION,"p_splitpart(2)",b);
5024 SYMCHECK((S_PA_LI(b) <2),"p_splitpart:partition with < 2 parts ");
5025
5026 m1 = CALLOCOBJECT();
5027 m2 = CALLOCOBJECT();
5028 splitpart(b,m1,m2);
5029 h1 = CALLOCOBJECT();init_hashtable(h1);
5030 h2 = CALLOCOBJECT();init_hashtable(h2);
5031 erg += (*tf)(a,m1,h1,cons_eins);
5032 erg += (*tf)(a,m2,h2,cons_eins);
5033 erg += (*mf)(h1,h2,c,f);
5034 FREEALL(m1);
5035 FREEALL(m2);
5036 FREEALL(h1);
5037 FREEALL(h2);
5038 ENDR("p_splitpart2");
5039 }
5040
txx_null__faktor(b,f)5041 INT txx_null__faktor(b,f) OP b,f;
5042 /* b = b + symfunc_0 * f */
5043 {
5044 INT erg = OK;
5045 OP m;
5046 CTO(ANYTYPE,"txx_null__faktor(2)",f);
5047 CTTTTTTO(SCHUR,MONOMIAL,HASHTABLE,HOMSYM,ELMSYM,POWSYM,"txx_null__faktor(1)",b);
5048 m = CALLOCOBJECT();
5049 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
5050 COPY(f,S_MO_K(m));
5051 erg += first_partition(cons_null,S_MO_S(m));
5052 if (S_O_K(b) == HASHTABLE)
5053 insert_scalar_hashtable(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
5054 else
5055 INSERT_LIST(m,b,add_koeff,comp_monomschur);
5056
5057 ENDR("txx_null__faktor");
5058 }
5059
5060
5061
mxx_null__(b,c,f)5062 INT mxx_null__(b,c,f) OP b,c,f;
5063 /* c = c + symfunc_b * f */
5064 /* called from several m.._null__ routines */
5065 {
5066 INT erg = OK;
5067 CTTTTTTTTO(PARTITION,INTEGER,SCHUR,MONOMIAL,HASHTABLE,HOMSYM,ELMSYM,POWSYM,"mxx_null__(1)",b);
5068 CTTTTTTO(SCHUR,MONOMIAL,HASHTABLE,HOMSYM,ELMSYM,POWSYM,"mxx_null__(2)",c);
5069 CTO(ANYTYPE,"mxx_null__(3)",f);
5070
5071
5072 if (S_O_K(b) == INTEGER) {
5073 OP m;
5074 m = CALLOCOBJECT();
5075 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
5076 COPY(f,S_MO_K(m));
5077 erg += first_partition(b,S_MO_S(m));
5078 if (S_O_K(c) == HASHTABLE)
5079 insert_scalar_hashtable(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
5080 else
5081 INSERT_LIST(m,c,add_koeff,comp_monomschur);
5082 }
5083 else if (S_O_K(b) == PARTITION)
5084 {
5085 _NULL_PARTITION_(b,c,f);
5086 }
5087 else
5088 {
5089 OP m;
5090 m = CALLOCOBJECT();
5091 COPY(b,m);
5092 if (not EINSP(f))
5093 {
5094 MULT_APPLY(f,m);
5095 }
5096 if (S_O_K(c) == HASHTABLE)
5097 INSERT_HASHTABLE(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
5098 else
5099 INSERT_LIST(m,c,add_koeff,comp_monomschur);
5100 }
5101 ENDR("mxx_null");
5102 }
5103
5104
giambelli_matrix(a,b)5105 INT giambelli_matrix(a,b) OP a,b;
5106 /* computes the matrix of giambelli
5107 a determinant of hooks */
5108 /* AK 260603 */
5109 {
5110 INT erg = OK;
5111 INT i,j,k;
5112 OP c,l,r;
5113 CTO(PARTITION,"giambelli_matrix(1)",a);
5114 c=CALLOCOBJECT();
5115 erg += t_VECTOR_FROBENIUS(a,c);
5116 r=S_V_I(S_PA_S(c),0);
5117 l=S_V_I(S_PA_S(c),1);
5118 erg += m_lh_m(S_V_L(l) ,S_V_L(r), b);
5119 for (i=0;i<S_M_HI(b);i++)
5120 for (j=0;j<S_M_LI(b);j++)
5121 {
5122 OP d,e;
5123 d = CALLOCOBJECT();
5124 e = CALLOCOBJECT();
5125 erg += m_il_integervector(S_V_II(l,j)+1,d);
5126 for (k=0;k<S_V_II(l,j);k++) M_I_I(1,S_V_I(d,k));
5127 M_I_I(S_V_II(r,i)+1,S_V_I(d,k));
5128 erg += b_ks_pa(VECTOR,d,e);
5129 erg += b_pa_s(e,S_M_IJ(b,i,j));
5130 }
5131 FREEALL(c);
5132 ENDR("giambelli_matrix");
5133 }
5134
5135
5136
ribbon_matrix(a,b)5137 INT ribbon_matrix(a,b) OP a,b;
5138 /* computes the matrix of ribbons,
5139 whose determinant is the schur function
5140 */
5141 /* AK 270603 */
5142 {
5143 INT erg = OK;
5144 INT i,j;
5145 OP c;
5146 CTO(PARTITION,"ribbon_matrix(1)",a);
5147 erg += durfee_size_part(a,b);
5148 erg += m_lh_m(b,b,b);
5149 c=CALLOCOBJECT();
5150 for (i=0;i<S_M_HI(b);i++)
5151 for (j=0;j<S_M_LI(b);j++)
5152 {
5153 erg += ribbon_partition(a,i,j,c);
5154 erg += part_part_skewschur(S_SPA_G(c),S_SPA_K(c),S_M_IJ(b,i,j));
5155 }
5156 FREEALL(c);
5157 ENDR("ribbon_matrix");
5158 }
5159
5160
jacobitrudimatrix(a,b)5161 INT jacobitrudimatrix(a,b) OP a,b;
5162 /* build the matrix of jacobi trudi */
5163 /* AK 010703 V2.0 */
5164 {
5165 INT i,j,k;
5166 INT erg = OK;
5167 CTTTO(INTEGERVECTOR,PARTITION,SKEWPARTITION,"jacobitrudimatrix(1)",a);
5168 if (S_O_K(a) == PARTITION)
5169 {
5170 m_lh_nm(S_PA_L(a),S_PA_L(a),b);
5171 for (i=0;i<S_M_HI(b);i++)
5172 for (j=0;j<S_M_LI(b);j++) {
5173 k = S_PA_II(a,S_PA_LI(a)-1-i)+j-i;
5174 if (k<0) continue;
5175 m_int_pa(k,S_M_IJ(b,i,j));
5176 m_pa_s(S_M_IJ(b,i,j),S_M_IJ(b,i,j));
5177 }
5178 }
5179 else if (S_O_K(a) == INTEGERVECTOR) /* AK 010703 */
5180 {
5181 m_lh_nm(S_V_L(a),S_V_L(a),b);
5182 for (i=0;i<S_M_HI(b);i++)
5183 for (j=0;j<S_M_LI(b);j++) {
5184 k = S_V_II(a,i)+j-i;
5185 if (k<0) continue;
5186 m_int_pa(k,S_M_IJ(b,i,j));
5187 m_pa_s(S_M_IJ(b,i,j),S_M_IJ(b,i,j));
5188 }
5189 }
5190 else if (S_O_K(a) = SKEWPARTITION) /* AK 010703 */
5191 {
5192 OP g = S_SPA_G(a);
5193 OP kl = S_SPA_K(a);
5194 m_lh_nm(S_PA_L(g),S_PA_L(g),b);
5195 for (i=0;i<S_M_HI(b);i++)
5196 for (j=0;j<S_M_LI(b);j++) {
5197 k = S_PA_II(g,S_PA_LI(g)-1-i)+j-i;
5198 /* now subtract smaller part */
5199 if (S_PA_LI(kl)-j-1 >= 0) k = k - S_PA_II(kl,S_PA_LI(kl)-j-1);
5200 if (k<0) continue;
5201 m_int_pa(k,S_M_IJ(b,i,j));
5202 m_pa_s(S_M_IJ(b,i,j),S_M_IJ(b,i,j));
5203 }
5204 }
5205 ENDR("jacobitrudimatrix");
5206 }
5207
5208
5209
5210
5211