1 /* SYMMETRICA V2.0 260298 */
2 /* file: part.c */
3
4 #include "def.h"
5 #include "macro.h"
6
7
8 static struct partition * callocpartition();
9 static void utiliser();
10 static void repartir();
11 static INT ordcon_char();
12 static INT m060588();
13 static INT m060588b();
14 INT mem_counter_part=(INT)0; /* AK 100893 */
15
16
17 INT partition_speicherindex=-1; /* AK 301001 */
18 INT partition_speichersize=0; /* AK 301001 */
19 struct partition **partition_speicher=NULL; /* AK 301001 */
20 static OP nb_e = NULL; /* result in number of part */
21
22
23
24
25
26
27 #ifdef PARTTRUE
28 INT t_CHARPARTITION_PARTITION();
29
part_kind_to_text(k)30 static char * part_kind_to_text(k) OBJECTKIND k;
31 {
32 switch(k)
33 {
34 case EXPONENT: return "exponent";
35 case VECTOR: return "vector";
36 case BITVECTOR: return "bitvector";
37 case FROBENIUS: return "frobenius";
38 default: return "unknown";
39 }
40 }
41
wrong_kind_part(t,a,b)42 static INT wrong_kind_part(t,a,b) char *t; OP a; OBJECTKIND b;
43 {
44 char s[200];
45 sprintf(s,"%s: wrong kind of partition, should be %s but it was %s",
46 t,part_kind_to_text(b),part_kind_to_text(S_PA_K(a)));
47 error(s);
48 return ERROR;
49 }
50
hookp(a)51 INT hookp(a) OP a;
52 /* AK 110888 */ /* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 180391 V1.2 */
53 /* AK 210891 V1.3 */ /* AK V2.0 160698 */
54 {
55 INT erg = OK;
56 PART_CHECK_KIND("hookp",a,VECTOR);
57 if (S_PA_LI (a) <= 1)
58 return(TRUE);
59 if (S_PA_II (a, S_PA_LI(a) - 2) == 1)
60 return(TRUE);
61 return(FALSE);
62 ENDR("hookp");
63 }
64
inc_partition(a)65 INT inc_partition(a) OP a;
66 /* AK 2.0 090298 */
67 {
68 INT erg = OK;
69 CTO(PARTITION,"inc_partition(1)",a);
70 erg += inc_vector(S_PA_S(a));
71 ENDR("inc_partition");
72 }
73
m_i_staircase(a,b)74 INT m_i_staircase(a,b) OP a,b;
75 /* AK 2.0 090298 */
76 /* input: INTEGER object a
77 output: PARTITION object 1,2,3,4,...,a */
78 {
79 INT i;
80 INT erg = OK;
81 CTO(INTEGER,"m_i_staircase",a);
82 if (S_I_I(a) <= (INT)0)
83 {
84 erg += error("m_i_staircase:input <= 0");
85 goto endr_ende;
86 }
87 CE2(a,b,m_i_staircase);
88
89 erg += b_ks_pa(VECTOR,callocobject(),b);
90 erg += m_l_v(a,S_PA_S(b));
91 C_O_K(S_PA_S(b),INTEGERVECTOR);
92 for (i=0;i<S_PA_LI(b);i++)
93 M_I_I(i+1,S_PA_I(b,i));
94 ENDR("m_i_staircase");
95 }
96
partitionp(a)97 INT partitionp(a) OP a;
98 /* AK 170692 */
99 /* AK 2.0 090298 */
100 {
101 INT i;
102 if ( S_O_K(a) == CHARPARTITION) /* AK 170593 */
103 {
104 INT m=1;
105 for (i=(INT)0;i<S_PA_CL(a); i++)
106 {
107 if (S_PA_CII(a,i) < m) return FALSE;
108 m = S_PA_CII(a,i);
109 }
110 return TRUE;
111 }
112 if ( S_O_K(a) != PARTITION ) return FALSE;
113 if ( S_PA_K(a) == VECTOR )
114 {
115 INT m=1;
116 for (i=(INT)0;i<S_PA_LI(a); i++)
117 {
118 if (S_O_K(S_PA_I(a,i)) != INTEGER) return FALSE;
119 if (S_PA_II(a,i) < m) return FALSE;
120 m = S_PA_II(a,i);
121 }
122 return TRUE;
123 }
124 if ( S_PA_K(a) == EXPONENT )
125 {
126 for (i=(INT)0;i<S_PA_LI(a); i++)
127 {
128 if (S_O_K(S_PA_I(a,i)) != INTEGER) return FALSE;
129 if (S_PA_II(a,i) < (INT)0) return FALSE;
130 }
131 return TRUE;
132 }
133 if (S_PA_K(a) == BITVECTOR )
134 return TRUE;
135 return FALSE;
136 }
137
138
139
neqparts_partition(a)140 INT neqparts_partition(a) OP a; { return strictp(a); }
141
strictp(a)142 INT strictp(a) OP a;
143 /* AK 300792 true if no equal parts */
144 /* AK 2.0 090298 */
145 {
146 INT i;
147 INT erg = OK;
148 CTO(PARTITION,"strictp(1)",a);
149 if (S_PA_K(a) == VECTOR)
150 {
151 for (i=1;i<S_PA_LI(a);i++)
152 if (S_PA_II(a,i) == S_PA_II(a,i-1))
153 return FALSE;
154 return TRUE;
155 }
156 else if (S_PA_K(a) == EXPONENT)
157 {
158 for (i=(INT)0;i<S_PA_LI(a);i++)
159 if (S_PA_II(a,i) > 1) return FALSE;
160 return TRUE;
161 }
162 else
163 {
164 debugprint(a);
165 return error("strictp:wrong type of partition");
166 }
167 ENDR("strictp");
168 }
169
oddpartsp(a)170 INT oddpartsp(a) OP a;
171 /* AK 080306 V3.0 true if all parts odd */
172 {
173 INT i;
174 INT erg =OK;
175 CTO(PARTITION,"oddpartsp(1)",a);
176 if (S_PA_K(a) == VECTOR)
177 {
178 for (i=0;i<S_PA_LI(a);i++)
179 if (S_PA_II(a,i) %2 == 0) return FALSE;
180 return TRUE;
181 }
182 else
183 NYI("oddpartsp");
184 ENDR("oddpartsp");
185 }
186
187
188
sub_part_part(a,b,c)189 INT sub_part_part(a,b,c) OP a,b,c;
190 /* c = a - b */
191 /* component wise subtraction */
192 /* AK 100603 */
193 {
194 INT erg = OK;
195 INT i,j,l;
196 PART_CHECK_KIND("sub_part_part",a,VECTOR);
197 PART_CHECK_KIND("sub_part_part",b,VECTOR);
198 SYMCHECK(S_PA_LI(b) > S_PA_LI(a), "sub_part_part:second partition too big");
199 CE3(a,b,c,sub_part_part);
200 if (S_PA_LI(a) == S_PA_LI(b))
201 {
202 for (i=0;i<S_PA_LI(a);i++) if (S_PA_II(a,i) != S_PA_II(b,i)) break;
203 if (i==S_PA_LI(a)) {
204 m_il_pa(0,c); /* 0 missing in first parameter AK 100206 */
205 goto ende; /* it was a = b */
206 }
207 j = i;
208 m_il_pa(S_PA_LI(a)-i,c);
209 l=0;
210 }
211 else {
212 i = S_PA_LI(a)-S_PA_LI(b); j=0;
213 copy_partition(a,c);
214 l = i;
215 }
216 for (;j<S_PA_LI(b);j++,i++,l++)
217 M_I_I(S_PA_II(a,i)-S_PA_II(b,j),S_PA_I(c,l));
218 l=S_PA_II(c,0);
219 /* check the result wether partition */
220 for (i=1;i<S_PA_LI(c);i++)
221 if (S_PA_II(c,i) < l) {
222 erg += error("sub_part_part: second parameter not contained in the first parameter ");
223 FREESELF(c);
224 goto ende;
225 }
226 else l=S_PA_II(c,i);
227
228 ende:;
229 ENDR("sub_part_part");
230 }
231
add_part_part(a,b,c)232 INT add_part_part(a,b,c) OP a,b,c;
233 /* c = a + b */
234 /* component wise addidtion */
235 /* AK 071189 */ /* AK 181289 V1.1 */ /* AK090891 V1.3 */
236 /* AK 2.0 090298 */
237 {
238 INT i,j;
239 INT erg = OK;
240 PART_CHECK_KIND("add_part_part",a,VECTOR);
241 PART_CHECK_KIND("add_part_part",b,VECTOR);
242 CE3(a,b,c,add_part_part);
243
244 if (S_PA_LI(a) <= S_PA_LI(b))
245 {
246 erg += copy_partition(b,c);
247 for (i=S_PA_LI(a)-1,j=S_PA_LI(b)-1;i>=(INT)0;i--,j--)
248 M_I_I(S_PA_II(a,i) + S_PA_II(b,j),S_PA_I(c,j));
249 }
250 else {
251 erg += copy_partition(a,c);
252 for (i=S_PA_LI(a)-1,j=S_PA_LI(b)-1;j>=(INT)0;i--,j--)
253 M_I_I(S_PA_II(a,i) + S_PA_II(b,j),S_PA_I(c,i));
254 }
255 ENDR("add_part_part");
256 }
257
remove_part_integer(a,b,c)258 INT remove_part_integer(a,b,c) OP a,b,c;
259 /* AK 100202 */
260 /* 234,2 --> 34 */
261 {
262 INT erg = OK;
263 OP d;
264 CTO(PARTITION,"remove_part_integer(1)",a);
265 CTO(INTEGER,"remove_part_integer(2)",b);
266 CTO(EMPTY,"remove_part_integer(3)",c);
267 d = CALLOCOBJECT();
268 erg += m_i_pa(b,d);
269 erg += remove_part_part(a,d,c);
270 FREEALL(d);
271 CTO(PARTITION,"remove_part_integer(e3)",c);
272 ENDR("remove_part_integer");
273 }
274
remove_part_part(a,b,c)275 INT remove_part_part(a,b,c) OP a,b,c;
276 /* AK 070995 */
277 /* 23344 , 24 ->> 334 */
278 /* AK 2.0 090298 */
279 {
280 INT erg = OK;
281 INT i,j,k;
282 OP d;
283
284 CTO(PARTITION,"remove_part_part(1)",a);
285 CTO(PARTITION,"remove_part_part(2)",b);
286 CTO(EMPTY,"remove_part_part(3)",c);
287
288 if (S_PA_K(a) != S_PA_K(b))
289 {
290 erg += error("remove_part_part entered different kind of partitions");
291 goto endr_ende;
292 }
293 else if (S_PA_K(a) == VECTOR)
294 {
295 d = CALLOCOBJECT();
296 erg += m_il_nv(S_PA_LI(a),d);
297 for (i=0,j=0,k=0;i<S_PA_LI(a);i++)
298 {
299 aaa:
300 if (j==S_PA_LI(b))
301 {
302 M_I_I(S_PA_II(a,i), S_V_I(d,k));
303 k++;
304 }
305 else if (S_PA_II(a,i) == S_PA_II(b,j))
306 {
307 j++;
308 }
309 else if (S_PA_II(a,i) < S_PA_II(b,j))
310 {
311 M_I_I(S_PA_II(a,i), S_V_I(d,k));
312 k++;
313 }
314 else {
315 j++;
316 goto aaa;
317 }
318 }
319 erg += m_v_pa(d,c);
320 FREEALL(d);
321 }
322 else if (S_PA_K(a) == EXPONENT)
323 {
324 erg += b_ks_pa(EXPONENT,callocobject(),c);
325 erg += sub(S_PA_S(a), S_PA_S(b), S_PA_S(c));
326 for (i = 0; i<S_PA_LI(c); i++)
327 if (S_PA_II(c,i) < (INT)0)
328 M_I_I(0,S_PA_I(c,i));
329 }
330 else
331 {
332 erg += error("remove_part_part works only with EXPONENT, VECTOR storage method");
333 goto endr_ende;
334 }
335 C_O_K(S_PA_S(c),INTEGERVECTOR);
336 ENDR("remove_part_part");
337 }
338
append_apply_part(a,b)339 INT append_apply_part(a,b) OP a,b;
340 /* AK 060901 */
341 /* a := new partition from sorted parts */
342 {
343 INT erg = OK;
344 CTO(PARTITION,"append_apply_part(1)",a);
345 CTTO(INTEGER,PARTITION,"append_apply_part(2)",b);
346
347 if (a == b) { /* a := a+a */
348 if (S_PA_K(a) == VECTOR) {
349 erg += append_apply_vector(S_PA_S(a),S_PA_S(b));
350 erg += SYM_sort(S_PA_S(a));
351 goto endr_ende;
352 }
353 else if (S_PA_K(a) == EXPONENT) {
354 INT i;
355 for (i=0;i<S_PA_LI(a);i++)
356 M_I_I(S_PA_II(a,i)+S_PA_II(a,i), S_PA_I(a,i));
357 }
358 else {
359 erg += error("append_apply_part(a,a): only working for VECTOR or EXPONENT type partitions");
360 goto endr_ende;
361 }
362 }
363 else { /* a := a+b */
364 if (S_O_K(b) == INTEGER) {
365 SYMCHECK(S_I_I(b) < 0,"append_apply_part:arg 2 integer < 0");
366 if (S_I_I(b) == 0) goto ende;
367
368 if (S_PA_K(a) == VECTOR) {
369 INT i;
370 inc_vector_co(S_PA_S(a),1);
371 for (i=S_PA_LI(a)-2;i>=0;i--)
372 if( S_PA_II(a,i) > S_I_I(b) )
373 M_I_I(S_PA_II(a,i),S_PA_I(a,i+1));
374 else
375 {
376 M_I_I(S_I_I(b),S_PA_I(a,i+1));
377 goto ende;
378 }
379 M_I_I(S_I_I(b),S_PA_I(a,0));
380 goto ende;
381 }
382 else if (S_PA_K(a) == EXPONENT) {
383 if (S_PA_LI(a) >= S_I_I(b))
384 { INC_INTEGER(S_PA_I(a,S_I_I(b)-1)); }
385 else {
386 INT l;
387 l = S_PA_LI(a);
388 inc_vector_co(S_PA_S(a), S_I_I(b) - S_PA_LI(a) );
389 for (;l<S_PA_LI(a);l++) M_I_I(0,S_PA_I(a,l));
390 INC_INTEGER(S_PA_I(a,S_I_I(b)-1));
391 }
392 goto ende;
393 }
394 else {
395 erg += error("append_apply_part(a,INTEGER): only working for partitions of VECTOR,EXPONENT type");
396 goto endr_ende;
397 }
398 }
399 if (S_PA_K(a) != S_PA_K(b)) {
400 erg += error("append_apply_part(a,b): only working for partitions of equal type");
401 goto endr_ende;
402 }
403 if (S_PA_K(a) == VECTOR) {
404 INT i,j,k;
405 i=S_PA_LI(a)-1;
406 k=S_PA_LI(b)-1;
407 /*
408 erg += append_apply_vector(S_PA_S(a),S_PA_S(b));
409 erg += SYM_sort(S_PA_S(a));
410 */
411 inc_vector_co(S_PA_S(a),S_PA_LI(b));
412 for (j=S_PA_LI(a)-1;j>=0;j--)
413 if (k == -1) goto ende;
414 else if (i == -1) { M_I_I(S_PA_II(b,k), S_PA_I(a,j)); k--; }
415 else if (S_PA_II(b,k) > S_PA_II(a,i)) { M_I_I(S_PA_II(b,k), S_PA_I(a,j)); k--; }
416 else { M_I_I(S_PA_II(a,i), S_PA_I(a,j)); i--; }
417
418 goto ende;
419 }
420 else if (S_PA_K(a) == EXPONENT) {
421 INT i,l,ol;
422 l = (S_PA_LI(a) > S_PA_LI(b) ? S_PA_LI(a) : S_PA_LI(b) );
423 /* l is the maximum of lengths */
424 ol = S_PA_LI(a);
425 if (l > S_PA_LI(a))
426 erg += inc_vector_co(S_PA_S(a), l - S_PA_LI(a) );
427 for (i=0;i<l;i++)
428 if ( (l < ol) && (l <S_PA_LI(b) ))
429 M_I_I(S_PA_II(a,i)+S_PA_II(b,i), S_PA_I(a,i));
430 else if (l <S_PA_LI(b) )
431 M_I_I(S_PA_II(b,i),S_PA_I(a,i));
432 goto endr_ende;
433 }
434 else {
435 erg += error("append_apply_part(a,a): only working for VECTOR or EXPONENT type partitions");
436 goto endr_ende;
437 }
438 }
439 ende:
440 ENDR("append_apply_part");
441 }
append_part_part(a,b,c)442 INT append_part_part(a,b,c) OP a,b,c;
443 /* AK 090891 V1.3 */
444 /* join the parts to one partition */
445 /* e.g. 233, 1224 --> 1222334 */
446 /* AK 2.0 090298 */
447 {
448 OP d;
449 INT erg = OK;
450 CTO(PARTITION,"append_part_part(1)",a);
451
452 if (S_O_K(b) == INTEGER)
453 {
454 d = callocobject();
455 erg += first_partition(b,d);
456 erg += append_part_part(a,d,c);
457 erg += freeall(d);
458 goto endr_ende;
459 }
460 else if (S_O_K(b) == VECTOR)
461 {
462 erg += copy(b,c);
463 erg += inc(c);
464 erg += copy_partition(a,S_V_I(c,S_V_LI(c)-1));
465 goto endr_ende;
466 }
467 else if (S_O_K(b) == EMPTY)
468 {
469 erg += copy_partition(a,c);
470 goto endr_ende;
471 }
472 CTO(PARTITION,"append_part_part(2)",b);
473 if (S_PA_K(a) != S_PA_K(b))
474 {
475 erg += error("append_part_part: different kind of partitions");
476 }
477 else if (S_PA_K(a) == VECTOR)
478 {
479 /*
480 d = callocobject();
481 erg += append(S_PA_S(a),S_PA_S(b),d);
482 erg += m_v_pa(d,c);
483 erg += freeall(d);
484 */
485 /* the following is faster */
486 /* AK 260901 */
487 INT i,j,k;
488 B_KS_PA(VECTOR,CALLOCOBJECT(),c);
489 erg += m_il_v(S_PA_LI(a)+S_PA_LI(b),S_PA_S(c));
490 C_O_K(S_PA_S(c),INTEGERVECTOR); /* AK 011101 */
491 for (i=0,j=0,k=0;i<S_PA_LI(c);i++)
492 if (j==S_PA_LI(a))
493 { M_I_I(S_PA_II(b,k),S_PA_I(c,i)); k++; }
494 else if (k==S_PA_LI(b))
495 { M_I_I(S_PA_II(a,j),S_PA_I(c,i)); j++; }
496 else if (S_PA_II(a,j) < S_PA_II(b,k))
497 { M_I_I(S_PA_II(a,j),S_PA_I(c,i)); j++; }
498 else
499 { M_I_I(S_PA_II(b,k),S_PA_I(c,i)); k++; }
500 }
501 else if (S_PA_K(a) == EXPONENT)
502 {
503 B_KS_PA(EXPONENT,CALLOCOBJECT(),c);
504 erg += add_integervector(S_PA_S(a), S_PA_S(b), S_PA_S(c));
505 }
506 else {
507 erg += error("append_part_part works only for VECTOR,EXPONENT partitions");
508 }
509 ENDR("append_part_part");
510 }
511
512
add_partition(a,b,c)513 INT add_partition(a,b,c) OP a,b,c;
514 /* AK 060789 V1.0 */ /* AK 280590 V1.1 */ /* AK 200891 V1.3 */
515 /* AK 2.0 090298 */
516 {
517 INT erg = OK; /* AK 040292 */
518 CTO(PARTITION,"add_partition(1)",a);
519 CTO(EMPTY,"add_partition(3)",c);
520
521 switch(S_O_K(b))
522 {
523 case PARTITION :
524 erg += add_part_part(a,b,c);
525 break;
526
527 #ifdef SCHURTRUE
528 case SCHUR :
529 erg += m_pa_s(a,c);
530 erg += add_apply(b,c);
531 break;
532 #endif /* SCHURTRUE */
533
534 default :
535 erg += WTO("add_partition(2)",b);
536 }
537
538 ENDR("add_partition");
539 }
540
541
542
first_composition(w,parts,c)543 INT first_composition(w,parts,c) OP parts, w, c;
544 /* AK 090487 */ /* AK 201189 V1.1 */ /* AK 150591 V1.2 */ /* AK 200891 V1.3 */
545 /* AK 2.0 090298 */
546 /* parameter may be equal */
547 /* AK 170206 V3.0 */
548 {
549 INT i,erg=OK,wp,ww;
550 CTO(INTEGER,"first_composition",w);ww=S_I_I(w);
551 CTO(INTEGER,"first_composition",parts);wp=S_I_I(parts);
552 SYMCHECK(wp <= 0,"first_composition:number of parts <= 0");
553 SYMCHECK(ww <= 0,"first_composition:weight <= 0");
554 erg += m_il_nv(wp,c);
555 M_I_I(ww,S_V_I(c,0));
556 C_O_K(c,COMPOSITION);
557 ENDR("first_composition");
558 }
559
first_subset(n,k,c)560 INT first_subset(n,k,c) OP n,k,c;
561 /* AK 220997 */
562 /* AK V2.0 090298 */
563 /* AK V2.1 100902 */ /* AK 3.1 081106 */
564
565 /* computes the first k-element subset of a n-element set */
566 /* result is of type subset */
567 {
568 INT erg = OK;
569 CTO(INTEGER,"first_subset(1)",n);
570 CTO(INTEGER,"first_subset(2)",k);
571 SYMCHECK( S_I_I(n) <= 0, "first_subset:input variable n <= 0");
572 SYMCHECK( S_I_I(k) < 0, "first_subset:input variable k < 0");
573 SYMCHECK (S_I_I(k) > S_I_I(n) ,"first_subset:input variable k > n");
574 CE3(n,k,c,first_subset);
575 {
576 INT i;
577 erg += m_l_nv(n,c);
578 for (i=0;i<S_I_I(k); i++)
579 M_I_I(1,S_V_I(c,i));
580 C_O_K(c,SUBSET);
581 }
582 CTO(SUBSET,"first_subset(e3)",c);
583 ENDR("first_subset");
584 }
585
next_subset(c,d)586 INT next_subset(c,d) OP c,d;
587 /* AK 220997 */
588 /* AK 2.0 090298 */
589 {
590 INT i,m;
591 copy(c,d);
592 m=0;
593 for (i=S_V_LI(c)-1;i>=0;i--)
594 {
595 if (S_V_II(c,i) == 0) break;
596 else m++;
597 }
598 /* m ist die anzahl der gelesenen 1en bis zur 0 */
599 for (; i>=0 ;i--)
600 {
601 if (S_V_II(c,i) == 1) break;
602 }
603 if (i == -1) return LAST_SUBSET;
604 M_I_I(0, S_V_I(d,i));
605 M_I_I(1,S_V_I(d,i+1));
606
607 for (i=i+2; m>0 ; i++,m--)
608 M_I_I(1,S_V_I(d,i));
609 for (; i<S_V_LI(d); i++)
610 M_I_I(0,S_V_I(d,i));
611 return OK;
612 }
613
next_apply_subset(c)614 INT next_apply_subset(c) OP c;
615 /* AK 281097 */
616 /* AK V2.0 200298 */ /* AK 090107 V3. 1*/
617 {
618 INT i,m;
619 m=0;
620 for (i=S_V_LI(c)-1;i>=0;i--)
621 {
622 if (S_V_II(c,i) == 0) break;
623 else m++;
624 }
625 /* m ist die anzahl der gelesenen 1en bis zur 0 */
626 for (; i>=0 ;i--)
627 {
628 if (S_V_II(c,i) == 1) break;
629 }
630 if (i == -1) return LAST_SUBSET;
631 M_I_I(0, S_V_I(c,i));
632 M_I_I(1,S_V_I(c,i+1));
633
634 for (i=i+2; m>0 ; i++,m--)
635 M_I_I(1,S_V_I(c,i));
636 for (; i<S_V_LI(c); i++)
637 M_I_I(0,S_V_I(c,i));
638 return OK;
639 }
640
641
next_composition(c,newcomp)642 INT next_composition(c,newcomp) OP c, newcomp;
643 /* AK V2.0 100298 */
644 {
645 INT erg = OK;
646 CTO(COMPOSITION,"next_composition(1)",c);
647 copy_composition(c,newcomp);
648 return next_apply_composition(newcomp);
649 ENDR("next_composition");
650 }
651
next_apply_composition(newcomp)652 INT next_apply_composition(newcomp) OP newcomp;
653 /* AK 300889 */ /* AK 201189 V1.1 */ /* AK 200891 V1.3 */
654 /* AK V2.0 100298 */
655 {
656 INT i,j,rest;
657 for (i=S_V_LI(newcomp)-2L,j=i+1,rest=(INT)0; i>=(INT)0; i--,j--)
658 if (S_V_II(newcomp,i) == (INT)0)
659 {
660 rest += S_V_II(newcomp,j);
661 C_I_I(S_V_I(newcomp,j),(INT)0);
662 }
663 else if (S_V_II(newcomp,i) > (INT)0)
664 {
665 DEC_INTEGER(S_V_I(newcomp,i));
666 C_I_I(S_V_I(newcomp,j),S_V_II(newcomp,j)+1+rest);
667 return(OK);
668 };
669 return(LASTCOMP);
670 }
671
672
is_selfconjugate(part)673 INT is_selfconjugate(part) OP part;
674 /* AK 180703 */
675 {
676 INT erg = OK,res;
677 OP c;
678 CTO(PARTITION,"is_selfconjugate(1)",part);
679
680 c = CALLOCOBJECT();
681 conjugate_partition(part,c);
682 res = EQ(c,part);
683 FREEALL(c);
684 return res;
685 ENDR("is_selfconjugate");
686 }
687
conjugate_partition(part,b)688 INT conjugate_partition(part,b) OP part, b;
689 /* AK 220587 */
690 /* AK 060789 V1.0 */ /* AK 240490 V1.1 */ /* AK 200891 V1.3 */
691 /* AK 200298 V2.0 */
692 {
693 INT i,j,k=(INT)0,m;
694 /* k ist die adresse an der geschrieben wird im b */
695 INT erg = OK;
696
697 CTO(PARTITION,"conjugate_partition",part);
698 CE2(part,b,conjugate_partition);
699
700 if (S_PA_K(part) == EXPONENT) /* AK 170692 */
701 {
702 OP c = callocobject();
703 erg += t_EXPONENT_VECTOR(part,c);
704 erg += conjugate_partition(c,b);
705 erg += freeall(c);
706 erg += t_VECTOR_EXPONENT(b,b);
707 goto endr_ende;
708 }
709 else if (S_PA_K(part) == BITVECTOR) /* AK 090703 */
710 {
711 COPY(part,b);
712 erg += reverse_bitvector(S_PA_S(b),S_PA_S(b));
713 erg += invers_bitvector(S_PA_S(b),S_PA_S(b));
714 goto endr_ende;
715 }
716 else if (S_PA_K(part) == FROBENIUS)
717 {
718 B_KS_PA(FROBENIUS,callocobject(),b);
719 erg += m_il_v((INT)2,S_PA_S(b));
720 erg += copy_integervector(S_V_I(S_PA_S(part),0),
721 S_V_I(S_PA_S(b),1) );
722 erg += copy_integervector(S_V_I(S_PA_S(part),1),
723 S_V_I(S_PA_S(b),0) );
724 goto endr_ende;
725 }
726 else if (S_PA_K(part) != VECTOR)
727 {
728 erg += error("conjugate_partition: works only for VECTOR,EXPONENT,FROBENIUS type");
729 goto endr_ende;
730 }
731
732 if (S_PA_LI(part) == (INT)0)
733 {
734 erg += copy_partition(part,b);
735 goto endr_ende;
736 }
737 erg += m_il_pa(S_PA_II(part,S_PA_LI(part)-1),b);
738
739 j = S_PA_LI(part) - 1;
740 /* dies sind die adressen in den beiden partitionen */
741 m = S_PA_LI(b)+S_PA_LI(part)+1;
742 /* dies ist die laenge der permutation + 1 */
743 for( i=m-1; i > (INT)0 ; i--)
744 {
745 if (j>=0)
746 if (i == S_PA_II(part,j)+j+1 ) j-- ;
747 else {
748 M_I_I(m-i- k - 1,S_PA_I(b,k));
749 k++ ;
750 }
751 else {
752 M_I_I(m-i- k - 1,S_PA_I(b,k));
753 k++ ;
754 }
755 }
756 ENDR("conjugate_partition");
757 }
758
759
760
ferrers_partition(part)761 INT ferrers_partition(part) OP part;
762 /* AK 060789 V1.0 */ /* AK 150690 V1.1 */ /* AK 200891 V1.3 */
763 /* AK 240298 V2.0 */
764 {
765 INT i,j;
766 INT erg = OK;
767 OP z;
768 CTO(PARTITION,"ferrers_partition",part);
769 if (S_PA_K(part) == EXPONENT)
770 {
771 z = callocobject();
772 erg += t_EXPONENT_VECTOR(part,z);
773 erg += ferrers_partition(z);
774 erg += freeall(z);
775 goto endr_ende;
776 }
777 PART_CHECK_KIND("ferrers_partition",part,VECTOR);
778
779 printf("\n");
780 for (i=(INT)0; i<S_PA_LI(part);i++)
781 {
782 for (j=(INT)0;j<S_PA_II(part,i);j++) printf("**** ");
783 printf("\n");
784 for (j=(INT)0;j<S_PA_II(part,i);j++) printf("**** ");
785 printf("\n\n");
786 };
787 zeilenposition = (INT)0;
788 ENDR("ferrers_partition");
789 }
790
791
792
fprint_partition(f,partobj)793 INT fprint_partition(f,partobj) FILE *f; OP partobj;
794 /* AK 140587 */ /* AK 060789 V1.0 */ /* AK 290890 V1.1 */ /* AK 200891 V1.3 */
795 /* AK V2.0 200298 */
796 {
797 INT i;
798 INT erg = OK;
799 if (S_PA_K(partobj) == FROBENIUS) /* AK 101292 */
800 {
801 fprint(f,S_PA_S(partobj));
802 goto endr_ende;
803 }
804 else if (S_PA_K(partobj) == BITVECTOR)
805 {
806 fprint(f,S_PA_S(partobj));
807 goto endr_ende;
808 }
809 else if (S_PA_LI(partobj) == (INT)0)
810 {
811 fprintf(f,"[]");
812 if (f == stdout) zeilenposition+=2;
813 goto endr_ende;
814 }
815
816 for( i = (INT)0; i<S_PA_LI(partobj); i++)
817 if (S_PA_II(partobj,i)<10)
818 /*AK partitionsteile kleiner 10 werden als Zahlen geschrieben */
819 {
820 fprintf(f,"%ld",S_PA_II(partobj,i));
821 if (f == stdout) zeilenposition++;
822 }
823 else if (S_PA_II(partobj,i)<16)
824 /* A.K. partitionsteile von 10 bis 15 werden als
825 A,B,C,D,E,F geschrieben */
826 {
827 fprintf(f,"%c",(int)S_PA_II(partobj,i)+55);
828 if (f == stdout) zeilenposition++;
829 }
830 else {
831 /* A.K. sonst werden die Teile als zahl mit
832 abschliessenden senkrechten Strich geschrieben */
833 fprintf(f,"%c%ld",'|',S_PA_II(partobj,i));
834 if(f==stdout)
835 zeilenposition+=(1+intlog(S_PA_I(partobj,i)));
836 };
837 if ((f == stdout)&&(zeilenposition>row_length))
838 {
839 fprintf(f,"\n");
840 zeilenposition = (INT)0;
841 }
842 ENDR("fprint_partition");
843 }
844
sprint_partition(f,partobj)845 INT sprint_partition(f,partobj) char *f; OP partobj;
846 /* AK V2.0 200298 */
847 {
848 INT i;
849 INT erg = OK;
850 CTO(PARTITION,"sprint_partition",partobj);
851 if (S_PA_K(partobj) == FROBENIUS) /* AK 101292 */
852 {
853 erg += sprint(f,S_PA_S(partobj));
854 goto endr_ende;
855 }
856 else if (S_PA_K(partobj) == BITVECTOR)
857 {
858 erg+= sprint(f,S_PA_S(partobj));
859 goto endr_ende;
860 }
861
862 f[0]='\0'; /* AK 151298 to handle zero partition */
863 for( i = (INT)0; i<S_PA_LI(partobj); i++)
864 if (S_PA_II(partobj,i)<10)
865 /*AK partitionsteile kleiner 10 werden als Zahlen geschrieben */
866 {
867 sprintf(f,"%ld",S_PA_II(partobj,i));
868 f++;
869 }
870 else if (S_PA_II(partobj,i)<16)
871 /* A.K. partitionsteile von 10 bis 15 werden als
872 A,B,C,D,E,F geschrieben */
873 {
874 sprintf(f,"%c",(int)S_PA_II(partobj,i)+55);
875 f++;
876 }
877 else {
878 /* A.K. sonst werden die Teile als zahl mit
879 abschliessenden senkrechten Strich geschrieben */
880 sprintf(f,"%c%ld",'|',S_PA_II(partobj,i));
881 f+=(1+intlog(S_PA_I(partobj,i)));
882 };
883 ENDR("sprint_partition");
884 }
885
886
887
888
gupta_nm(n,m,res)889 INT gupta_nm(n,m,res) OP n,m,res;
890 /* AK 220888
891 vgl. Hansraj Gupta Proc London Math Soc 2 (39)
892 1935 142-149 dort werden die Anzahlen der Partitionen von n
893 bis n=300 aufgelistet. Zur Berechnung mittels einer
894 Rekurssion werden die Zahlen (n,m) = Anzahl der Partitionen
895 von n mit dem kleinsten Teil = m benoetigt
896 Diese werden rekursiv berechnet, diese Zahlen
897 werden auch von dieser Prozedur berechnet
898 */
899 /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 200891 V1.3 */
900 /* AK V2.0 200298 */
901 {
902 OP i,j,zw;
903 INT erg = OK;
904
905
906 CTO(INTEGER,"gupta_nm",n);
907 CTO(INTEGER,"gupta_nm",m);
908 CE3(n,m,res,gupta_nm);
909
910 if (S_I_I(n) == S_I_I(m))
911 {
912 erg += m_i_i(1,res);
913 }
914 else if (S_I_I(m) > S_I_I(n)/2L)
915 {
916 erg += m_i_i((INT)0,res);
917 }
918 else {
919 i = callocobject();
920 j = callocobject();
921 zw = callocobject();
922 /* initialisieren i = n-m, j = m, res = 0 */
923 M_I_I(S_I_I(n)-S_I_I(m),i);
924 COPY_INTEGER(m,j);
925 erg += m_i_i((INT)0,res);
926
927 while(S_I_I(j) <= S_I_I(i) )
928 {
929 erg += gupta_nm(i,j,zw);
930 if (S_O_K(zw) != INTEGER) add_apply(zw,res);
931 else if (not NULLP_INTEGER(zw)) add_apply(zw,res);
932 /* nicht aufrufen falls 0 */
933 INC_INTEGER(j);
934 }
935
936 erg += freeall(zw);
937 erg += freeall(i);
938 erg += freeall(j);
939 }
940 ENDR("gupta_nm");
941 }
942
943 #ifdef MATRIXTRUE
gupta_tafel(mx,mat)944 INT gupta_tafel(mx,mat) OP mx,mat;
945 /* AK 220888 */
946 /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 200891 V1.3 */
947 /* AK 200298 V2.0 */
948 /* mx and mat may be equal */
949 {
950 INT erg = OK;
951 CTO(INTEGER,"gupta_tafel(1)",mx);
952 {
953
954
955 INT i,j,k;
956 OP h,l;
957 h = callocobject();
958 l = callocobject();
959
960 M_I_I(S_I_I(mx),h);
961 M_I_I((S_I_I(mx) / 2L)+1,l);
962
963 erg += b_lh_nm(l,h,mat);
964
965 for (i=0; i< S_I_I(mx); i++)
966 for (j=0;j<=i/2L;j++)
967 {
968 for (k=(INT)0; j+k < (i-j)/2L ; k++)
969 /* die rekursion */
970 ADD_APPLY(S_M_IJ(mat,i-j-1,j+k),S_M_IJ(mat,i,j));
971 INC(S_M_IJ(mat,i,j));
972 };
973 }
974 ENDR("gupta_tafel");
975 }
976
gupta_nm_speicher(n,m,res)977 INT gupta_nm_speicher(n,m,res) OP n,m,res;
978 /* AK 120390 V1.1 */ /* AK 200891 V1.3 */
979 /* AK 200298 V2.0 */
980 /* n,m,res may be equal */
981 {
982 OP mat;
983 INT erg = OK;
984 CTO(INTEGER,"gupta_nm_speicher",n);
985 CTO(INTEGER,"gupta_nm_speicher",m);
986 if (S_I_I(n) <= 0)
987 {
988 erg += error("gupta_nm_speicher;input <= 0");
989 goto endr_ende;
990 }
991
992 if (S_I_I(n) == S_I_I(m))
993 {
994 M_I_I(1,res);
995 goto endr_ende;
996 }
997 if (S_I_I(m) > S_I_I(n)/2L)
998 {
999 M_I_I(0,res);
1000 goto endr_ende;
1001 }
1002
1003 mat = callocobject();
1004 erg += gupta_tafel(n,mat);
1005 erg += copy(S_M_IJ(mat,S_I_I(n)-1,S_I_I(m)-1),res);
1006 erg += freeall(mat);
1007 ENDR("gupta_nm_speicher");
1008 }
1009
1010 #endif /* MATRIXTRUE */
1011
1012
1013
hook_length_augpart(p,i,j,res)1014 INT hook_length_augpart(p,i,j,res) OP p,res; INT i,j;
1015 /* AK 060988 hakenlaenge */
1016 /* AK 060789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
1017 /* AK V2.0 200298 */
1018 /* p and res may be equal */
1019 {
1020 INT e,k;
1021 INT erg = OK;
1022 OP z;
1023 CTO(AUG_PART,"hook_length_augpart(1)",p);
1024 FREESELF(res);
1025
1026 if (i >= S_PA_LI(p))
1027 {
1028 M_I_I(0,res);
1029 goto ende;
1030 }
1031 z = S_PA_I(p,i);
1032 if (j >= S_I_I(z)-i)
1033 {
1034 M_I_I(0,res);
1035 goto ende;
1036 }
1037 else {
1038 e = S_I_I(z) - j - i;
1039 /* nun noch die zeilen dazu */
1040 for (z--,k=i-1; k>= 0; k--,z--)
1041 if (S_I_I(z) -1 -k >= j)
1042 e++;
1043 else break;
1044 M_I_I(e,res);
1045 goto ende;
1046 }
1047 ende:
1048 CTO(INTEGER,"hook_length_augpart(e4)",res);
1049 ENDR("hook_length_augpart");
1050 }
1051
1052
1053
hook_diagramm(p,m)1054 INT hook_diagramm(p,m) OP p,m;
1055 /* AK 010295 */
1056 /* AK V2.0 100298 */
1057 /* input: PARTITION object
1058 output: MATRIX object with hooklength */
1059 {
1060 INT erg = OK, i,j;
1061
1062 PART_CHECK_KIND("hook_diagramm(1)",p, VECTOR);
1063 CE2(p,m,hook_diagramm);
1064
1065 erg += m_ilih_m(S_PA_II(p,S_PA_LI(p)-1), S_PA_LI(p), m);
1066 for (i=0;i<S_M_HI(m);i++)
1067 for (j=0;j<S_M_LI(m);j++)
1068 erg += hook_length(p,i,j,S_M_IJ(m,i,j));
1069 CTO(MATRIX,"hook_diagramm(2e)",m);
1070 ENDR("hook_diagramm");
1071 }
1072
hook_length(p,i,j,b)1073 INT hook_length(p,i,j,b) OP p,b; INT i,j;
1074 /* AK 060988 hakenlaenge */
1075 /* AK 060789 V1.0 */ /* AK 150690 V1.1 */ /* AK 200891 V1.3 */
1076 /* AK V2.0 100298 */
1077 {
1078 INT e,k;
1079 INT erg = OK;
1080 CTO(PARTITION,"hook_length(1)",p);
1081
1082 if (S_PA_K(p) == EXPONENT) /* AK 170692 */
1083 {
1084 OP c = callocobject();
1085 e = t_EXPONENT_VECTOR(p,c);
1086 e += hook_length(c,i,j,b);
1087 e += freeall(c);
1088 return e;
1089 }
1090
1091 SYMCHECK( S_PA_K(p) != VECTOR,"hook_length:only for vector or exponent type");
1092
1093 FREESELF(b);
1094
1095 if (i >= S_PA_LI(p))
1096 { M_I_I(0,b); goto ende; }
1097 if (j >= S_PA_II(p,S_PA_LI(p)-1-i))
1098 { M_I_I(0,b); goto ende; }
1099 e = S_PA_II(p,S_PA_LI(p)-1-i) - j;
1100 /* nun noch die zeilen dazu */
1101 for (k=i+1; k<S_PA_LI(p); k++)
1102 if (S_PA_II(p,S_PA_LI(p)-1-k) -1 >= j) e++;
1103 else break;
1104 M_I_I(e,b);
1105 ende:
1106 ENDR("hook_length");
1107 }
1108
1109
1110
dimension_partition(a,b)1111 INT dimension_partition(a,b) OP a,b;
1112 /* AK 150988 */
1113 /* AK 060789 V1.0 */ /* AK 080290 V1.1 */ /* AK 050391 V1.2 */
1114 /* AK 200891 V1.3 */
1115 /* AK 200298 V2.0 */
1116 /* input: PARTITION object
1117 ouput: dimension of corresponding irreducible Sn character
1118 INTEGER object or LONGINT object */
1119 /* a and b may be equal */
1120 {
1121 OP zaehler, nenner, zw;
1122 INT i,j;
1123 INT erg = OK;
1124
1125 CTO(PARTITION,"dimension_partition(1)",a);
1126
1127 if (S_PA_K(a) == EXPONENT) /* AK 170692 */
1128 {
1129 zw = callocobject();
1130 erg += t_EXPONENT_VECTOR(a,zw);
1131 erg += dimension_partition(zw,b);
1132 erg += freeall(zw);
1133 }
1134 else if (S_PA_K(a) != VECTOR)
1135 {
1136 error("dimension_partition: wrong kind of partition");
1137 erg = ERROR;
1138 }
1139 else {
1140 zw = callocobject();
1141 zaehler = callocobject();
1142 erg = weight(a,zw);
1143
1144 erg += fakul(zw,zaehler);
1145 FREESELF(zw);
1146 NEW_INTEGER(nenner,1);
1147 for (i=(INT)0;i<S_PA_LI(a);i++)
1148 for (j=(INT)0;j<S_PA_II(a,S_PA_LI(a)-1-i);j++)
1149 {
1150 erg += hook_length(a,i,j,zw);
1151 MULT_APPLY(zw,nenner);
1152 };
1153 FREEALL(zw);
1154 FREESELF(b);
1155 GANZDIV(zaehler,nenner,b);
1156 FREEALL(zaehler);
1157 FREEALL(nenner);
1158 }
1159 ENDR("dimension_partition");
1160 }
1161
1162
1163
dimension_augpart(a,b)1164 INT dimension_augpart(a,b) OP a,b;
1165 /* a ist an object of type AUGPART
1166 b becomes the dimension of the corresponding irred representation */
1167 /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 250291 V1.2 */
1168 /* AK 200891 V1.3 */
1169 /* AK V2.0 200298 */
1170 {
1171 OP nenner;
1172 OP zw;
1173
1174 INT i,j,erg = OK;
1175 CTO(AUG_PART,"dimension_augpart(1)",a);
1176
1177 FREESELF(b);
1178
1179 if (S_PA_LI(a) == 1)
1180 { M_I_I(1,b); goto ende; }
1181 if (S_PA_II(a,S_PA_LI(a)-1) == S_PA_LI(a)) /* 1^n */
1182 { M_I_I(1,b); goto ende; }
1183 if (S_PA_II(a,S_PA_LI(a)-2L) == S_PA_LI(a)-2L) /* n */
1184 { M_I_I(1,b); goto ende; }
1185
1186 if (S_PA_LI(a)==2)
1187 {
1188 if (S_PA_II(a,0)==1)
1189 { M_I_I(S_PA_II(a,1)-1,b); goto ende; }
1190 }
1191
1192
1193 nenner = CALLOCOBJECT();
1194 zw = CALLOCOBJECT();
1195
1196
1197 erg += weight_augpart(a,zw);
1198
1199 erg += fakul(zw,b);
1200
1201 FREESELF(zw);
1202 M_I_I(1,nenner);
1203 for (i=(INT)0;i<S_PA_LI(a);i++)
1204 for (j=(INT)0;j<S_PA_II(a,i)-i;j++)
1205 {
1206 erg += hook_length_augpart(a,i,j,zw);
1207 if (S_I_I(zw) != 1)
1208 MULT_APPLY_INTEGER(zw,nenner);
1209 };
1210
1211 FREEALL(zw);
1212 GANZDIV_APPLY(b,nenner);
1213 FREEALL(nenner);
1214 ende:
1215 ENDR("dimension_augpart");
1216 }
1217
1218
1219
last_part_EXPONENT(n,part)1220 INT last_part_EXPONENT(n,part) OP n,part;
1221 /* AK 150888 */ /* AK 060789 V1.0 */ /* AK 281189 V1.1 */
1222 /* AK 200891 V1.3 */
1223 /* AK 120298 V2.0 */
1224 /* input: INTEGER object
1225 output: last PARTITION object of EXPONENT kind */
1226 {
1227 INT erg = OK;
1228 CTO(INTEGER,"last_part_EXPONENT",n);
1229 if (S_I_I(n) < (INT)0)
1230 {
1231 erg += error("last_part_EXPONENT:input < 0");
1232 goto endr_ende;
1233 }
1234
1235 B_KS_PA(EXPONENT,CALLOCOBJECT(),part);
1236 erg += m_il_nv(S_I_I(n),S_PA_S(part));
1237 C_O_K(S_PA_S(part),INTEGERVECTOR);
1238
1239 if (S_I_I(n) > (INT)0)
1240 M_I_I(S_PA_LI(part), S_PA_I(part,(INT)0));
1241 ENDR("last_part_EXPONENT");
1242 }
1243
1244
1245
first_part_VECTOR(n,part)1246 INT first_part_VECTOR(n,part) OP n,part;
1247 /* AK 200891 V1.3 */
1248 /* AK V2.0 200298 */
1249 {
1250 return first_partition(n,part);
1251 }
1252
1253
last_part_VECTOR(n,part)1254 INT last_part_VECTOR(n,part) OP n,part;
1255 /* AK 200891 V1.3 */
1256 /* AK V2.0 200298 */
1257 {
1258 return last_partition(n,part);
1259 }
1260
1261
1262
first_part_EXPONENT(n,part)1263 INT first_part_EXPONENT(n,part) OP n,part;
1264 /* AK 170298 V2.0 */
1265 /* input: n = INTEGER object >= 0
1266 output: PARTITION-EXPONENT object 00000...00001
1267 of given weight n */
1268 /* n and part may be equal */
1269 {
1270 INT i;
1271 INT erg = OK;
1272 CTO(INTEGER,"first_part_EXPONENT",n);
1273
1274 i = S_I_I(n);
1275 SYMCHECK((i < 0) ,"first_part_EXPONENT:input < 0");
1276
1277 B_KS_PA(EXPONENT,callocobject(),part);
1278 erg += m_il_nv(i,S_PA_S(part));
1279
1280 if (i > 0)
1281 M_I_I(1, S_PA_I(part,S_PA_LI(part)-1));
1282 C_O_K(S_PA_S(part), INTEGERVECTOR);
1283 ENDR("first_part_EXPONENT");
1284 }
1285
1286
1287
last_partition(n,part)1288 INT last_partition(n,part) OP n,part;
1289 /* AK 190587 */
1290 /* die prozedur erzeugt aus der Zahl n die Partition
1291 [1^n], die letzte Partition bezueglich nextpartition
1292 bzgl. Dominanzordnung und auch lexikographisch */
1293 /* n wird nicht verwendet */
1294 /* AK 060789 V1.0 */ /* AK 300590 V1.1 */ /* AK 200891 V1.3 */
1295 /* AK V2.0 200298 */
1296 {
1297 INT i;
1298 INT erg = OK; /* AK 020692 */
1299
1300 CTO(INTEGER,"last_partition",n);
1301 SYMCHECK((S_I_I(n) < 0) ,"last_partition:input < 0");
1302
1303 CE2(n,part,last_partition);
1304
1305 B_KS_PA(VECTOR,CALLOCOBJECT(),part);
1306 erg += m_l_v(n,S_PA_S(part));
1307 for (i=0;i<S_I_I(n);i++)
1308 M_I_I(1,S_PA_I(part,i));
1309 C_O_K(S_PA_S(part), INTEGERVECTOR);
1310 ENDR("last_partition");
1311 }
1312
1313
1314
first_partition(n,part)1315 INT first_partition(n,part) OP n,part;
1316 /* AK 190587 */ /* AK 060789 V1.0 */ /* AK 261190 V1.1 */ /* AK 200891 V1.3 */
1317 /* AK 230298 V2.0 */
1318 /* input: INTEGER object n
1319 output: PARTITION [n] */
1320 /* n and part may be equal objects */
1321 {
1322 INT erg = OK;
1323 COP("first_partition",part);
1324 CTO(INTEGER,"first_partition",n);
1325
1326 if (S_I_I(n) < (INT)0) /* AK 020692 */
1327 {
1328 fprintf(stderr,"input = %ld\n",S_I_I(n));
1329 erg += error("first_partition:input < 0");
1330 }
1331 else if (S_I_I(n) == (INT)0) /* AK 020692 */
1332 {
1333 B_KS_PA(VECTOR,CALLOCOBJECT(),part);
1334 erg += m_il_v((INT)0,S_PA_S(part));
1335 C_O_K(S_PA_S(part), INTEGERVECTOR);
1336 }
1337 else
1338 erg += m_i_pa(n,part); /* AK 020692 */
1339 ENDR("first_partition");
1340 }
1341
1342
1343
next_partition(part,next)1344 INT next_partition(part,next) OP part,next;
1345 /* AK 060789 V1.0 */ /* AK 300590 V1.1 */ /* AK 200891 V1.3 */
1346 /* AK V2.0 200298 */
1347 /* the order of transversal of the set of all partitions
1348 is equal if we use VECTOR or EXPONENT */
1349 {
1350 INT erg = OK;
1351 switch(S_PA_K(part))
1352 {
1353 case EXPONENT:
1354 erg = next_part_EXPONENT(part,next);
1355 break;
1356 case VECTOR:
1357 erg = next_part_VECTOR(part,next);
1358 break;
1359 default:
1360 erg = error("next_partition:wrong type of partition");
1361 goto endr_ende;
1362 };
1363 return erg;
1364 ENDR("next_partition");
1365 }
1366
next_part_VECTOR_apply(part)1367 INT next_part_VECTOR_apply(part) OP part;
1368 /* AK 211100 */
1369 {
1370 INT erg=OK;
1371 INT res;
1372 /* NYI */
1373 OP c;
1374 CTO(PARTITION,"next_part_VECTOR_apply(1)",part);
1375 c = CALLOCOBJECT();
1376 SWAP(c,part);
1377 res = next_part_VECTOR(c,part);
1378 if (res == LASTPARTITION) { SWAP(c,part); } /* AK 211201 */
1379 CTO(PARTITION,"next_part_VECTOR_apply(e1)",part);
1380 FREEALL(c);
1381 return res;
1382 ENDR("next_part_VECTOR_apply");
1383 }
1384
next_partition_apply(part)1385 INT next_partition_apply(part) OP part;
1386 /* compability */
1387 {
1388 return next_apply_partition(part);
1389 }
1390
next_apply_partition(part)1391 INT next_apply_partition(part) OP part;
1392 /* AK V2.0 211100 */
1393 {
1394 INT erg = OK;
1395 CTO(PARTITION,"next_apply_partition(1)",part);
1396
1397 switch(S_PA_K(part))
1398 {
1399 case EXPONENT:
1400 erg = next_part_EXPONENT_apply(part);
1401 break;
1402 case VECTOR:
1403 erg = next_part_VECTOR_apply(part);
1404 break;
1405 default:
1406 erg = error("next_apply_partition:wrong type of partition");
1407 goto endr_ende;
1408 };
1409 return erg;
1410 ENDR("next_apply_partition");
1411 }
1412
1413
1414
next_part_VECTOR(part,next)1415 INT next_part_VECTOR(part,next) OP part, next;
1416 /* AK 091086 */ /* Nijenhuis ch. 9 */
1417 /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 200891 V1.3 */
1418 /* AK V2.0 200298 */
1419 {
1420 OP length;
1421 INT i,j,m,o;
1422 INT n,k;
1423 INT erg = OK;
1424 INT res;
1425 CTO(PARTITION,"next_part_VECTOR(1)",part);
1426
1427 if (S_PA_LI(part) < (INT)1)
1428 {
1429 res = LASTPARTITION;
1430 goto ende;
1431 }
1432 if (S_PA_II(part,(INT)0) > 1)
1433 /* bsp: 2345 --> 11345 */
1434 {
1435 NEW_INTEGER(length,S_PA_LI(part)+1);
1436 B_KL_PA(VECTOR,length,next);
1437 M_I_I(1,S_PA_I(next,(INT)0));
1438 M_I_I(S_PA_II(part,(INT)0)-1,S_PA_I(next,1));
1439 for (i=2L;i<S_I_I(length);i++)
1440 M_I_I(S_PA_II(part,(i-1)),S_PA_I(next,i));
1441 res = OK;
1442 goto ende;
1443 };
1444 for (i=(INT)0;i<S_PA_LI(part);i++)
1445 if (S_PA_II(part,i) > 1) break;
1446
1447 if (i == S_PA_LI(part)) {
1448 res = LASTPARTITION;
1449 goto ende;
1450 }
1451
1452
1453 k = S_PA_LI(part) -i; /* restlaenge */
1454 m = S_PA_II(part,i);
1455 n = m - 1 ; /* neuer wert in next */
1456 j = (i + m) / n;
1457 o =(i + m) % n ;
1458
1459 if (o == (INT)0) j--;
1460 length = CALLOCOBJECT();
1461 M_I_I( j+k, length);
1462
1463 B_KL_PA(VECTOR,length,next);
1464 if (o != (INT)0)
1465 {
1466 M_I_I(o ,S_PA_I(next,(INT)0));
1467 o=1;
1468 };
1469
1470 for (m=o;m<=j;m++) M_I_I(n, S_PA_I(next,m));
1471
1472 for (;m<S_I_I(length);m++,i++)
1473 M_I_I(S_PA_II(part,i+1),S_PA_I(next,m));
1474 res = OK;
1475 ende:
1476 return res;
1477 ENDR("next_part_VECTOR");
1478 }
1479
next_part_EXPONENT(part,next)1480 INT next_part_EXPONENT(part,next) OP part,next;
1481 /* AK 150888 */ /* AK 060789 V1.0 */ /* AK 121190 V1.1 */ /* AK 200891 V1.3 */
1482 /* AK V2.0 200298 */
1483 {
1484 INT l = S_PA_LI(part);
1485 INT i,index=(INT)0,k;
1486 INT summe;
1487 INT value;
1488 INT erg =OK;
1489 if (l == (INT)0)
1490 return(LASTPARTITION);
1491
1492 if (S_PA_II(part,(INT)0) == l)
1493 return(LASTPARTITION);
1494 /* part = n 0 0 0 0 0 0 ... */
1495
1496 B_KS_PA(EXPONENT,CALLOCOBJECT(),next);
1497 m_il_v(l--,S_PA_S(next));
1498 C_O_K(S_PA_S(next),INTEGERVECTOR);
1499
1500 M_I_I(0,S_PA_I(next,(INT)0));
1501 for (i=1;i<=l;i++)
1502 {
1503 k = S_PA_II(part,i);
1504 M_I_I(k,S_PA_I(next,i));
1505 if (k>(INT)0) {
1506 index=i++;
1507 break;
1508 };
1509 }
1510 memcpy( (char *)S_PA_I(next,i),
1511 (char *)S_PA_I(part,i),
1512 (int) (l-i+1)*sizeof(struct object) );
1513
1514 summe = S_PA_II(part,(INT)0);
1515
1516 /* an der stelle index wird der index um eins decrementiert */
1517 summe = summe + index + 1;
1518 M_I_I(S_PA_II(part,index)-1, S_PA_I(next,index));
1519 /* nun nach rechts wieder aufbauen */
1520 for (i=index-1;i>=(INT)0;i--)
1521 {
1522 value = summe / (i+1);
1523 M_I_I(value,S_PA_I(next,i));
1524 summe = summe % (i+1);
1525
1526 if (summe == (INT)0) break;
1527 i = summe;
1528 }
1529 ENDR("next_part_EXPONENT");
1530 }
1531
next_part_EXPONENT_apply(part)1532 INT next_part_EXPONENT_apply(part) OP part;
1533 /* AK V2.0 211100 */
1534 {
1535 INT l = S_PA_LI(part);
1536 INT i,index=(INT)0,k;
1537 INT summe;
1538 INT value;
1539 if (l == (INT)0)
1540 return(LASTPARTITION);
1541
1542 if (S_PA_II(part,(INT)0) == l)
1543 return(LASTPARTITION);
1544 /* part = n 0 0 0 0 0 0 ... */
1545
1546 for (i=1;i<=l;i++)
1547 {
1548 k = S_PA_II(part,i);
1549 if (k>(INT)0) {
1550 index=i++;
1551 break;
1552 };
1553 }
1554
1555 summe = S_PA_II(part,(INT)0);
1556 M_I_I(0,S_PA_I(part,(INT)0));
1557
1558 /* an der stelle index wird der index um eins decrementiert */
1559 summe = summe + index + 1;
1560 M_I_I(S_PA_II(part,index)-1, S_PA_I(part,index));
1561 /* nun nach rechts wieder aufbauen */
1562 for (i=index-1;i>=(INT)0;i--)
1563 {
1564 value = summe / (i+1);
1565 M_I_I(value,S_PA_I(part,i));
1566 summe = summe % (i+1);
1567
1568 if (summe == (INT)0) break;
1569 i = summe;
1570 }
1571 return(OK);
1572 }
1573
1574
1575
numberofpart_i(n)1576 INT numberofpart_i(n) OP n;
1577 /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 200891 V1.3 */
1578 /* AK V2.0 200298 */
1579 /* return the number of partitions
1580 as an INT */
1581 {
1582 OP zw;
1583 INT i;
1584 INT erg = OK;
1585
1586 CTO(INTEGER,"numberofpart_i(1)",n);
1587 SYMCHECK(S_I_I(n) < 0,"numberofpart_i: parameter < 0");
1588
1589 zw=CALLOCOBJECT();
1590 erg += numberofpart(n,zw);
1591 SYMCHECK(S_O_K(zw)!=INTEGER,"numberofpart_i:result too big");
1592 i=S_I_I(zw);
1593 FREEALL(zw);
1594 return(i);
1595
1596 ENDR("numberofpart_i");
1597 }
1598
1599
numberofselfconjugatepart(a,c)1600 INT numberofselfconjugatepart(a,c) OP a,c;
1601 /* AK 231202 */
1602 /* computes the number of self conjugate partitions
1603 using the fact that his number is equal to the number of partitions with
1604 distinct odd parts
1605 */
1606 /* using generating function */
1607 {
1608 INT erg =OK,ai;
1609 CTO(INTEGER,"numberofselfconjugatepart(1)",a);
1610 ai = S_I_I(a);
1611 if (ai <0) erg += m_i_i(0,c);
1612 else if (ai <= 1) erg += m_i_i(1,c);
1613 else if (ai == 2) erg += m_i_i(0,c);
1614 else {
1615 OP v = CALLOCOBJECT();
1616 INT i,j;
1617 m_il_nv(ai+1,v);
1618 M_I_I(1,S_V_I(v,0));
1619 M_I_I(1,S_V_I(v,1));
1620 for (i=3;i<=ai;i+=2)
1621 {
1622 for (j=S_V_LI(v)-1;j>=i;j--)
1623 ADD_APPLY(S_V_I(v,j-i),S_V_I(v,j));
1624 }
1625
1626 SWAP(S_V_I(v,ai),c);
1627 FREEALL(v);
1628 }
1629 ENDR("numberofselfconjugatepart");
1630 }
1631
numberofparts_ge(a,b,c)1632 INT numberofparts_ge(a,b,c) OP a,b,c;
1633 /* number of partitions of a with maximal part >=b */
1634 /* AK 180803 */
1635 {
1636 INT erg = OK;
1637 CTO(INTEGER,"numberofparts_ge(1)",a);
1638 CTO(INTEGER,"numberofparts_ge(2)",b);
1639 SYMCHECK(S_I_I(a) < 0,"numberofparts_ge(1>=0)");
1640 if (S_I_I(b)<=0)
1641 erg += numberofpart(a,c);
1642 else if (GT(b,a))
1643 erg += m_i_i(0,c);
1644 else {
1645 OP ai,bi,ci;
1646 CALLOCOBJECT3(ai,bi,ci);
1647 COPY(b,bi);
1648 COPY(a,ai);
1649 erg += m_i_i(0,c);
1650 while (LE(bi,ai)) {
1651 numberofparts_exact_parts(ai,bi,ci);
1652 ADD_APPLY(ci,c);
1653 INC(bi);
1654 }
1655 FREEALL3(ai,bi,ci);
1656 }
1657 ENDR("numberofparts_ge");
1658 }
1659
1660
numberofparts_le_parts(a,b,c)1661 INT numberofparts_le_parts(a,b,c) OP a,b,c;
1662 /* number of partitions of a with maximal b parts */
1663 /* using generating function */
1664 /* AK 230103 */
1665 {
1666 INT erg = OK;
1667 CTO(INTEGER,"numberofparts_le_parts(1)",a);
1668 CTO(INTEGER,"numberofparts_le_parts(2)",b);
1669 SYMCHECK(S_I_I(a) < 0,"numberofparts_le_parts(1>=0)");
1670 SYMCHECK(S_I_I(b) <0,"numberofparts_le_parts(2>=0)");
1671 {
1672 if (EQ(a,b) ) numberofpart(a,c);
1673 else if (NULLP(b)) m_i_i(0,c);
1674 else if (EINSP(b)) m_i_i(1,c);
1675 else {
1676 OP v,v2;
1677 INT i,j,k,ai = S_I_I(a), bi=S_I_I(b);
1678 if (nb_e == NULL)
1679 {
1680 nb_e = CALLOCOBJECT();
1681 m_il_v(bi+1,nb_e);
1682 }
1683 else if (S_V_LI(nb_e) > bi)
1684 {
1685 OP nv = S_V_I(nb_e,bi);
1686 if (not EMPTYP(nv))
1687 {
1688 if (S_V_LI(nv) > ai) { CLEVER_COPY(S_V_I(nv,ai),c); goto endr_ende; }
1689 else FREESELF(nv);
1690 }
1691 }
1692 else
1693 {
1694 inc_vector_co(nb_e,bi);
1695 }
1696 v = CALLOCOBJECT();
1697 v2 = CALLOCOBJECT();
1698 m_il_nv(ai+1,v);
1699 m_il_v(ai+1,v2);
1700 for (i=0;i<=ai;i++)
1701 M_I_I(1,S_V_I(v,i));
1702 for (i=2;i<=bi;i++)
1703 {
1704 m_il_nv(ai+1,v2);
1705 for (j=i;j<=ai;j+=i)
1706 for (k=ai;k>=j;k--)
1707 ADD_APPLY(S_V_I(v,k-j),S_V_I(v2,k));
1708 ADD_APPLY(v2,v);
1709 }
1710 CLEVER_COPY(S_V_I(v,ai),c);
1711 SWAP(v,S_V_I(nb_e,bi));
1712 FREEALL(v);
1713 FREEALL(v2);
1714 }
1715 }
1716 ENDR("numberofparts_le_parts");
1717 }
1718
numberofparts_exact_parts(a,b,c)1719 INT numberofparts_exact_parts(a,b,c) OP a,b,c;
1720 /* number of partitions of a with exact b parts */
1721 /* using generating function */
1722 /* AK 230103 */
1723 {
1724 INT erg = OK;
1725 CTO(INTEGER,"numberofparts_exact_parts(1)",a);
1726 CTO(INTEGER,"numberofparts_exact_parts(2)",b);
1727 SYMCHECK(S_I_I(a) < 0,"numberofparts_exact_parts(1>=0)");
1728 SYMCHECK(S_I_I(b) <0,"numberofparts_exact_parts(2>=0)");
1729 {
1730 if (EQ(a,b) ) m_i_i(1,c);
1731 else if (NULLP(b)) m_i_i(0,c);
1732 else if (LT(a,b)) m_i_i(0,c);
1733 else {
1734 INT ai=S_I_I(a),bi=S_I_I(b),i;
1735 M_I_I(ai-bi,a);
1736 numberofparts_le_parts(a,b,c);
1737 M_I_I(ai,a);
1738 }
1739 }
1740 ENDR("numberofparts_exact_parts");
1741 }
1742
1743
1744 static INT rec01();
numberofpart(n,res)1745 INT numberofpart(n, res) OP n,res;
1746 /* AK 191202 */
1747 /* bressoud: proofs and confirmations p.37 */
1748 /* input INTEGER n
1749 output: number of partitions INTEGER or LONGINT */
1750 {
1751 INT erg = OK;
1752 OP v;
1753 CTO(INTEGER,"numberofpart(1)",n);
1754 if (S_I_I(n) < 0) erg += m_i_i(0,res);
1755 else {
1756 INT i;
1757 v = CALLOCOBJECT();
1758 erg += m_il_v(S_I_I(n)+1,v);
1759 for (i=0;i<=S_I_I(n);i++) rec01(i,v);
1760 SWAP(res,S_V_I(v,S_I_I(n)));
1761 FREEALL(v);
1762 }
1763 ENDR("numberofpart");
1764 }
1765
rec01(INT ni,OP vec)1766 static INT rec01(INT ni, OP vec)
1767 /* to compute number of partitions */
1768 {
1769 INT erg = OK;
1770 if (ni<0) return ERROR;
1771 if (not EMPTYP(S_V_I(vec,ni))) return ERROR;
1772 else if (ni<=1) M_I_I(1,S_V_I(vec,ni));
1773 else {
1774
1775 INT m,og;
1776 og = ni/3+3;
1777 m_i_i(0,S_V_I(vec,ni));
1778
1779 for (m=1;m<og;m++)
1780 {
1781 INT j;
1782 j = ni-m*(3*m-1)/2;
1783 if (j<0) break;
1784 if (m%2==0) { ADDINVERS_APPLY(S_V_I(vec,j));
1785 ADD_APPLY(S_V_I(vec,j),S_V_I(vec,ni));
1786 ADDINVERS_APPLY(S_V_I(vec,j));
1787 }
1788 else ADD_APPLY(S_V_I(vec,j),S_V_I(vec,ni));
1789 j = ni-m*(3*m+1)/2;
1790 if (j<0) break;
1791 if (m%2==0) { ADDINVERS_APPLY(S_V_I(vec,j));
1792 ADD_APPLY(S_V_I(vec,j),S_V_I(vec,ni));
1793 ADDINVERS_APPLY(S_V_I(vec,j));
1794 }
1795 else ADD_APPLY(S_V_I(vec,j),S_V_I(vec,ni));
1796 }
1797 }
1798 ENDR("internal:rec01");
1799 }
1800
1801
indexofpart(part)1802 INT indexofpart(part) OP part;
1803 /* AK 190587 */
1804 /* AK 060789 V1.0 */ /* AK 260690 V1.1 */ /* AK 200891 V1.3 */
1805 /* AK 200298 V2.0 */ /* AK 161006 V3.1 */
1806 {
1807 OP b,a;
1808 INT i=(INT)-1,erg=OK,comperg;
1809 CTO(PARTITION,"indexofpart(1)",part);
1810
1811 a = CALLOCOBJECT();
1812
1813 if (S_PA_K(part) != VECTOR)
1814 {
1815 if (S_PA_K(part) != EXPONENT)
1816 {
1817 erg += error("indexofpart:wrong kind of part");
1818 goto endr_ende;
1819 }
1820 erg += t_EXPONENT_VECTOR(part,a);
1821 i = indexofpart(a);
1822 erg += freeall(a);
1823 if (erg != OK)
1824 goto endr_ende;
1825 return i;
1826 }
1827
1828 erg += weight_partition(part,a);
1829 b = CALLOCOBJECT();
1830 erg += first_partition(a,b);
1831 i=(INT)0;
1832 while ((comperg = comp_partition_partition(b,part)) != 0)
1833 {
1834 i++;
1835 if (not next_apply(b))
1836 {
1837 debugprint(b);
1838 erg += error("indexofpart:ERROR");
1839 }
1840 };
1841
1842 erg += freeall(b);
1843 erg += freeall(a);
1844 if (erg != OK)
1845 goto endr_ende;
1846 return(i);
1847 ENDR("indexofpart");
1848 }
1849
1850
1851
ordcen(part,res)1852 INT ordcen(part,res) OP part, res;
1853 /* AK 010888 ordnung der konjugiertenklasse ist der index des zentralisators */
1854 /* AK 060789 V1.0 */ /* AK 071289 V1.1 */ /* AK 150591 V1.2 */
1855 /* AK 200891 V1.3 */
1856 /* AK 200298 V2.0 */ /* AK 161006 V3.1 */
1857 {
1858 OP h1,h2,zw;
1859 INT erg = OK;
1860
1861 CTO(PARTITION,"ordcen",part);
1862
1863 zw = CALLOCOBJECT();
1864 h1 = CALLOCOBJECT();
1865 h2 = CALLOCOBJECT();
1866 erg += ordcon(part,h2);
1867 erg += weight_partition(part,zw);
1868 erg += fakul(zw,h1);
1869 erg += ganzdiv(h1,h2,res); /* ist ganzzahlig */
1870 erg += freeall(zw);
1871 erg += freeall(h2);
1872 erg += freeall(h1);
1873 ENDR("ordcen");
1874 }
1875
1876
1877 #ifdef TABLEAUXTRUE
m_tableaux_polynom(a,c)1878 INT m_tableaux_polynom(a,c) OP a, c;
1879 /* AK 250789 */ /* AK 200891 V1.3 */
1880 /* AK V2.0 200298 */ /* AK 161006 V3.1 */
1881 {
1882 /* a ist poly of tableaux c wird poly of monom */
1883 /* AK 060588 */
1884 OP zeiger;
1885 INT erg = OK;
1886 COP("m_tableaux_polynom(2)",c);
1887
1888 zeiger = a;
1889 erg += init(POLYNOM,c);
1890 while( zeiger != NULL)
1891 {
1892 OP b = callocobject();
1893 erg += b_skn_po(CALLOCOBJECT(),CALLOCOBJECT(),NULL,b);
1894 M_I_I(1,S_PO_K(b));
1895 erg += content_tableaux(S_PO_S(zeiger),S_PO_S(b));
1896 insert(b,c,add_koeff,comp_monomvector_monomvector);
1897 zeiger = S_PO_N(zeiger);
1898 };
1899 ENDR("m_tableaux_polynom");
1900 }
1901
1902
m_part_tableaux(part,alph,res)1903 INT m_part_tableaux(part,alph,res) OP part,alph,res;
1904 /* AK 070588 */
1905 /* AK 200891 V1.3 */
1906 /* AK V2.0 200298 */
1907 {
1908 return(m_umriss_tableaux(part,alph,res));
1909 }
1910
1911
m_umriss_tableaux(umriss,alph,res)1912 INT m_umriss_tableaux(umriss,alph,res) OP umriss,alph,res;
1913 /* AK 070588 */
1914 /* erzeugt aus umriss eine liste der tableaus von diesen umriss
1915 mit eintraegen 1,2,..,alph */
1916 /* ergebnis ist polynom */
1917 /* AK 200891 V1.3 */
1918 /* AK V2.0 200298 */
1919 /* input: PARTITION object umriss
1920 INTEGER object alph
1921 output:
1922 */
1923 {
1924 OP a,b;
1925 OP start;
1926 INT i,j;
1927 INT erg = OK;
1928
1929 CTO(INTEGER,"m_umriss_tableaux",alph);
1930 PART_CHECK_KIND("m_umriss_tableaux",umriss,VECTOR);
1931
1932 CE3(umriss,alph,res,m_umriss_tableaux);
1933
1934 erg += init(LIST,res);
1935
1936 if (S_I_I(alph) < S_PA_LI(umriss)) return(OK);
1937
1938
1939 a = CALLOCOBJECT();
1940 b = CALLOCOBJECT();
1941 erg += copy(umriss,a);
1942 erg += m_u_t(a,b);
1943 /* damit haben wird das tablaux */
1944
1945 j = zeilenanfang(b,0);
1946 start = S_T_IJ(b,0,j);
1947
1948
1949 /* start ist die linke untere ecke */
1950
1951
1952 for (i= (INT)0; i< S_I_I(alph); i++)
1953 {
1954 M_I_I(i+1,start); /* initialisieren */
1955 erg += m060588(b,alph,res);
1956 }
1957 erg += freeall(a);
1958 erg += freeall(b);
1959 ENDR("m_umriss_tableaux");
1960 }
1961
m060588(tab,alph,res)1962 static INT m060588(tab,alph,res) OP tab,alph,res;
1963 /* alph ist maximaler eintrag */
1964 /* AK 200891 V1.3 */
1965 /* AK V2.0 200298 */
1966 {
1967 OP b,c;
1968 INT i,j;
1969 INT grenze;
1970 INT lasti,lastj;
1971
1972
1973 again:
1974 for (i=S_T_HI(tab)-1;i>= 0;i--)
1975 {
1976 j=zeilenanfang(tab,i); /* erster erlaubter index */
1977 if (not EMPTYP(S_T_IJ(tab,i,j))) break;
1978 };
1979
1980 lasti = i;
1981 /* lasti ist zeile in der letzter eintrag */
1982
1983 grenze = zeilenende(tab,lasti);
1984
1985 for ( j=zeilenanfang(tab,lasti); /* erster erlaubter index */
1986 j<= grenze;
1987 j++)
1988 if (EMPTYP(S_T_IJ(tab,lasti,j))) break;
1989
1990 lastj = j;
1991 /* lastj ist letzter eintrag + 1 */
1992
1993
1994 if (lastj <= grenze) { /* d.h. in der zeile kann noch eingetragen
1995 werden */
1996 INT m;
1997 m = S_T_IJI(tab,lasti,lastj-1);
1998 /* m = der letzte eintrag */
1999
2000 if (lasti == /* s_t_hi(tab)-1*/ 0) /* letzte zeile */
2001 M_I_I(m,S_T_IJ(tab,lasti,lastj));
2002 /* rechts anfuegen der gleichen zahl */
2003 else if (EMPTYP(S_T_IJ(tab,lasti-1,lastj)))
2004 /* bei schief unterhalb leer */
2005 M_I_I(m,S_T_IJ(tab,lasti,lastj));
2006 /* rechts anfuegen der gleichen zahl */
2007
2008 else {
2009 /* schauen ob unterhalb groesserer eintrag */
2010 m =
2011 (S_T_IJI(tab,lasti-1,lastj) >= m ?
2012 S_T_IJI(tab,lasti-1,lastj)+1 : m);
2013
2014 if (m > S_I_I(alph)) goto m060588nein;
2015 /* kann nicht einsetzen */
2016
2017 M_I_I(m,S_T_IJ(tab,lasti,lastj));
2018 };
2019 goto again;
2020 /* return(m060588(tab,alph,res)); */
2021 };
2022
2023 /* falls in der zeile nicht mehr eingetragen werden kann */
2024
2025 i = i+1; /* neue zeilenzahl */
2026
2027 if (i < S_T_HI(tab)) {
2028 j = zeilenanfang(tab,i);
2029 /* neue spaltenzahl */
2030
2031 if (not EMPTYP(s_t_ij(tab,i-1,j)))
2032 /* unterhalb der neuen
2033 position ist ein eintrag */
2034 {
2035 if (S_T_IJI(tab,i-1,j)+1 > S_I_I(alph))
2036 goto m060588nein;
2037 M_I_I(s_t_iji(tab,i-1,j)+1,s_t_ij(tab,i,j));
2038 return(m060588(tab,alph,res));
2039 }
2040 else M_I_I(1,s_t_ij(tab,i,j));
2041 };
2042 /* nun sind wir am ende */
2043 b = CALLOCOBJECT();
2044 c = CALLOCOBJECT();
2045 copy(tab,b);
2046 b_s_po(b,c);
2047 insert(c,res,NULL,NULL);
2048 /* jetzt muss versucht werden das naechste tableaux
2049 zu bekommen */
2050 m060588nein:
2051 if (m060588b(tab,alph) == TRUE) /* m060588(tab,alph,res); */ goto again;
2052 /* d.h noch nicht letztes tableaux */
2053 return(OK);
2054 }
2055
2056
m060588b(tab,alph)2057 static INT m060588b(tab,alph) OP tab,alph;
2058 /* es wird versucht das naechste tableaux zu bekommen */
2059 /* AK 200891 V1.3 */ /* AK V2.0 200298 */
2060 {
2061 INT i,j;
2062 INT lastj = zeilenanfang(tab,0);
2063 INT erg = OK;
2064 for (i=S_T_HI(tab)-1; i>=0 ;i--)
2065 for (j= S_T_LI(tab)-1;j >= (INT)0; j--)
2066 if (not EMPTYP(S_T_IJ(tab,i,j)))
2067 /* es gibt einen eintrag */
2068 if (i == 0 && j == lastj)
2069 return(FALSE);
2070 /* wir sind am ende */
2071 else if (S_T_IJI(tab,i,j) < S_I_I(alph))
2072 {
2073 INC(S_T_IJ(tab,i,j));
2074 return(TRUE);
2075 }
2076 else
2077 {
2078 FREESELF(S_T_IJ(tab,i,j));
2079 return(m060588b(tab,alph));
2080 }
2081 return(FALSE);
2082 ENDR("m060588b");
2083 }
2084 #endif /* TABLEAUXTRUE */
2085
2086
t_augpart_part(a,b)2087 INT t_augpart_part(a,b) OP a,b;
2088 /* AK 150988 */ /* AK 060789 V1.0 */ /* AK 170190 V1.1 */
2089 /* AK 200891 V1.3 */
2090 /* AK V2.0 200298 */
2091 {
2092 INT i,s=0;
2093 INT erg = OK;
2094 CTO(AUG_PART,"t_augpart_part(1)",a);
2095
2096 copy(a,b);
2097 C_O_K(b,PARTITION);
2098 for (i=(INT)0;i<S_PA_LI(b);i++)
2099 {
2100 M_I_I(S_PA_II(b,i)-i,s_pa_i(b,i));
2101 if (S_PA_II(b,i)==(INT)0) s++;
2102 }
2103 if (s != (INT)0) /* d.h. 0 am anfang */
2104 {
2105 OP nv = callocobject();
2106 m_il_v(S_PA_LI(b)-s,nv);
2107 for (i=(INT)0; i<S_V_LI(nv); i++)
2108 M_I_I(S_PA_II(b,i+s),S_V_I(nv,i));
2109 freeall(S_PA_S(b));
2110 C_PA_S(b,nv);
2111 }
2112 ENDR("t_augpart_part");
2113 }
2114
eq_partition_partition(a,b)2115 INT eq_partition_partition(a,b) OP a,b;
2116 /* AK 040202 */
2117 {
2118 INT erg = OK,l,i;
2119 char *ac,*bc;
2120 OP ap,bp;
2121 CTO(PARTITION,"eq_partition_partition(1)",a);
2122 CTO(PARTITION,"eq_partition_partition(2)",b);
2123 if (S_PA_K(a) != S_PA_K(b)) return FALSE;
2124
2125 if (S_PA_K(a) == VECTOR)
2126 {
2127 if (S_PA_LI(a) != S_PA_LI(b))
2128 return FALSE;
2129 ac = (char *) S_V_S(S_PA_S(a));
2130 bc = (char *) S_V_S(S_PA_S(b));
2131 if (memcmp(ac,bc, sizeof(struct object) * S_PA_LI(a) ) == 0)
2132 return TRUE;
2133 else
2134 return FALSE;
2135 }
2136 if (S_PA_K(a) == EXPONENT)
2137 {
2138 if (S_PA_LI(a) > S_PA_LI(b)) l=S_PA_LI(b);
2139 else l = S_PA_LI(a);
2140
2141 /* this code is slower
2142 ac = (char *) S_V_S(S_PA_S(a));
2143 bc = (char *) S_V_S(S_PA_S(b));
2144 if (memcmp(ac,bc, sizeof(struct object) * l ) != 0) return FALSE;
2145 */
2146 ap = S_V_S(S_PA_S(a));
2147 bp = S_V_S(S_PA_S(b));
2148
2149 for (i=0;i<l;i++,ap++,bp++)
2150 if (S_I_I(ap) != S_I_I(bp)) return FALSE;
2151 if (S_PA_LI(a) > l) {
2152 for (;l<S_PA_LI(a);l++)
2153 if (S_PA_II(a,l) != 0) return FALSE;
2154 return TRUE;
2155 }
2156 if (S_PA_LI(b) > l) {
2157 for (;l<S_PA_LI(b);l++)
2158 if (S_PA_II(b,l) != 0) return FALSE;
2159 return TRUE;
2160 }
2161 return TRUE;
2162 }
2163 else
2164 return (comp_partition_partition(a,b) == 0);
2165 ENDR("eq_partition_partition");
2166 }
2167
eq_partition(a,b)2168 INT eq_partition(a,b) OP a,b;
2169 /* AK 291001 */
2170 {
2171 INT erg = OK;
2172 CTO(PARTITION,"eq_partition(1)",a);
2173
2174 if (S_O_K(b) != PARTITION) return FALSE;
2175 return eq_partition_partition(a,b);
2176 ENDR("eq_partition");
2177 }
2178
2179
comp_partition_partition(a,b)2180 INT comp_partition_partition(a,b) OP a,b;
2181 /* AK 110488*/ /* AK 060789 V1.0 */ /* AK 191289 V1.1 */
2182 /* AK 070891 V1.3 */
2183 /* AK V2.0 200298 */
2184 {
2185 INT i;
2186 INT erg=OK;
2187 char *ac, *bc;
2188 CTO(PARTITION,"comp_partition_partition(1)",a);
2189 CTO(PARTITION,"comp_partition_partition(2)",b);
2190
2191 if (S_PA_K(a) != S_PA_K(b))
2192 {
2193 erg = error("comp_partition:different kind of partitions");
2194 goto endr_ende;
2195 }
2196
2197 if (S_PA_K(a) == VECTOR )
2198 {
2199 #ifdef __alpha
2200 erg = comp_integervector(S_PA_S(a), S_PA_S(b));
2201 goto cpende;
2202 #endif /* __alpha */
2203 ac = (char *) S_V_S(S_PA_S(a));
2204 bc = (char *) S_V_S(S_PA_S(b));
2205 if (S_PA_LI(a) == S_PA_LI(b))
2206 {
2207 erg = (INT)memcmp(ac,bc,
2208 ( sizeof(struct object) * S_PA_LI(a) ));
2209 goto cpende;
2210 }
2211 if (S_PA_LI(a) < S_PA_LI(b))
2212 {
2213 erg = (INT) memcmp(ac,bc,
2214 (sizeof(struct object) * S_PA_LI(a) ));
2215 if (erg == (INT)0) erg = (INT)-1;
2216 goto cpende;
2217 }
2218 if (S_PA_LI(a) > S_PA_LI(b))
2219 {
2220 erg = (INT)memcmp(ac,bc,
2221 (sizeof(struct object) * S_PA_LI(b) ));
2222 if (erg == (INT)0) erg = (INT)1;
2223 goto cpende;
2224 }
2225
2226 }
2227 else if (S_PA_K(a) == EXPONENT)
2228 {
2229 if (S_PA_LI(a) == S_PA_LI(b)) /* AK 011097 */
2230 {
2231 erg = (INT)memcmp(
2232 (char *) S_V_S(S_PA_S(a)),
2233 (char *) S_V_S(S_PA_S(b)),
2234 ( sizeof(struct object) * S_PA_LI(a) ));
2235 goto cpende;
2236 }
2237 for ( i=(INT)0; i<S_PA_LI(a); i++)
2238 {
2239 if (i >= S_PA_LI(b) )
2240 {
2241 if (S_PA_II(a,i) != (INT)0)
2242 {
2243 erg = (INT)1;
2244 goto cpende;
2245 }
2246 }
2247 else if (S_PA_II(a,i) > S_PA_II(b,i))
2248 {
2249 erg = (INT)1;
2250 goto cpende;
2251 }
2252 else if (S_PA_II(a,i) < S_PA_II(b,i))
2253 {
2254 erg = (INT)-1;
2255 goto cpende;
2256 }
2257 }
2258
2259 for ( ; i<S_PA_LI(b); i++)
2260 if (S_PA_II(b,i) != (INT)0)
2261 {
2262 erg = (INT)-1;
2263 goto cpende;
2264 }
2265 }
2266 erg = (INT)0; goto cpende;
2267 cpende:
2268 return erg;
2269
2270 ENDR("comp_partition_partition");
2271 }
2272
comp_partition(a,b)2273 INT comp_partition(a,b) OP a,b;
2274 {
2275 INT erg=OK;
2276 CTO(PARTITION,"comp_partition(1)",a);
2277 if (S_O_K(b) == PARTITION)
2278 return comp_partition_partition(a,b);
2279 else
2280 WTO("comp_partition(2)",b);
2281 ENDR("comp_partition");
2282 }
2283
2284 OP t_exp_vec_app_c = NULL;
part_anfang()2285 INT part_anfang()
2286 /* AK V2.0 040903 */
2287 {
2288 INT erg =OK;
2289 ANFANG_MEMMANAGER(partition_speicher,
2290 partition_speicherindex,
2291 partition_speichersize,
2292 mem_counter_part);
2293 ENDR("part_anfang");
2294 }
part_ende()2295 INT part_ende()
2296 /* AK V2.0 200298 */
2297 {
2298 INT erg = OK;
2299 if (t_exp_vec_app_c!=NULL)
2300 {
2301 CTO(INTEGERVECTOR,"part_ende(i1)",t_exp_vec_app_c);
2302 FREEALL(t_exp_vec_app_c);
2303 t_exp_vec_app_c=NULL;
2304 }
2305 if (nb_e != NULL) { FREEALL(nb_e); nb_e=NULL; }
2306
2307 ENDE_MEMMANAGER(partition_speicher,
2308 partition_speicherindex,
2309 partition_speichersize,
2310 mem_counter_part,"part speicher not freed");
2311
2312 if (no_banner != TRUE)
2313 if (mem_counter_part != (INT)0)
2314 {
2315 fprintf(stderr, "mem_counter_part = %" PRIINT "\n" ,mem_counter_part);
2316 erg += error("memory problem with partitions");
2317 }
2318
2319 ENDR("part_ende");
2320 }
2321
freepartition(d)2322 INT freepartition(d) struct partition *d;
2323 /* AK 020102 */
2324 {
2325 INT erg = OK;
2326 FREE_MEMMANAGER(struct partition *,
2327 partition_speicher,
2328 partition_speicherindex,
2329 partition_speichersize,
2330 mem_counter_part,
2331 d);
2332 ENDR("freepartition");
2333 }
2334
freeself_partition(a)2335 INT freeself_partition(a) OP a;
2336 /* AK 110488 */ /* AK 060789 V1.0 */ /* AK 211189 V1.1 */
2337 /* AK 120691 V1.2 */ /* AK 070891 V1.3 */
2338 /* AK V2.0 200298 */
2339 {
2340 INT erg = OK;
2341 CTTO(PARTITION,CHARPARTITION,"freeself_partition(1)",a);
2342
2343 if (S_O_K(a) == CHARPARTITION) SYM_free(S_PA_S(a));
2344 else if (S_PA_K(a) == FROBENIUS) FREEALL(S_PA_S(a));
2345 else if (S_PA_K(a) == BITVECTOR) FREEALL(S_PA_S(a));
2346 else /* VECTOR, EXPONENT */
2347 {
2348 if (S_PA_S(a) != NULL)
2349 {
2350 CTO(INTEGERVECTOR,"freeself_partition(i)",S_PA_S(a));
2351 FREEALL_INTEGERVECTOR(S_PA_S(a));
2352 }
2353 }
2354
2355 FREEPARTITION(S_O_S(a).ob_partition);
2356 C_O_K(a,EMPTY);
2357 ENDR("freeself_partition");
2358 }
2359
copy_partition(a,b)2360 INT copy_partition(a,b) OP a,b;
2361 /* AK 060789 V1.0 */ /* AK 191289 V1.1 */ /* AK 070891 V1.3 */
2362 /* AK V2.0 200298 */
2363 {
2364 INT erg = OK;
2365 CTTO(PARTITION,AUG_PART,"copy_partition(1)",a);
2366 CTO(EMPTY,"copy_partition(2)",b);
2367
2368 if (S_PA_K(a) == FROBENIUS) {
2369 B_KS_PA(S_PA_K(a),CALLOCOBJECT(),b);
2370 COPY(S_PA_S(a), S_PA_S(b));
2371 goto ende;
2372 }
2373 else if (S_PA_K(a) == BITVECTOR)
2374 {
2375 B_KS_PA(S_PA_K(a),CALLOCOBJECT(),b);
2376 COPY(S_PA_S(a), S_PA_S(b));
2377 goto ende;
2378 }
2379
2380 B_KS_PA(S_PA_K(a),CALLOCOBJECT(),b);
2381 erg += m_il_integervector(S_PA_LI(a),S_PA_S(b));
2382 memcpy(
2383 (char *) S_V_S(S_PA_S(b)),
2384 (char *) S_V_S(S_PA_S(a)),
2385 (int)(S_PA_LI(a)*sizeof(struct object)) );
2386
2387 C_O_K(b,S_O_K(a)); /* copy of AUG_PART e.g. */
2388 C_PA_HASH(b,S_PA_HASH(a)); /* AK 061101 */
2389
2390 ende:
2391 ENDR("copy_partition");
2392 }
2393
2394
tex_partition(part)2395 INT tex_partition(part) OP part;
2396 /* AK 101187 */
2397 /* output of a PARTITIONobject in format for TeX */
2398 /* AK 060789 V1.0 */ /* AK 170190 V1.1 */
2399 /* AK 070291 V1.2 texout for output */ /* AK 070891 V1.3 */
2400 /* AK V2.0 200298 */
2401 {
2402 INT erg = OK;
2403 CTO(PARTITION,"tex_partition(1)",part);
2404 COP("tex_partition:texout",texout);
2405
2406 if (texmath_yn == 0) /* if not in math mode */
2407 fprintf(texout,"\\ $ ");
2408
2409 erg += fprint(texout,part);
2410 texposition = (INT)0;
2411 if (texmath_yn == 0) /* if not in math mode */
2412 fprintf(texout," $\\ ");
2413 ENDR("tex_partition");
2414 }
2415
2416
2417
callocpartition()2418 static struct partition * callocpartition()
2419 /* AK 060789 V1.0 */ /* AK 170889 malloc statt calloc */ /* AK 170190 V1.1 */
2420 /* AK 070891 V1.3 */
2421 /* AK V2.0 200298 */
2422 {
2423 struct partition * res;
2424 INT erg = OK;
2425 CALLOC_MEMMANAGER(struct partition,
2426 partition_speicher,
2427 partition_speicherindex,
2428 mem_counter_part,
2429 res);
2430 return(res);
2431 ENDTYP("callocpartition", struct partition * );
2432 }
2433
2434
2435
inversordcen(part,ergeb)2436 INT inversordcen(part,ergeb) OP part, ergeb;
2437 /* AK 210387 */
2438 /* AK 060789 V1.0 */ /* AK 170190 V1.1 */ /* AK 070891 V1.3 */
2439 /* AK V2.0 200298 */
2440 /* input: PARTITION object
2441 output: BRUCH object giving invers order of centraliser of S_n
2442 labeled by the partition */
2443 {
2444 INT i;
2445 INT erg = OK; /* AK 090692 */
2446 OP sp;
2447
2448 PART_CHECK_KIND("inversordcen(1)",part,VECTOR);
2449 CE2(part,ergeb,inversordcen);
2450
2451 M_I_I(1,ergeb);
2452 NEW_INTEGER(sp,1);
2453
2454 for (i=(INT)0; i<S_PA_LI(part);i++)
2455 {
2456 if (i>(INT)0)
2457 {
2458 if (S_PA_II(part,i) == S_PA_II(part,(i-1)))
2459 {
2460 INC_INTEGER(sp);
2461 MULT_APPLY_INTEGER(sp,ergeb);
2462 }
2463 else M_I_I(1,sp);
2464 };
2465 MULT_APPLY_INTEGER(S_PA_I(part,i),ergeb);
2466 };
2467
2468
2469 erg += invers_apply(ergeb);
2470 FREEALL(sp);
2471 ENDR("inversordcen");
2472 }
2473
ordcon(part,res)2474 INT ordcon(part,res) OP part, res;
2475 /* AK 200387 */ /* AK 060789 */
2476 /* AK 060789 V1.0 */ /* AK 081289 V1.1 */ /* AK 070891 V1.3 */
2477 /* AK V2.0 200298 */
2478 /* AK V3.1 300306 */
2479 /* input: PARTITION object or
2480 PERMUTATION object
2481 output: INTEGER or LONGINT object giving
2482 the size of the conjugacy class in S_n labled by
2483 the partition or
2484 the size of the class containing the permutation */
2485 {
2486 INT i;
2487 INT erg = OK;
2488 OP ergebnis,sp;
2489 OP h1;
2490 if (S_O_K(part) == CHARPARTITION) /* AK 170593 */
2491 {
2492 erg+= ordcon_char(part,res);
2493 goto endr_ende;
2494 }
2495 else if (S_O_K(part)==PERMUTATION) /* AK 300306 */
2496 {
2497 OP p;
2498 p = CALLOCOBJECT();
2499 erg += zykeltyp_permutation(part,p);
2500 erg += ordcon(p,res);
2501 FREEALL(p);
2502 goto endr_ende;
2503 }
2504 PART_CHECK_KIND("ordcon(1)",part,VECTOR);
2505 CE2(part,res,ordcon);
2506
2507 NEW_INTEGER(sp,1);
2508 NEW_INTEGER(ergebnis,1);
2509 for (i=(INT)0; i<S_PA_LI(part);i++)
2510 {
2511 if (i>(INT)0)
2512 {
2513 if (S_PA_II(part,i) == S_PA_II(part,(i-1)))
2514 {
2515 INC_INTEGER(sp);
2516 erg += mult_apply_integer(sp,ergebnis);
2517 }
2518 else M_I_I(1,sp);
2519 };
2520 erg += mult_apply_integer(S_PA_I(part,i),ergebnis);
2521 };
2522
2523 h1 = callocobject();
2524 erg += weight_partition(part,h1);
2525 erg += fakul(h1,sp);
2526 erg += freeall(h1);
2527 erg += ganzdiv(sp,ergebnis,res); /* diese division ist ganzzahlig */
2528
2529 erg += freeall(sp);
2530 erg += freeall(ergebnis);
2531 ENDR("ordcon");
2532 }
2533
2534
2535
ordcon_char(part,res)2536 static INT ordcon_char(part,res) OP part, res;
2537 /* AK V2.0 200298 */
2538 {
2539 INT i;
2540 INT erg = OK;
2541 OP ergebnis,sp;
2542 OP h1,h2;
2543 CTO(CHARPARTITION,"ordcon_char(1)",part);
2544
2545 if (S_PA_K(part) != VECTOR)
2546 return ERROR;
2547
2548 h1 = callocobject();
2549 h2 = callocobject();
2550 sp=callocobject();
2551 M_I_I(1,sp);
2552 ergebnis=callocobject();
2553 M_I_I(1,ergebnis);
2554 if (not EMPTYP(res))
2555 if (S_O_K(res) != INTEGER)
2556 erg += freeself(res);
2557 for (i=(INT)0; i<S_PA_CL(part);i++)
2558 {
2559 if (i>(INT)0)
2560 {
2561 if (S_PA_CII(part,i) == S_PA_CII(part,(i-1)))
2562 {
2563 INC_INTEGER(sp);
2564 erg += mult_apply_integer(sp,ergebnis);
2565 }
2566 else M_I_I(1,sp);
2567 };
2568 M_I_I(S_PA_CII(part,i),h2); /* AK 170593 */
2569 erg += mult_apply_integer(h2,ergebnis);
2570 };
2571 erg += weight_partition(part,h1);
2572 erg += fakul(h1,sp);
2573 erg += freeall(h1);
2574 erg += ganzdiv(sp,ergebnis,res); /* diese division ist ganzzahlig */
2575
2576 erg += freeall(sp);
2577 erg += freeall(ergebnis);
2578
2579 erg += freeall(h2);
2580 ENDR("ordcon_char");
2581 }
2582
2583
2584
mycc(a,b)2585 static int mycc(a,b) OP a,b; { return (int)(S_I_I(a)-S_I_I(b)); }
2586
m_v_pa(vec,part)2587 INT m_v_pa(vec,part) OP vec, part;
2588 /* AK 060789 V1.0 */ /* AK 240490 V1.1 */ /* AK 150591 V1.2 */
2589 /* AK 070891 V1.3 */
2590 /* AK V2.0 200298 */
2591 /* input: VECTOR object with INTEGER entries >= 0
2592 output: PARTITION object got by ordering the entries
2593 and removinf the zeros */
2594 {
2595 INT i,j, erg=OK;
2596 OP self;
2597
2598 CE2(vec,part,m_v_pa);
2599 CTTO(VECTOR,INTEGERVECTOR,"m_v_pa",vec);
2600
2601 if (S_V_LI(vec) == 0) {
2602 null:
2603 erg += m_il_pa(0,part);
2604 goto ende;
2605 }
2606
2607 self = CALLOCOBJECT();
2608
2609
2610 if (S_O_K(vec) == VECTOR)
2611 {
2612 C_O_K(vec,INTEGERVECTOR);
2613 erg += copy_integervector(vec,self);
2614 C_O_K(vec,VECTOR); /* AK 080502 */
2615 }
2616 else
2617 erg += copy_integervector(vec,self);
2618
2619 qsort(S_V_S(self), S_V_LI(self), sizeof(struct object), mycc);
2620
2621 if (S_V_II(self,0) < 0) {
2622 INT err;
2623 FREEALL(self);
2624 err=error("m_v_pa: negativ entries");
2625 if (err == ERROR_EXPLAIN) {
2626 fprintf(stderr,"the wrong input vector was ");
2627 fprintln(stderr,vec);
2628 }
2629 }
2630
2631 i = 0;
2632 while ((i<S_V_LI(self)) && (S_V_II(self,i) == 0)) i++;
2633 /* eintraege = 0 werden ueberlesen */
2634
2635 if (i == S_V_LI(self))
2636 {
2637 FREEALL(self);
2638 goto null; /* nur nullen */
2639 }
2640
2641
2642 /* die laenge der ergebnis-partition vectorlaenge - anzahl der nullen */
2643 if ((S_V_LI(self)-i) == 1) /* AK 121093 */
2644 {
2645 j = S_V_II(self,i);
2646 erg += m_il_v(1,self);
2647 M_I_I(j,S_V_I(self,(INT)0));
2648 }
2649 else {
2650 for (j=0;i<S_V_LI(self);j++,i++)
2651 M_I_I(S_V_II(self,i),S_V_I(self,j));
2652 M_I_I(j,S_V_L(self));
2653 }
2654
2655 C_O_K(self,INTEGERVECTOR);
2656 B_KS_PA(VECTOR,self,part); /* part is the resulting partition object */
2657 ende:
2658 ENDR("m_v_pa");
2659 }
2660
m_int_pa(i,result)2661 INT m_int_pa(i,result) INT i; OP result;
2662 /* AK V2.0 200298 */
2663 {
2664 OP c;
2665 INT erg = OK;
2666 COP("m_int_pa(2)",result);
2667 SYMCHECK((i < 0),"m_int_pa:integer < 0");
2668 c=CALLOCOBJECT();
2669 M_I_I(i,c);
2670 erg += b_i_pa(c,result);
2671 ENDR("m_int_pa");
2672 }
2673
m_i_pa(i,result)2674 INT m_i_pa(i,result) OP i,result;
2675 /* AK 280890 V1.1 */ /* AK 150591 V1.2 */ /* AK 070891 V1.3 */
2676 /* AK V2.0 200298 */
2677 /* input: INTEGER object i
2678 output: PARTITION object [i] in VECTOR notation */
2679 /* i and result may be equal */
2680 /* i >= 0 */
2681 /* i == 0 ==> part = [] */
2682 /* AK 210704 V3.0 */
2683 {
2684 INT erg = OK;
2685 COP("m_i_pa(2)",result);
2686 CTO(INTEGER,"m_i_pa(1)",i);
2687 SYMCHECK((S_I_I(i) < 0),"m_i_pa:integer < 0");
2688 {
2689 OP c;
2690 c = CALLOCOBJECT();
2691 M_I_I(S_I_I(i),c);
2692 erg += b_i_pa(c,result);
2693 }
2694 ENDR("m_i_pa");
2695 }
2696
2697
b_i_pa(integer,res)2698 INT b_i_pa(integer,res) OP integer,res;
2699 /* AK 140687 */ /* Bsp: 5 --> [5] */
2700 /* AK 060789 V1.0 */ /* AK 280890 V1.1 */ /* AK 070891 V1.3 */
2701 /* AK 200298 V2.0 */
2702 /* input: INTEGER object integer
2703 output: PARTITION object [i] in VECTOR notation */
2704 /* integer becomes a part of res */
2705 /* integer >= 0 */
2706 /* integer == 0 ==> part = [] */
2707 /* AK 210704 V3.0 */
2708 {
2709 INT erg = OK;
2710 COP("b_i_pa(2)",res);
2711 CTO(INTEGER,"b_i_pa(1)",integer);
2712 SYMCHECK((S_I_I(integer) < 0),"b_i_pa(1):integer < 0");
2713 SYMCHECK((integer == res),"b_i_pa(1,2):identical objects");
2714
2715 {
2716 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),res);
2717 if (S_I_I(integer) > 0)
2718 erg += b_o_v(integer,S_PA_S(res));
2719 else
2720 {
2721 erg += m_il_v(0,S_PA_S(res));
2722 FREEALL(integer);
2723 }
2724 C_O_K(S_PA_S(res),INTEGERVECTOR);
2725 }
2726
2727 ENDR("b_i_pa");
2728 }
2729
2730
2731
m_ks_pa(kind,self,ergebnis)2732 INT m_ks_pa(kind,self,ergebnis) OP self,ergebnis; OBJECTKIND kind;
2733 /* make_kind.self_partition */
2734 /* AK 300590 V1.1 */ /* AK 070891 V1.3 */
2735 /* AK V2.0 200298 */
2736 /* self and ergebnis may be equal */
2737 {
2738 OP s = NULL;
2739 INT erg = OK;
2740 COP("m_ks_pa(3)",ergebnis);
2741 if (self != NULL) {
2742 s = CALLOCOBJECT();
2743 erg += copy(self,s);
2744 }
2745 erg += b_ks_pa(kind,s,ergebnis);
2746 ENDR("m_ks_pa");
2747 }
2748
b_ks_pa(kind,self,c)2749 INT b_ks_pa(kind,self,c) OP self,c; OBJECTKIND kind;
2750 /* build_kind_self_partition */ /* AK 060789 V1.0 */ /* AK 300590 V1.1 */
2751 /* AK 200891 V1.3 */
2752 /* AK V2.0 200298 */
2753 {
2754 OBJECTSELF d;
2755 INT erg = OK;
2756 COP("b_ks_pa(3)",c);
2757
2758 d.ob_partition = callocpartition();
2759 erg += b_ks_o(PARTITION, d, c);
2760 C_PA_K(c,kind);
2761 C_PA_S(c,self);
2762 C_PA_HASH(c,-1);
2763 if (kind == VECTOR)
2764 {
2765 if (VECTORP(self)) C_O_K(self,INTEGERVECTOR); /* AK 011101 */
2766 }
2767 else if (kind == EXPONENT)
2768 {
2769 if (VECTORP(self)) C_O_K(self,INTEGERVECTOR); /* AK 011101 */
2770 }
2771
2772 ENDR("b_ks_pa");
2773 }
2774
2775
m_kl_pa(a,b,c)2776 INT m_kl_pa(a,b,c) OBJECTKIND a; OP b,c;
2777 /* AK 060789 V1.0 */ /* AK 280890 V1.1 */ /* AK 200891 V1.3 */
2778 /* AK V2.0 200298 */
2779 {
2780 INT erg = OK;
2781 CTO(INTEGER,"m_kl_pa(2)",b);
2782 erg += b_ks_pa(a,callocobject(),c) ;
2783 erg += m_l_v(b,S_PA_S(c));
2784 C_O_K(S_PA_S(c), INTEGERVECTOR);
2785 ENDR("m_kl_pa");
2786 }
2787
b_kl_pa(a,b,c)2788 INT b_kl_pa(a,b,c) OBJECTKIND a; OP b,c;
2789 /* AK 180893 */
2790 /* AK V2.0 200298 */
2791 {
2792 INT erg = OK;
2793 CTO(INTEGER,"b_kl_pa(2)",b);
2794 erg += b_ks_pa(a,callocobject(),c) ;
2795 erg += b_l_v(b,S_PA_S(c));
2796 if (a == VECTOR)
2797 C_O_K(S_PA_S(c),INTEGERVECTOR);
2798 else if (a == EXPONENT)
2799 C_O_K(S_PA_S(c),INTEGERVECTOR);
2800 ENDR("b_kl_pa");
2801 }
2802
2803
dec_partition(a)2804 INT dec_partition(a) OP a;
2805 /* AK 060789 V1.0 */ /* AK 261190 V1.1 */ /* AK 200891 V1.3 */
2806 /* AK V2.0 200298 */
2807 /* removes the biggest part of the partition */
2808 /* stops if length = 0 */
2809 {
2810 INT i;
2811 INT erg = OK;
2812 CTO(PARTITION,"dec_partition",a);
2813 if (S_PA_K(a) == VECTOR)
2814 {
2815 if (S_PA_LI(a) > (INT)0)
2816 erg += dec_integervector(S_PA_S(a));
2817 }
2818 else if (S_PA_K(a) == EXPONENT)
2819 {
2820 for(i=S_PA_LI(a)-1;i>=(INT)0;i--)
2821 if (S_PA_II(a,i) > (INT)0)
2822 {
2823 M_I_I(S_PA_II(a,i)-1,S_PA_I(a,i));
2824 goto endr_ende;
2825 }
2826 }
2827 else
2828 {
2829 erg += error("dec_partition:works only for VECTOR, EXPONENT");
2830 }
2831 ENDR("dec_partition");
2832 }
2833
lastof_partition(a,b)2834 INT lastof_partition(a,b) OP a,b;
2835 /* returns the biggest part of the partition */
2836 /* zero if partition of length 0 */
2837 /* AK 060789 V1.0 */ /* AK 261190 V1.1 */ /* AK 200891 V1.3 */
2838 /* AK V2.0 200298 */
2839 {
2840 INT erg = OK;
2841 CTO(PARTITION,"lastof_partition(1)",a);
2842 CTO(EMPTY,"lastof_partition(2)",b);
2843
2844 if (S_PA_K(a) == VECTOR)
2845 {
2846 if (S_PA_LI(a) == 0) M_I_I(0,b);
2847 else M_I_I(S_PA_II(a,S_PA_LI(a)-1),b);
2848 }
2849 else if (S_PA_K(a) == EXPONENT)
2850 {
2851 INT i;
2852 M_I_I(0,b);
2853 for (i=S_PA_LI(a)-1; i>=0; i--)
2854 if (S_PA_II(a,i) > 0) { M_I_I(i+1,b); break; }
2855 }
2856 else
2857 {
2858 erg += error("lastof_partition works only with VECTOR or EXPONENT type partitions");
2859 }
2860 ENDR("lastof_partition");
2861 }
2862
2863
2864
length_partition(a,b)2865 INT length_partition(a,b) OP a,b;
2866 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
2867 /* AK V2.0 200298 */
2868 /* AK 140901 */
2869 /* input: PARTITION object
2870 output: INTEGER object = number of parts of the partition */
2871 {
2872 INT erg = OK;
2873 CTO(PARTITION,"length_partition(1)",a);
2874 CTO(EMPTY,"length_partition(2)",b);
2875
2876 switch(S_PA_K(a)) {
2877 case VECTOR:
2878 erg += length_vector(S_PA_S(a),b);
2879 break;
2880 case EXPONENT:
2881 erg += sum_integervector(S_PA_S(a),b);
2882 break;
2883 case FROBENIUS: /* AK 140901 */
2884 if (S_V_LI(S_V_I(S_PA_S(a),0)) == 0)
2885 M_I_I(0,b);
2886 else
2887 M_I_I(S_V_II(S_V_I(S_PA_S(a),0),0) +1, b);
2888 break;
2889 default:
2890 erg += error("length_partition: wrong kind of part");
2891 break;
2892 }
2893 ENDR("length_partition");
2894 }
2895
2896
2897
weight_partition(a,b)2898 INT weight_partition(a,b) OP a,b;
2899 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
2900 /* AK V2.0 200298 */
2901 /* input: PARTITION object
2902 output: INTEGER object */
2903 {
2904 INT i ,res=(INT)0;
2905 INT erg = OK;
2906 CTO(EMPTY,"weight_partition(2)",b);
2907 CTTO(CHARPARTITION,PARTITION,"weight_partition(1)",a);
2908
2909 if (S_O_K(a) == CHARPARTITION)
2910 if (S_PA_K(a) == VECTOR) {
2911 for (i=S_PA_CL(a)-1;i>=(INT)0;i--)
2912 res += S_PA_CII(a,i);
2913 M_I_I(res,b);
2914 goto endr_ende;
2915 }
2916
2917 if (S_PA_K(a) == VECTOR) {
2918 for (i=S_PA_LI(a)-1;i>=(INT)0;i--) res += S_PA_II(a,i);
2919 M_I_I(res,b);
2920 }
2921 else if (S_PA_K(a) == EXPONENT) {
2922 for (i=S_PA_LI(a)-1;i>=(INT)0;i--) res += (i+1) * S_PA_II(a,i);
2923 M_I_I(res,b);
2924 }
2925 else if (S_PA_K(a) == FROBENIUS)
2926 {
2927 OP c = callocobject();
2928 erg += sum_integervector(S_V_I(S_PA_S(a),0),b);
2929 erg += sum_integervector(S_V_I(S_PA_S(a),1),c);
2930 erg += add_apply_integer(c,b);
2931 erg += freeall(c);
2932 erg += add_apply_integer(S_V_L(S_V_I(S_PA_S(a),0)),b);
2933 }
2934 else {
2935 erg += error("weight_partition: wrong kind of part");
2936 }
2937 ENDR("weight_partition");
2938 }
2939
2940
2941
scan_exponentpartition(c)2942 INT scan_exponentpartition(c) OP c;
2943 /* AK V2.0 200298 */
2944 {
2945 INT erg=OK;
2946 COP("scan_exponentpartition(1)",c);
2947 spa:
2948 erg += b_ks_pa(EXPONENT,callocobject(),c);
2949 erg += printeingabe("Please input a partition as vector");
2950 erg += printeingabe("of integers (multiplicities) >= 0.");
2951 erg += scan(INTEGERVECTOR,S_PA_S(c));
2952 if (partitionp(c) != TRUE) /* AK 170692 */
2953 {
2954 erg += printeingabe("Sorry, you did not enter a partition");
2955 erg += printeingabe("please try again.");
2956 erg += freeself(c);
2957 goto spa;
2958 }
2959 ENDR("scan_exponentpartition");
2960 }
2961
2962
scan_partition(c)2963 INT scan_partition(c) OP c;
2964 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 250291 V1.2 */
2965 /* AK 200891 V1.3 */
2966 /* AK V2.0 200298 */
2967 {
2968 INT erg=OK;
2969 COP("scan_partition(1)",c);
2970 spa:
2971 erg += b_ks_pa(VECTOR,callocobject(),c);
2972 erg += printeingabe("Please input a partition as increasing vector");
2973 erg += printeingabe("of integers > 0.");
2974 erg += scan(INTEGERVECTOR,S_PA_S(c));
2975 if (partitionp(c) != TRUE) /* AK 170692 */
2976 {
2977 erg += printeingabe("Sorry, you did not enter a partition");
2978 erg += printeingabe("please try again.");
2979 erg += freeself(c);
2980 goto spa;
2981 }
2982 ENDR("scan_partition");
2983 }
2984
2985
scan_reversepartition(c)2986 INT scan_reversepartition(c) OP c;
2987 /* AK 150703 */
2988 {
2989 INT erg=OK;
2990 OP d;
2991 COP("scan_reversepartition(1)",c);
2992 spa:
2993 d = CALLOCOBJECT();
2994 erg += printeingabe("Please input a partition as decreasing vector");
2995 erg += printeingabe("of integers > 0.");
2996 erg += scan(INTEGERVECTOR,d);
2997 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),c);
2998 erg += reverse_vector(d,S_PA_S(c));
2999 FREEALL(d);
3000 if (partitionp(c) != TRUE) /* AK 170692 */
3001 {
3002 erg += printeingabe("Sorry, you did not enter a partition");
3003 erg += printeingabe("please try again.");
3004 FREESELF(c);
3005 goto spa;
3006 }
3007 ENDR("scan_partition");
3008 }
3009
3010
3011
3012
s_pa_s(a)3013 OP s_pa_s(a) OP a;
3014 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3015 /* AK V2.0 200298 */
3016 {
3017 OBJECTSELF c;
3018 c = s_o_s(a);
3019 return(c.ob_partition->pa_self);
3020 }
3021
s_pa_hash(a)3022 INT s_pa_hash(a) OP a;
3023 /* AK 240901 */
3024 {
3025 OBJECTSELF c;
3026 c = s_o_s(a);
3027 return(c.ob_partition->pa_hash);
3028 }
3029
s_pa_k(a)3030 OBJECTKIND s_pa_k(a) OP a;
3031 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3032 /* AK V2.0 200298 */
3033 {
3034 OBJECTSELF c;
3035 c = s_o_s(a);
3036 return(c.ob_partition->pa_kind);
3037 }
3038
s_pa_i(a,i)3039 OP s_pa_i(a,i) OP a; INT i;
3040 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3041 /* AK V2.0 200298 */
3042 {
3043 return(s_v_i(s_pa_s(a),i));
3044 }
3045
s_pa_ii(a,i)3046 INT s_pa_ii(a,i) OP a; INT i;
3047 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3048 /* AK V2.0 200298 */
3049 {
3050 INT erg = OK;
3051 CTO(PARTITION,"s_pa_ii",a);
3052 return(s_v_ii(s_pa_s(a),i));
3053 ENDR("s_pa_ii");
3054 }
3055
s_pa_l(a)3056 OP s_pa_l(a) OP a;
3057 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3058 /* AK V2.0 200298 */
3059 {
3060 INT erg = OK;
3061 CTO(PARTITION,"s_pa_l",a);
3062 return(s_v_l(s_pa_s(a)));
3063 ENDO("s_pa_l");
3064 }
3065
s_pa_li(a)3066 INT s_pa_li(a) OP a;
3067 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3068 {
3069 INT erg = OK;
3070 CTO(PARTITION,"s_pa_li",a);
3071 return(s_v_li(s_pa_s(a)));
3072 ENDR("s_pa_li");
3073 }
3074
c_pa_k(a,b)3075 INT c_pa_k(a,b) OP a; OBJECTKIND b;
3076 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3077 /* AK V2.0 200298 */
3078 {
3079 OBJECTSELF c;
3080 c = s_o_s(a);
3081 c.ob_partition->pa_kind = b;
3082 return(OK);
3083 }
3084
c_pa_s(a,b)3085 INT c_pa_s(a,b) OP a,b;
3086 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3087 /* AK V2.0 200298 */
3088 {
3089 OBJECTSELF c;
3090 c = s_o_s(a);
3091 c.ob_partition->pa_self = b;
3092 return(OK);
3093 }
3094
c_pa_hash(a,b)3095 INT c_pa_hash(a,b) OP a; INT b;
3096 /* AK 240901 */
3097 {
3098 OBJECTSELF c;
3099 c = s_o_s(a);
3100 c.ob_partition->pa_hash = b;
3101 return(OK);
3102 }
3103
3104
3105
3106
3107
3108
objectread_partition(filename,part)3109 INT objectread_partition(filename,part) OP part; FILE *filename;
3110 /* AK 291086 zum einlesen einer partition von einem file */
3111 /* AK 060789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
3112 /* AK V2.0 200298 */
3113 {
3114 INT kind;
3115 INT erg = OK;
3116 COP("objectread_partition(1)",filename);
3117 COP("objectread_partition(2)",part);
3118 fscanf(filename, "%" SCNINT ,&kind);
3119 erg += b_ks_pa((OBJECTKIND)kind, callocobject(),part);
3120 erg += objectread(filename,S_PA_S(part));
3121 if (S_PA_K(part) == VECTOR)
3122 C_O_K(S_PA_S(part),INTEGERVECTOR);
3123 /* AK 030502 to be compatible with old data */
3124 ENDR("objectread_partition");
3125 }
3126
objectwrite_partition(filename,part)3127 INT objectwrite_partition(filename,part) FILE *filename; OP part;
3128 /* AK 291086 */ /* zum schreiben einer partition auf einen file */
3129 /* AK 060789 V1.0 */ /* AK 200690 V1.1 */ /* AK 200891 V1.3 */
3130 /* AK V2.0 200298 */
3131 {
3132 INT erg = OK;
3133 COP("objectwrite_partition(1)",filename);
3134 COP("objectwrite_partition(2)",part);
3135 fprintf(filename, "%" PRIINT "\n" ,(INT)PARTITION);
3136 fprintf(filename, "%" PRIINT "\n",(INT)S_PA_K(part));
3137 erg += objectwrite(filename,S_PA_S(part));
3138 ENDR("objectwrite_partition");
3139 }
3140
3141
m_il_pa(i,p)3142 INT m_il_pa(i,p) INT i; OP p;
3143 /* AK 130803 */
3144 /* partition object of kind VECTOR of given length with undefined entries
3145 */
3146 {
3147 INT erg =OK;
3148 SYMCHECK(i<0,"m_il_pa: negative length");
3149 B_KS_PA(VECTOR,CALLOCOBJECT(),p);
3150 erg += m_il_integervector(i,S_PA_S(p));
3151 ENDR("m_il_pa");
3152 }
3153
t_VECTOR_EXPONENT(von,nach)3154 INT t_VECTOR_EXPONENT(von,nach) OP von,nach;
3155 /* AK 190588 */
3156 /* AK 060789 V1.0 */ /* AK 200690 V1.1 */ /* AK 200891 V1.3 */
3157 /* AK V2.0 020698 */
3158 /* in the exponent noattion the i-th entry of the vector
3159 contains the number of parts of size i+1
3160
3161
3162 e.g. 234 --> 011100000
3163 */
3164 {
3165 INT i,w;
3166 OP l;
3167 INT erg = OK;
3168 PART_CHECK_KIND("t_VECTOR_EXPONENT",von,VECTOR);
3169 CE2(von,nach,t_VECTOR_EXPONENT);
3170
3171 l=CALLOCOBJECT();
3172 PARTITION_WEIGHT(von,w);
3173 M_I_I(w,l);
3174 erg += b_ks_pa(EXPONENT,CALLOCOBJECT(),nach);
3175 erg += b_l_nv(l,S_PA_S(nach));
3176 C_O_K(S_PA_S(nach),INTEGERVECTOR);
3177
3178 for (i=(INT)0;i<S_PA_LI(von);i++)
3179 INC_INTEGER(S_PA_I(nach,S_PA_II(von,i) -(INT)1));
3180
3181 ENDR("t_VECTOR_EXPONENT");
3182 }
3183
t_EXPONENT_VECTOR_apply(a)3184 INT t_EXPONENT_VECTOR_apply(a) OP a;
3185 /* AK 051201 */
3186 {
3187 INT erg = OK;
3188 INT i,j,ba,s;
3189 OP c,l,z;
3190 PART_CHECK_KIND("t_EXPONENT_VECTOR_apply(1)",a,EXPONENT);
3191
3192
3193 j=(INT)0;ba=0;
3194 for (i=0,l=S_V_S(S_PA_S(a));i<S_PA_LI(a);i++,l++)
3195 if (S_I_I(l)>0) { j += S_I_I(l); ba=i; }
3196
3197 /* ba is the last non zero entry in a */
3198 if (t_exp_vec_app_c==NULL)
3199 {
3200 NEW_INTEGERVECTOR(c,j);
3201 t_exp_vec_app_c = c;
3202 }
3203 else {
3204 c = t_exp_vec_app_c;
3205 if (j > S_V_LI(c))
3206 erg += inc_vector_co(c,j-S_V_LI(c)+5);
3207 }
3208 s=j;
3209 for (i=0,z=S_V_S(c);i<=ba;i++)
3210 if (S_PA_II(a,i)>0)
3211 for (j=(INT)0;j<S_PA_II(a,i);j++)
3212 {
3213 M_I_I(i+1,z);
3214 z++;
3215 }
3216
3217 C_PA_K(a,VECTOR);
3218 if (S_PA_LI(a) < s)
3219 inc_vector_co(S_PA_S(a), s - S_PA_LI(a));
3220
3221 memcpy(S_V_S(S_PA_S(a)),S_V_S(c), s * sizeof(struct object));
3222 M_I_I(s,S_PA_L(a));
3223 ENDR("t_EXPONENT_VECTOR_apply");
3224 }
3225
3226
t_EXPONENT_VECTOR(a,b)3227 INT t_EXPONENT_VECTOR(a,b) OP a,b;
3228 /* AK 160988 */ /* AK 060789 V1.0 */ /* AK 200690 V1.1 */ /* AK 200891 V1.3 */
3229 /* AK V2.0 200298 */
3230 {
3231
3232 INT i,j,z=(INT)0,ba;
3233 INT erg = OK;
3234 OP l;
3235 PART_CHECK_KIND("t_EXPONENT_VECTOR(1)",a,EXPONENT);
3236 if (a==b) {
3237 erg += t_EXPONENT_VECTOR_apply(a);
3238 goto ende;
3239 }
3240
3241 j=(INT)0;ba=0;
3242 for (i=(INT)0;i<S_PA_LI(a);i++)
3243 if (S_PA_II(a,i)>0) { j += S_PA_II(a,i); ba=i; }
3244 /* ba is the last non zero entry in a */
3245 l = CALLOCOBJECT();
3246 M_I_I(j,l);
3247 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),b);
3248 erg += b_l_v(l,S_PA_S(b));
3249 C_O_K(S_PA_S(b), INTEGERVECTOR);
3250 for (i=(INT)0;i<=ba;i++)
3251 if (S_PA_II(a,i)>0)
3252 for (j=(INT)0;j<S_PA_II(a,i);j++)
3253 {
3254 M_I_I(i+(INT)1,S_PA_I(b,z));
3255 z++;
3256 };
3257 ende:
3258 ENDR("t_EXPONENT_VECTOR");
3259 }
3260
3261
3262
makevectorofpart(n,vec)3263 INT makevectorofpart(n,vec) OP n,vec;
3264 /* AK 200587 */ /* AK 060789 V1.0 */ /* AK 081289 V1.1 */ /* AK 130691 V1.2 */
3265 /* AK 200891 V1.3 */ /* AK V2.0 200298 */
3266 /* input: INTEGER object n
3267 output: VECTOR object with PARTITION objects of weight n */
3268 /* n and vec may be equal */
3269 {
3270 INT i,erg =OK;
3271 OP l;
3272 CTO(INTEGER,"makevectorofpart(1)",n);
3273 SYMCHECK((S_I_I(n) < (INT)0),"makevectorofpart:input < 0");
3274
3275 CE2(n,vec,makevectorofpart);
3276 l=callocobject();
3277 erg += numberofpart(n,l);
3278 erg += b_l_v(l,vec);
3279 erg += first_partition(n,S_V_I(vec,(INT)0));
3280 for (i=(INT)1;i<S_V_LI(vec);i++)
3281 erg += next_part_VECTOR(S_V_I(vec,(i-1)),S_V_I(vec,i));
3282
3283 ENDR("makevectorofpart");
3284 }
3285
makevectorofpart_EXPONENT(n,vec)3286 INT makevectorofpart_EXPONENT(n,vec) OP n,vec;
3287 /* AK 211100 */
3288 /* input: INTEGER object n
3289 output: VECTOR object with PARTITION objects of weight n of type EXPONENT*/
3290 /* n and vec may be equal */
3291 {
3292 INT i,erg =OK;
3293 OP l;
3294 CTO(INTEGER,"makevectorofpart_EXPONENT(1)",n);
3295 SYMCHECK(S_I_I(n) < 0,"makevectorofpart_EXPONENT:input < 0");
3296 CE2(n,vec,makevectorofpart_EXPONENT);
3297
3298 l=CALLOCOBJECT();
3299 erg += numberofpart(n,l);
3300 erg += b_l_v(l,vec);
3301 erg += first_part_EXPONENT(n,S_V_I(vec,(INT)0));
3302 for (i=1;i<S_V_LI(vec);i++)
3303 erg += next_part_EXPONENT(S_V_I(vec,(i-1)),S_V_I(vec,i));
3304
3305
3306 ENDR("makevectorofpart_EXPONENT");
3307 }
3308
3309
3310
3311
3312
weight_augpart(a,b)3313 INT weight_augpart(a,b) OP a,b;
3314 /* AK 160988 */ /* AK 060789 V1.0 */ /* AK 120390 V1.1 */ /* AK 130691 V1.2 */
3315 /* AK 200891 V1.3 */
3316 /* AK V2.0 200298 */
3317 {
3318 INT i,k=(INT)0;
3319 INT erg = OK;
3320 CTO(AUG_PART,"weight_augpart(1)",a);
3321
3322 for (i=S_PA_LI(a)-1;i>=(INT)0;i--) k = k + S_PA_II(a,i) - i;
3323
3324 M_I_I(k,b);
3325 ENDR("weight_augpart");
3326 }
3327
3328
3329
contain_comp_part(a,b)3330 INT contain_comp_part(a,b) OP a,b;
3331 /* AK V2.0 090298 */
3332 /* true if a sub b */
3333 {
3334 INT i;
3335 if (S_PA_LI(a) > S_PA_LI(b)) return FALSE;
3336 for (i=0;i<S_PA_LI(a);i++)
3337 {
3338 if (S_PA_II(a,S_PA_LI(a)-1-i) > S_PA_II(b,S_PA_LI(b)-1-i)) return FALSE;
3339 }
3340 return TRUE;
3341 }
3342
length_comp_part(a,b)3343 INT length_comp_part(a,b) OP a,b;
3344 /* returns 0 if equal length
3345 returns >0 if length(a) > length(b)
3346 returns <0 if length(a) < length(b)
3347 */
3348 /* AK 161001 */
3349 {
3350 INT erg = OK;
3351 PART_CHECK_KIND("length_comp_part(1)",a,VECTOR);
3352 PART_CHECK_KIND("length_comp_part(2)",b,VECTOR);
3353 return S_PA_LI(a) - S_PA_LI(b);
3354 ENDR("length_comp_part");
3355 }
3356
maxpart_comp_part(a,b)3357 INT maxpart_comp_part(a,b) OP a,b;
3358 /* returns 0 if equal maximal part
3359 returns >0 if maximal part(a) > maximal part(b)
3360 returns <0 if maximal part(a) < maximal part(b)
3361 */
3362 /* AK 191001 */
3363 {
3364 INT erg = OK;
3365 PART_CHECK_KIND("maxpart_comp_part(1)",a,VECTOR);
3366 PART_CHECK_KIND("maxpart_comp_part(2)",b,VECTOR);
3367 if (S_PA_LI(a) == 0)
3368 {
3369 if (S_PA_LI(b) == 0) return 0;
3370 else return -1;
3371 }
3372 if (S_PA_LI(b) == 0) return 1;
3373 return S_PA_II(a,S_PA_LI(a)-1) - S_PA_II(b,S_PA_LI(b)-1);
3374 ENDR("maxpart_comp_part");
3375 }
3376
3377
sub_comp_part(a,b)3378 INT sub_comp_part(a,b) OP a,b;
3379 /* returns 0 on equal
3380 1 if a bigger according to containment
3381 -1 if smaller
3382 NONCOMPARABLE else
3383 */
3384 /* AK V2.0 250298 */
3385 /* a and b may be equal */
3386 {
3387 INT erg=0,i,j;
3388 PART_CHECK_KIND("sub_comp_part",a,VECTOR);
3389 PART_CHECK_KIND("sub_comp_part",b,VECTOR);
3390
3391 for (i=S_PA_LI(a)-1, j=S_PA_LI(b)-1;i>=0;i--,j--)
3392 {
3393 if (j<(INT)0) /* length of a > length of b */
3394 {
3395 if (erg == -1) return NONCOMPARABLE;
3396 return 1;
3397 }
3398 if (S_PA_II(a,i) > S_PA_II(b,j))
3399 {
3400 if (erg == -1) return NONCOMPARABLE;
3401 erg = 1;
3402 continue;
3403 }
3404 if (S_PA_II(a,i) < S_PA_II(b,j))
3405 {
3406 if (erg == 1) return NONCOMPARABLE;
3407 erg = -1;
3408 continue;
3409 }
3410 }
3411 if (j >= 0)
3412 {
3413 return -1;
3414 }
3415 return erg;
3416 ENDR("sub_comp_part");
3417 }
3418
dom_comp_part(a,b)3419 INT dom_comp_part(a,b) OP a,b;
3420 /* returns 0 on equal
3421 1 if a bigger according dominance
3422 -1 smaller
3423 NONCOMPARABLE if not comparable */
3424 /* AK 140591 V1.2 */ /* AK 200891 V1.3 */
3425 /* AK V2.0 200298 */
3426 /* a and b may be equal */
3427 /* AK V3.1 131006 */
3428 {
3429 INT i,j,s1,s2;
3430 INT l,erg = (INT)0;
3431 PART_CHECK_KIND("dom_comp_part",a,VECTOR);
3432 PART_CHECK_KIND("dom_comp_part",b,VECTOR);
3433
3434 l = (S_PA_LI(a) > S_PA_LI(b)) ? S_PA_LI(a) : S_PA_LI(b) ;
3435 /* l is the length of the longer partition */
3436 for (i=(INT)0; i<l ; i++)
3437 /* all partial sums */
3438 {
3439 s1 = s2 = (INT)0;
3440 for (j=(INT)0;j<=i;j++)
3441 {
3442 if (j < S_PA_LI(a)) s1 += S_PA_II(a,S_PA_LI(a)-1-j);
3443 if (j < S_PA_LI(b)) s2 += S_PA_II(b,S_PA_LI(b)-1-j);
3444 }
3445 /* s1 is partialsum of a
3446 s2 is partialsum of b */
3447 if (erg == (INT)0)
3448 {
3449 if (s1 > s2) erg = (INT)1;
3450 if (s1 < s2) erg = (INT)-1;
3451 }
3452 else if ( erg == 1 )
3453 {
3454 if (s1 < s2) return NONCOMPARABLE; /* not comparable */
3455 }
3456 else if ( erg == -1 )
3457 {
3458 if (s1 > s2) return NONCOMPARABLE; /* not comparable */
3459 }
3460 else {
3461 erg = error("dom_comp_part:internal error");
3462 goto endr_ende;
3463 }
3464 }
3465 return erg;
3466 ENDR("dom_comp_part");
3467 }
3468
3469
3470
3471
even_partition(a,b)3472 INT even_partition(a,b) OP a,b;
3473 /* AK V2.0 200298 */
3474 /* AK V3.1 131006 */
3475 {
3476 OP c;
3477 INT erg;
3478 c = callocobject();
3479 weight(a,c);
3480 sub(c,S_PA_L(a),c);
3481 erg = even(c);
3482 freeall(c);
3483 return erg;
3484 }
3485
random_part_EXPONENT(n,b)3486 INT random_part_EXPONENT(n,b) OP n,b;
3487 /* AK V2.0 250298 */
3488 {
3489 return random_partition_exponent(n,b);
3490 }
3491
random_partition_exponent(n,b)3492 INT random_partition_exponent(n,b) OP n,b;
3493 /* new random partition nijnhuis wilf p.76 */
3494 /* AK 151092 also for longint */
3495 /* AK V2.0 200298 */
3496 /* input: INTEGER object
3497 output: PARTITION object of given weight in EXPONENT notation */
3498 /* AK V3.1 131006 */
3499 {
3500 OP k,z,multi,p,d,m,i,isum,is,i1,j;
3501 INT nlast;
3502 INT erg = OK;
3503
3504 CTO(INTEGER,"random_partition_exponent",n);
3505 CE2(n,b,random_partition_exponent);
3506
3507 if (S_I_I(n) < (INT)0)
3508 {
3509 erg += error("random_partition_exponent: n < 0");
3510 goto endr_ende;
3511 }
3512 else if (S_I_I(n) == (INT)0)
3513 {
3514 erg += first_part_EXPONENT(n,b);
3515 goto endr_ende;
3516 }
3517
3518 CALLOCOBJECT5(z,k,m,p,i);
3519 CALLOCOBJECT6(i1,j,is,isum,d,multi);
3520
3521 nlast = 0;
3522
3523 erg += m_l_nv(n,multi);
3524 erg += m_l_v(n,p);
3525 /* l10: */ if (S_I_I(n) <= nlast) goto l30;
3526 /* l20:*/ erg += m_i_i(1,S_V_I(p,(INT)0));
3527 erg += m_i_i(nlast + (INT)1, m);
3528 /* erg += add(nlast,cons_eins,m); */
3529 /* erg += copy_integer(n,nlast); */
3530 nlast = S_I_I(n);
3531 if (S_I_I(n) == (INT)1) goto l30;
3532 for(copy(m,i); le(i,n); inc(i))
3533 {
3534 erg += m_i_i((INT)0,isum);
3535 for (m_i_i(1,d); le(d,i); inc_integer(d) )
3536 {
3537 erg += m_i_i((INT)0,is);
3538 erg += copy(i,i1);
3539 l24: erg += sub(i1,d,i1);
3540 if (lt(i1,cons_null) ) goto l22;
3541 if (eq(i1,cons_null) ) goto l25;
3542 erg += add_apply(S_V_I(p,S_I_I(i1)-1),is);
3543 goto l24;
3544 l25: erg += inc(is);
3545 l22: erg += mult_apply(d,is);
3546 erg += add_apply(is,isum);
3547 }
3548 erg += ganzdiv(isum,i,S_V_I(p,S_I_I(i)-1));
3549 }
3550 l30: erg += copy(n,m);
3551 erg += m_i_i((INT)0,k);
3552 l40: erg += mult(m,S_V_I(p,S_I_I(m)-1),d);
3553 erg += random_integer(z,cons_eins,d);
3554 erg += m_i_i((INT)0,d);
3555 l110: erg += inc(d);
3556 /*l60:*/ erg += copy(m,i1);
3557 erg += m_i_i((INT)0,j);
3558 l150: erg += inc(j);
3559 /*l70:*/ erg += sub(i1,d,i1);
3560 /*l80:*/ if (lt(i1,cons_null)) goto l110;
3561 if (eq(i1,cons_null)) goto l90;
3562 erg += mult(d,S_V_I(p,S_I_I(i1)-1),is);
3563 erg += sub(z,is,z);
3564 /* l130: */ if (le(z,cons_null)) goto l145;
3565 goto l150;
3566 l90: erg += sub(z,d,z);
3567 /* l100: */ if (le(z,cons_null)) goto l145;
3568 goto l110;
3569 l145: erg += add_apply(j,S_V_I(multi,S_I_I(d)-1));
3570 erg += add_apply(j,k);
3571 /* l160:*/ erg += copy(i1,m);
3572 /*l170:*/ if (neq(m,cons_null)) goto l40;
3573
3574 FREEALL5(z,k,m,p,i);
3575 FREEALL5(i1,j,is,isum,d);
3576
3577 erg += b_ks_pa(EXPONENT,multi,b); /* do not free multi */
3578 ENDR("random_partition_exponent");
3579 }
3580
3581
random_partition(n,p)3582 INT random_partition(n,p) OP n,p;
3583 /* AK 230298 V2.0 */
3584 /* input: INTEGER object n
3585 output: PARTITION object of given weight in VECTOR notation */
3586 /* n and p may be equal */
3587 {
3588 OP c;
3589 INT erg = OK;
3590 CTO(INTEGER,"random_partition(1)",n);
3591 SYMCHECK(S_I_I(n)<0, "random_partition(1)<0");
3592
3593 if (S_I_I(n) < 2)
3594 erg += first_partition(n,p);
3595 else
3596 {
3597 c = CALLOCOBJECT();
3598 erg += random_partition_exponent(n,c);
3599 erg += t_EXPONENT_VECTOR(c,p);
3600 FREEALL(c);
3601 }
3602 ENDR("random_partition");
3603 }
3604
3605
t_FROBENIUS_VECTOR(a,b)3606 INT t_FROBENIUS_VECTOR(a,b) OP a,b;
3607 /* AK 270603 V2.0 */
3608 {
3609 INT erg =OK;
3610 OP l,r;
3611 INT d,i,k;
3612 PART_CHECK_KIND("t_FROBENIUS_VECTOR",a,FROBENIUS);
3613 CE2(a,b,t_FROBENIUS_VECTOR);
3614 r = S_V_I(S_PA_S(a),0); /* right of main dia */
3615 l = S_V_I(S_PA_S(a),1); /* left of main dia */
3616 d = S_V_LI(l); /* durfee size */
3617
3618 if (d == 0) {
3619 first_partition(cons_null,b);
3620 goto endr_ende;
3621 }
3622 erg += m_il_pa(S_V_II(l,0)+1, b);
3623
3624 for (i=0;i<d;i++) m_i_i(S_V_II(r,i)+1+i, S_PA_I(b,S_PA_LI(b)-1-i));
3625
3626
3627 for (; i<S_PA_LI(b);i++)
3628 {
3629 for (k=0;k<d;k++)
3630 if (S_V_II(l,k)-(d-k-1) < (i-d+1)) break;
3631 M_I_I(k, S_PA_I(b,S_PA_LI(b)-1-i));
3632 }
3633
3634 ENDR("t_FROBENIUS_VECTOR");
3635 }
3636
t_VECTOR_FROBENIUS(a,b)3637 INT t_VECTOR_FROBENIUS(a,b) OP a,b;
3638 /* AK V2.0 250298 */
3639 {
3640 return t_VECTOR_FROB(a,b);
3641 }
t_VECTOR_FROB(a,b)3642 INT t_VECTOR_FROB(a,b) OP a,b;
3643 /* AK 101292 */
3644 /* AK V2.0 200298 */
3645 {
3646 INT i,j;
3647 INT erg = OK;
3648 OP c;
3649 PART_CHECK_KIND("t_VECTOR_FROB",a,VECTOR);
3650 CE2(a,b,t_VECTOR_FROB);
3651
3652 erg += b_ks_pa(FROBENIUS,callocobject(),b);
3653 erg += m_il_v(2L,S_PA_S(b));
3654 if (S_PA_LI(a) == (INT)0)
3655 {
3656 erg += m_il_v((INT)0,S_V_I(S_PA_S(b),(INT)0));
3657 erg += m_il_v((INT)0,S_V_I(S_PA_S(b),1));
3658 goto endr_ende;
3659 }
3660 for (i=(INT)0, j=S_PA_LI(a)-1;(j>=0)&&(S_PA_II(a,j) > i); i++,j--) ;
3661 erg += m_il_v(i,S_V_I(S_PA_S(b),(INT)0));
3662 erg += m_il_v(i,S_V_I(S_PA_S(b),1));
3663 c = callocobject();
3664 erg += conjugate(a,c);
3665 for (j=(INT)0;j<S_V_LI(S_V_I(S_PA_S(b),(INT)0));j++)
3666 {
3667 erg += m_i_i(S_PA_II(a,S_PA_LI(a)-1-j)-1-j, S_V_I(S_V_I(S_PA_S(b),(INT)0),j));
3668 erg += m_i_i(S_PA_II(c,S_PA_LI(c)-1-j)-1-j, S_V_I(S_V_I(S_PA_S(b),1),j));
3669 }
3670 FREEALL(c);
3671 ENDR("t_VECTOR_FROB");
3672 }
3673
3674
t_PARTITION_CHARPARTITION(a,b)3675 /* offset necessary */ INT t_PARTITION_CHARPARTITION(a,b) OP a,b;
3676 /* only for internal use */
3677 /* AK V2.0 200298 */
3678 {
3679 INT erg = OK;
3680 char *v;
3681 if (a == b)
3682 return ERROR;
3683 if (S_PA_K(a) == FROBENIUS)
3684 return ERROR;
3685 erg += freeself(b);
3686 erg += b_ks_pa(S_PA_K(a), NULL, b);
3687 erg += t_INTVECTOR_UCHAR(S_PA_S(a), &v);
3688 C_PA_S(b,(OP)v);
3689 C_O_K(b,CHARPARTITION);
3690 return erg;
3691 }
3692
3693
c_PARTITION_CHARPARTITION(a)3694 INT c_PARTITION_CHARPARTITION(a) OP a;
3695 /* only for internal use */
3696 /* AK 170593 */
3697 /* AK V2.0 200298 */
3698 {
3699 INT erg = OK;
3700 OP c = callocobject();
3701 *c = *a;
3702 C_O_K(a,EMPTY);
3703 erg += t_PARTITION_CHARPARTITION(c,a);
3704 erg += freeall(c);
3705 return erg;
3706 }
3707
c_CHARPARTITION_PARTITION(a)3708 INT c_CHARPARTITION_PARTITION(a) OP a;
3709 /* only for internal use */
3710 /* AK 170593 */
3711 {
3712 INT erg = OK;
3713 OP c = callocobject();
3714 *c = *a;
3715 C_O_K(a,EMPTY);
3716 erg += t_CHARPARTITION_PARTITION(c,a);
3717 erg += freeall(c);
3718 return erg;
3719 }
3720
t_CHARPARTITION_PARTITION(a,b)3721 INT t_CHARPARTITION_PARTITION(a,b) OP a,b;
3722 /* only for internal use */
3723 {
3724 INT erg = OK;
3725 if (a == b)
3726 return ERROR;
3727 if (S_PA_K(a) == FROBENIUS)
3728 return ERROR;
3729 erg += freeself(b);
3730 erg += b_ks_pa(S_PA_K(a), callocobject(), b);
3731 erg += t_UCHAR_INTVECTOR(S_PA_S(a), S_PA_S(b));
3732 C_O_K(S_PA_S(b),INTEGERVECTOR);
3733 return erg;
3734 }
3735
3736
t_PARTITION_AUGPART(a,b)3737 INT t_PARTITION_AUGPART(a,b) OP a,b;
3738 /* AK 170593 */
3739 /* AK V2.0 200298 */
3740 {
3741 INT erg = OK;
3742 INT i;
3743 CTO(PARTITION,"t_PARTITION_AUGPART(1)",a);
3744 if (S_PA_K(a) != VECTOR)
3745 return ERROR;
3746 erg += copy(a,b);
3747 for (i=(INT)0;i<S_PA_LI(a);i++)
3748 M_I_I(S_PA_II(a,i)+i,S_PA_I(b,i));
3749 C_O_K(b,AUG_PART);
3750 ENDR("t_PARTITION_AUGPART");
3751 }
3752
c_CHARAUGPART_CHARPARTITION(a)3753 INT c_CHARAUGPART_CHARPARTITION(a) OP a;
3754 /* AK 170593 */
3755 /* AK V2.0 200298 */
3756 {
3757 INT erg = OK;
3758 INT i;
3759 if (S_O_K(a) != CHAR_AUG_PART)
3760 return ERROR;
3761 if (S_PA_K(a) != VECTOR)
3762 return ERROR;
3763 for (i=(INT)0;i<S_PA_CL(a);i++)
3764 S_PA_CII(a,i) = S_PA_CII(a,i)-i;
3765 C_O_K(a,CHARPARTITION);
3766 return erg;
3767 }
3768
c_CHARPARTITION_CHARAUGPART(a)3769 INT c_CHARPARTITION_CHARAUGPART(a) OP a;
3770 /* AK 170593 */
3771 /* AK V2.0 200298 */
3772 {
3773 INT erg = OK;
3774 INT i;
3775 if (S_O_K(a) != CHARPARTITION)
3776 return ERROR;
3777 if (S_PA_K(a) != VECTOR)
3778 return ERROR;
3779 for (i=(INT)0;i<S_PA_CL(a);i++)
3780 S_PA_CII(a,i) = S_PA_CII(a,i)+i;
3781 C_O_K(a,CHAR_AUG_PART);
3782 return erg;
3783 }
c_AUGPART_PARTITION(a)3784 INT c_AUGPART_PARTITION(a) OP a;
3785 /* AK 170593 */
3786 /* AK V2.0 200298 */
3787 {
3788 INT erg = OK;
3789 INT i;
3790 if (S_O_K(a) != AUG_PART)
3791 return ERROR;
3792 if (S_PA_K(a) != VECTOR)
3793 return ERROR;
3794 for (i=(INT)0;i<S_PA_LI(a);i++)
3795 M_I_I(S_PA_II(a,i)-i, S_PA_I(a,i));
3796 C_O_K(a,PARTITION);
3797 C_O_K(S_PA_S(a),INTEGERVECTOR);
3798 return erg;
3799 }
3800
c_PARTITION_AUGPART(a)3801 INT c_PARTITION_AUGPART(a) OP a;
3802 /* AK 170593 */
3803 /* AK V2.0 200298 */
3804 {
3805 INT erg = OK;
3806 INT i;
3807 if (S_O_K(a) != PARTITION)
3808 return ERROR;
3809 if (S_PA_K(a) != VECTOR)
3810 return ERROR;
3811 for (i=(INT)0;i<S_PA_LI(a);i++)
3812 M_I_I(S_PA_II(a,i)+i, S_PA_I(a,i));
3813 C_O_K(a,AUG_PART);
3814 return erg;
3815 }
3816
3817
3818
3819
3820 struct axelclaude {
3821 int nbl, nbc, contrib,rang;
3822 int *pdl, *pdc;
3823 int *mat;
3824 int *ligne_mat;
3825 };
3826
3827
row_column_matrices(a,c,e)3828 INT row_column_matrices(a,c,e) OP a,c,e;
3829 /* AK 131093 CP 031293 */
3830 /* AK V2.0 200298 */
3831 {
3832 int i;
3833 OP d;
3834 INT erg = OK;
3835 struct axelclaude aa;
3836
3837 if (S_O_K(a) == PARTITION)
3838 {
3839 if (S_PA_K(a) != VECTOR)
3840 return error("row_column_matrices requires VECTOR partitions");
3841 a = S_PA_S(a);
3842 }
3843 if (S_O_K(c) == PARTITION)
3844 {
3845 if (S_PA_K(c) != VECTOR)
3846 return error("row_column_matrices requires VECTOR partitions");
3847 c = S_PA_S(c);
3848 }
3849
3850 if ((not VECTORP(a)) || (not VECTORP(c)))
3851 {
3852 WTT("row_column_matrices",a,c);
3853 goto endr_ende;
3854 }
3855
3856 d = callocobject();
3857 aa.nbl=S_V_LI(a)+1;
3858 aa.nbc=S_V_LI(c)+1;
3859 aa.pdl = (int *) SYM_calloc(aa.nbl, sizeof(int));
3860 aa.pdc = (int *) SYM_calloc(aa.nbc, sizeof(int));
3861 aa.ligne_mat = (int *) SYM_calloc(aa.nbc, sizeof(int));
3862 aa.mat = (int *) SYM_calloc(aa.nbc * aa.nbl, sizeof(int));
3863
3864 for(i=0;i<S_V_LI(a);i++) aa.pdl[i+1]= S_V_II(a,i);
3865 for(i=0;i<S_V_LI(c);i++) aa.pdc[i+1]= S_V_II(c,i);
3866 erg += m_ilih_m(aa.nbc-1,aa.nbl-1,d);
3867 erg += m_il_v((INT)0,e);
3868 aa.contrib=aa.pdl[1];
3869 aa.rang=1;
3870 repartir(&aa,aa.rang,aa.contrib,aa.pdc,aa.ligne_mat,aa.nbc,d,e);
3871 SYM_free(aa.pdl);
3872 SYM_free(aa.pdc);
3873 SYM_free(aa.ligne_mat);
3874 SYM_free(aa.mat);
3875 FREEALL(d);
3876 ENDR("row_column_matrices");
3877 }
3878
3879 /******************************************************************
3880 * passage de aaaaaa a abbbbbb *
3881 ******************************************************************/
remplir(contrib,pdc,v,d,l)3882 static int remplir(contrib,pdc,v,d,l) int contrib, d, l, pdc[], v[];
3883 {
3884 int i, x;
3885 for(i=d;i<=l;i++) v[i] = 0;
3886 i = l;
3887 x = contrib;
3888 while(x>0) {
3889 if(i==d-1) return 0;
3890 if(x>=pdc[i]) {
3891 v[i]=pdc[i];
3892 x -= pdc[i--];
3893 }
3894 else {
3895 v[i] = x;
3896 x = 0;
3897 }
3898 }
3899 return 1;
3900 }
3901
3902 /**********************************************************************
3903 * partitions avec contraintes *
3904 **********************************************************************/
repartir(aa,rang,contrib,pdc,v,lv,dd,e)3905 static void repartir(aa,rang,contrib,pdc,v,lv,dd,e) OP dd,e;
3906 int rang, contrib, lv, pdc[], v[];
3907 struct axelclaude *aa;
3908 {
3909 int d,l,i;
3910 int *w, *pdcv;
3911 pdcv = (int *) SYM_calloc(lv,sizeof(int));
3912 w = (int *) SYM_calloc(lv,sizeof(int));
3913 d=1;
3914 l=lv-1;
3915 while(1) {
3916 remplir(contrib,pdc,v,d,l);
3917 utiliser(aa,rang,v,lv,dd,e);
3918 if(rang<aa->nbl-1) {
3919 for(i=1;i<=l;i++) pdcv[i]=pdc[i]-v[i];
3920 repartir(aa,rang+1,aa->pdl[rang+1],pdcv,w,lv,dd,e);
3921 }
3922 i=l-1;
3923 contrib = v[l];
3924 while(i>0) if(v[i]==pdc[i]) contrib += v[i--];
3925 else if(contrib==0) contrib=v[i--];
3926 else break;
3927 if(i>0) {
3928 v[i]++;
3929 contrib--;
3930 d=i+1;
3931 continue;
3932 }
3933 else break;
3934 }
3935 SYM_free(pdcv);
3936 SYM_free(w);
3937 }
3938
3939 /*******************************************************************
3940 * exploitation d'une ligne construite *
3941 *******************************************************************/
utiliser(aa,rang,v,lv,d,e)3942 static void utiliser(aa,rang,v,lv,d,e) OP d,e; struct axelclaude *aa; int rang,v[], lv;
3943 {
3944 int i, j;
3945 /* for(i=1;i<lv;i++) aa->mat[rang][i]=v[i]; */
3946 for(i=1;i<lv;i++) aa->mat[(rang*aa->nbc) +i]=v[i];
3947
3948 if(rang==aa->nbl-1) {
3949 inc(e);
3950 for(i=1;i<aa->nbl;i++) {
3951 for(j=1;j<lv;j++)
3952 M_I_I(aa->mat[(i*aa->nbc) +j],S_M_IJ(d,i-1,j-1) );
3953 }
3954 copy(d,S_V_I(e,S_V_LI(e)-1));
3955
3956 }
3957 }
3958
3959
3960 static INT sscan_partition_co();
sscan_reversepartition(t,a)3961 INT sscan_reversepartition(t,a) OP a; char *t;
3962 {
3963 INT erg = OK;
3964 OP d;
3965 sscan_partition_co(t,a);
3966 d=CALLOCOBJECT();
3967 reverse_vector(S_PA_S(a),d);
3968 COPY(d,S_PA_S(a));
3969 FREEALL(d);
3970 SYMCHECK (not partitionp(a),"sscan_reversepartition:no partition entered");
3971 ENDR("sscan_reversepartition");
3972 }
sscan_partition(t,a)3973 INT sscan_partition(t,a) OP a; char *t;
3974 {
3975 INT erg = OK;
3976 sscan_partition_co(t,a);
3977 SYMCHECK (not partitionp(a),"sscan_reversepartition:no partition entered");
3978 ENDR("sscan_partition");
3979 }
3980
sscan_partition_co(t,a)3981 static INT sscan_partition_co(t,a) OP a; char *t;
3982 /* AK 050194 to read partition from string
3983 format [1,2,3,23,23,33]
3984 */
3985 /* AK 230298 V2.0 */
3986 {
3987 INT i,n,erg = OK;
3988 int SYM_isdigit();
3989 char *v,*w;
3990
3991 COP("sscan_partition(1)",t);
3992 COP("sscan_partition(2)",a);
3993 v = t;
3994 while (*v == ' ') v++;
3995 if (*v != '[')
3996 {erg = ERROR; goto spe;}
3997 w = v; n = (INT)1;
3998 /* now we count the number of parts */
3999 w++;
4000 while (*w != ']')
4001 {
4002 if (*w == ',') n++;
4003 else if (not SYM_isdigit(*w))
4004 {erg = ERROR; goto spe;}
4005 w++;
4006 }
4007 /* n is the number of parts */
4008 b_ks_pa(VECTOR,callocobject(),a);
4009 m_il_v(n,S_PA_S(a));
4010 C_O_K(S_PA_S(a),INTEGERVECTOR);
4011 w = v;
4012 w++;
4013 for (i=(INT)0; i<n; i++)
4014 {
4015 erg += sscan(w,INTEGER,S_PA_I(a,i));
4016 if (erg != OK) goto spe;
4017
4018 while (SYM_isdigit(*w)) w++;
4019 w++;
4020 }
4021 spe:
4022 if (erg != OK)
4023 fprintf(stderr,"string = %s\n",t);
4024 ENDR("sscan_partition");
4025 }
4026
4027
cast_apply_part(a)4028 INT cast_apply_part(a) OP a;
4029 /* AK 280294 */
4030 /* AK 230298 V2.0 */
4031 {
4032 INT erg = OK;
4033 COP("cast_apply_part(1)",a);
4034 switch(S_O_K(a))
4035 {
4036 case INTEGER:
4037 erg += m_i_pa(a,a);
4038 break;
4039 case VECTOR:
4040 erg += m_v_pa(a,a);
4041 break;
4042 default:
4043 printobjectkind(a);
4044 erg += error("cast_apply_part: can not cast");
4045 break;
4046 }
4047 ENDR("cast_apply_part");
4048 }
4049
equal_parts(a,b)4050 INT equal_parts(a,b) OP a,b;
4051 /* return TRUE if PART a has >= b equal parts */
4052 /* AK 230298 V2.0 */
4053 {
4054 INT erg = OK;
4055 INT i,j=0,k=0;
4056 CTO( PARTITION,"equal_parts",a);
4057 CTO( INTEGER,"equal_parts",b);
4058 if (S_I_I(b) <= (INT)0)
4059 {
4060 erg += error("equal_parts:integer object not bigger 0");
4061 goto endr_ende;
4062 }
4063
4064 if (S_PA_K(a) == EXPONENT)
4065 {
4066 for (i=0;i<S_PA_LI(a);i++)
4067 if (S_PA_II(a,i) >= S_I_I(b)) return TRUE;
4068 return FALSE;
4069 }
4070 if (S_PA_K(a) != VECTOR)
4071 {
4072 erg += error("equal_parts: partition object not VECTOR kind");
4073 goto endr_ende;
4074 }
4075
4076 for (i=0;i<S_PA_LI(a);i++)
4077 {
4078 if (S_PA_II(a,i) == k) j++;
4079 else { k = S_PA_II(a,i); j= 1; }
4080 if (j == S_I_I(b)) return TRUE;
4081 }
4082 return FALSE;
4083 ENDR("equal_parts");
4084 }
4085
q_core(a,b,d)4086 INT q_core(a,b,d) OP a,b,d;
4087 /* computes the remaining partition after
4088 removal of all hooks of length q */
4089 {
4090 INT erg = OK;
4091 OP e;
4092 e = CALLOCOBJECT();
4093 q_core_sign(a,b,d,e);
4094 FREEALL(e);
4095 ENDR("q_core");
4096 }
4097
q_core_sign(a,b,d,si)4098 INT q_core_sign(a,b,d,si) OP a,b,d; OP si;
4099 /* computes the remaining partition after
4100 removal of all hooks of length q */
4101 /* sign = +/- 1 according to the parity of the sum of li lengths */
4102 /* AK 301095 */
4103 /* AK 230298 V2.0 */
4104 /* AK 090703 sign added */
4105 {
4106 INT erg = OK,i,j,bi,hi,li;
4107 OP e;
4108 PART_CHECK_KIND("q_core_sign(1)",a,VECTOR);
4109 CTO(INTEGER,"q_core_sign(2)",b);
4110 SYMCHECK(S_I_I(b)<1,"q_core_sign:q<1");
4111 if ( (a == d) || (a==si) ) {
4112 e = CALLOCOBJECT();
4113 COPY(a,e);
4114 erg += q_core_sign(e,b,d,si);
4115 goto endr_ende;
4116 }
4117 else if ( (b == d) || (b==si) ) {
4118 e = CALLOCOBJECT();
4119 COPY(b,e);
4120 erg += q_core_sign(a,e,d,si);
4121 goto endr_ende;
4122 }
4123 else {
4124 FREESELF(d);
4125 FREESELF(si);
4126 }
4127
4128 e = CALLOCOBJECT();
4129 M_I_I(1,si);
4130 erg += copy_partition(a,d);
4131 bi = S_I_I(b);
4132 aa:
4133 for (i=0;i<S_PA_LI(d);i++)
4134 for (j=0;j<S_PA_II(d,S_PA_LI(d)-1-i);j++)
4135 {
4136 /* erg += hook_length(d,i,j,e); */
4137 hi = S_PA_II(d,S_PA_LI(d)-1-i)-j; /* arm length +1 */
4138 li = 0;
4139 do {
4140 if ( S_PA_LI(d)-1-i-li < 0) { li--; break;}
4141 if ( S_PA_II(d, S_PA_LI(d)-1-i-li) < j+1) { li--; break;}
4142 li ++;
4143 } while (1);
4144 /* li = leg lenth */
4145 if ((li+hi) == bi)
4146 {
4147 if ((li % 2) == 1) M_I_I(-S_I_I(si),si);
4148
4149 erg += remove_hook(d,i,j,d);
4150 if (EMPTYP(d)) goto bb;
4151 goto aa; }
4152 }
4153 bb:
4154 erg += freeall(e);
4155 ENDR("q_core_sign");
4156 }
4157
4158
remove_hook(a,i,j,c)4159 INT remove_hook(a,i,j,c) OP a,c; INT i,j;
4160 /* AK 301095 */
4161 /* AK 230298 V2.0 */
4162 /* a may be identical to c */
4163 {
4164 INT erg =OK,k;
4165 OP d;
4166 CTO (PARTITION ,"remove_hook(1)",a);
4167 SYMCHECK(S_PA_K(a) != VECTOR,
4168 "remove_hook(1):only vector partition type");
4169
4170 if (i >= S_PA_LI(a))
4171 {
4172 if (a!= c) COPY(a,c);
4173 }
4174 else if (j >= S_PA_II(a,S_PA_LI(a)-1-i))
4175 {
4176 if (a!= c) COPY(a,c);
4177 }
4178 else {
4179 d = CALLOCOBJECT();
4180 COPY(S_PA_S(a),d);
4181 M_I_I(j,S_V_I(d,S_PA_LI(a)-i-1));
4182 for (k=i+1; k<S_PA_LI(a); k++)
4183 if (S_PA_II(a,S_PA_LI(a)-1-k) -1 >= j)
4184 {
4185 DEC_INTEGER(S_V_I(d,S_PA_LI(a)-1-k));
4186 COPY_INTEGER(S_V_I(d,S_PA_LI(a)-1-k),S_V_I(d,S_PA_LI(a)-k));
4187 }
4188 else {
4189 m_i_i(j,S_V_I(d,S_PA_LI(a)-k));
4190 break;
4191 }
4192 if (k == S_PA_LI(a))
4193 M_I_I(j,S_V_I(d,0));
4194 erg += m_v_pa(d,c);
4195 FREEALL(d);
4196 }
4197 ENDR("remove_hook");
4198
4199 }
4200
p_hook_diagramm(a,b,c)4201 INT p_hook_diagramm(a,b,c) OP a,b,c;
4202 /* AK 010295 */
4203 /* AK 230298 V2.0 */
4204 /* input: PARTITION object a
4205 INTEGER object b
4206 output: hook diagramm with entry = hooklength mod b */
4207 {
4208 INT erg=OK,i,j,k,l;
4209
4210 CTO(INTEGER,"p_hook_diagramm(2)",b);
4211 PART_CHECK_KIND("p_hook_diagramm(1)",a,VECTOR);
4212 CE3(a,b,c,p_hook_diagramm);
4213
4214
4215 if (S_I_I(b) < (INT) 0)
4216 {
4217 erg += error("p_hook_diagramm: second parameter < 0");
4218 goto endr_ende;
4219 }
4220 erg += hook_diagramm(a,c);
4221 if (S_I_I(b) == (INT)0) goto ee;
4222 if (S_I_I(b) == (INT)1) goto ee;
4223 for (i=0;i<S_M_HI(c);i++)
4224 for (j=0;j<S_M_LI(c);j++)
4225 {
4226 if (S_M_IJI(c,i,j) == (INT)0)
4227 {
4228 C_O_K(S_M_IJ(c,i,j),EMPTY);
4229 }
4230 else
4231 {
4232 k = S_I_I(b);
4233 l = 1;
4234 while (S_M_IJI(c,i,j)%k == 0)
4235 {l++;k *= S_I_I(b);
4236 }
4237 M_I_I(l-1,S_M_IJ(c,i,j));
4238 }
4239 }
4240
4241 ee:
4242 CTTO(INTEGERMATRIX,MATRIX,"p_hook_diagramm(3e)",c);
4243 ENDR("p_hook_diagramm");
4244 }
4245
4246
odd_to_strict_part(a,b)4247 INT odd_to_strict_part(a,b) OP a,b;
4248 /* AK 020196 */
4249 /* AK V2.0 090298 */
4250 /* input: odd PARTITION object
4251 output: corresponding strict PARTITION object */
4252
4253 /* a and b may be the same object */
4254 {
4255 INT erg = OK;
4256 OP c,d;
4257 INT i,j,k,l;
4258 CTO(PARTITION,"odd_to_strict_part(1)",a);
4259
4260 c = callocobject();
4261 d = callocobject();
4262 erg += t_VECTOR_EXPONENT(a,c);
4263 erg += weight(a,d);
4264 erg += m_il_nv(S_I_I(d),d);
4265 l = 0;
4266 for (i=0;i<S_PA_LI(c);i++)
4267 {
4268 if (S_PA_II(c,i) != 0)
4269 {
4270 j=1;k=S_PA_II(c,i);
4271 aa:
4272 if (k % 2) {
4273 erg += m_i_i((i+1)*j,S_V_I(d,l));
4274 l++;
4275 }
4276 k /=2 ;
4277 j *= 2;
4278 if (j <= S_PA_II(c,i)) goto aa;
4279 }
4280 }
4281 erg += m_v_pa(d,b);
4282 erg += freeall(c);
4283 erg += freeall(d);
4284 ENDR("odd_to_strict_part");
4285 }
4286
strict_to_odd_part(a,b)4287 INT strict_to_odd_part(a,b) OP a,b;
4288 /* AK 020196 */
4289 /* AK V2.0 090298 */
4290 /* input: strict PARTITION object
4291 output: corresponding PARTITION object with odd parts */
4292
4293 /* a and b may be the same object */
4294 {
4295 INT erg = OK;
4296 INT i,k,l=0,j;
4297 OP c;
4298 CTO(PARTITION,"strict_to_odd_part(1)",a);
4299 c = callocobject();
4300 erg += weight(a,c);
4301 erg += m_il_nv(S_I_I(c),c);
4302 for (i=0;i<S_PA_LI(a);i++)
4303 {
4304 k = S_PA_II(a,i);
4305 if ((k%2) == 1)
4306 {
4307 erg += m_i_i(k,S_V_I(c,l)); l++;
4308 }
4309 else {
4310 j=4;
4311 aa:
4312 if ((k%j) == 0) {j *= 2; goto aa;}
4313 j /= 2; /* j ist die hoechste 2er potenz die passt */
4314 k = k/j;
4315 for (;j>0;j--)
4316 {
4317 erg += m_i_i(k,S_V_I(c,l)); l++;
4318 }
4319 }
4320 }
4321 erg += m_v_pa(c,b);
4322 erg += freeall(c);
4323 ENDR("strict_to_odd_part");
4324 }
4325
4326
4327
nachfolger_young(a,b)4328 INT nachfolger_young(a,b) OP a,b;
4329 /* input: PARTITION object a
4330 output: VECTOR object of PARTITION objects, which are
4331 bigger neighbours in the Young poset */
4332 /* AK V2.0 170298 */
4333 /* a and b may be equal */
4334 {
4335 INT erg = OK,k;
4336 OP c,z;
4337 CTO(PARTITION,"nachfolger_young",a);
4338 c = callocobject();
4339 erg += first_partition(cons_eins,c);
4340 erg += outerproduct_schur(c,a,c);
4341 k=0; z = c;
4342 while (z != NULL) { k++; z = S_L_N(z); }
4343 erg += m_il_v(k,b);
4344 k=0; z = c;
4345 while (z != NULL) {
4346 erg += copy_partition(S_S_S(z), S_V_I(b,k)); k++; z = S_L_N(z); }
4347 erg += freeall(c);
4348 ENDR("nachfolger_young");
4349 }
4350
4351
4352
vorgaenger_young(a,b)4353 INT vorgaenger_young(a,b) OP a,b;
4354 /* input: PARTITION object a
4355 output: VECTOR object of PARTITION objects,
4356 which are smaller neighbours in the Young poset */
4357 /* AK V2.0 170298 */
4358 /* a and b may be equal */
4359 {
4360 INT erg = OK,k;
4361 OP c,z;
4362 CTTO(SKEWPARTITION,PARTITION,"vorgaenger_young(1)",a);
4363 if (S_O_K(a) == SKEWPARTITION)
4364 {
4365 CE2(a,b,vorgaenger_young_skewpartition);
4366 erg += vorgaenger_young_skewpartition(a,b);
4367 goto ende;
4368 }
4369 SYMCHECK (S_PA_LI(a) == 0, "vorgaenger_young: partition of weight 0 not allowed");
4370 c = CALLOCOBJECT();
4371 erg += first_partition(cons_eins,c);
4372 erg += part_part_skewschur(a,c,c);
4373 k=0; z = c;
4374 while (z != NULL) { k++; z = S_L_N(z); }
4375 erg += m_il_v(k,b);
4376 k=0; z = c;
4377 while (z != NULL) {
4378 erg += copy_partition(S_S_S(z), S_V_I(b,k));
4379 k++;
4380 z = S_L_N(z);
4381 }
4382 FREEALL(c);
4383 ende:
4384 ENDR("vorgaenger_young");
4385 }
4386
vorgaenger_young_skewpartition(a,b)4387 INT vorgaenger_young_skewpartition(a,b) OP a,b;
4388 /* input: SKEWPART object a
4389 EMPTY object b
4390 output: VECTOR object b of SKEWPART objects,
4391 which are smaller neighbours in the Young poset */
4392 /* AK V2.0 280602 */
4393 {
4394 INT erg = OK,i,kl;
4395 OP g,k;
4396 CTO(SKEWPARTITION,"vorgaenger_young_skewpartition(1)",a);
4397 CTO(EMPTY,"vorgaenger_young_skewpartition(2)",b);
4398 g = S_SPA_G(a);
4399 k = S_SPA_K(a);
4400
4401 SYMCHECK( EQ(g,k), "vorgaenger_young_skewpartition: partition of weight 0 not allowed");
4402
4403 erg += init(BINTREE,b);
4404
4405 if (S_PA_LI(g) == 1)
4406 {
4407 OP c;
4408 c = CALLOCOBJECT();
4409 m_gk_spa(g,k,c);
4410 DEC_INTEGER(S_SPA_GI(c,0));
4411 insert(c,b,NULL,NULL);
4412 goto ende;
4413 }
4414
4415 /* in der ersten zeile kann evtl ein stein entfernt werden */
4416
4417 if (S_PA_LI(k) < S_PA_LI(g)) {
4418 OP c;
4419 c = CALLOCOBJECT();
4420 m_gk_spa(g,k,c);
4421 if (S_PA_II(g,0) == 1)
4422 {
4423 FREESELF(S_SPA_G(c));
4424 remove_part_integer(S_SPA_G(a),cons_eins,S_SPA_G(c));
4425 }
4426 else
4427 DEC_INTEGER(S_SPA_GI(c,0));
4428 insert(c,b,NULL,NULL);
4429 }
4430 else
4431 if (S_PA_II(g,0) > S_PA_II(k,0))
4432 {
4433 OP c;
4434 c = CALLOCOBJECT();
4435 m_gk_spa(g,k,c);
4436 DEC_INTEGER(S_SPA_GI(c,0));
4437 insert(c,b,NULL,NULL);
4438 }
4439
4440
4441 for (i=1;i<S_PA_LI(g);i++)
4442 if (S_PA_II(g,i) > S_PA_II(g,i-1)) {
4443 kl = S_PA_LI(k) - (S_PA_LI(g)-i);
4444 if (kl < 0)
4445 {
4446 OP c;
4447 c = CALLOCOBJECT();
4448 m_gk_spa(g,k,c);println(c);
4449 DEC_INTEGER(S_SPA_GI(c,i));println(c);
4450 insert(c,b,NULL,NULL);
4451 }
4452 else if (S_PA_II(g,i) > S_PA_II(k,i-(S_PA_LI(g)-S_PA_LI(k)) ))
4453 {
4454 OP c;
4455 c = CALLOCOBJECT();
4456 m_gk_spa(g,k,c);println(c);
4457 DEC_INTEGER(S_SPA_GI(c,i));println(c);
4458 insert(c,b,NULL,NULL);
4459 }
4460 }
4461 ende:
4462 t_BINTREE_VECTOR(b,b);
4463 ENDR("vorgaenger_young_skewpartition");
4464 }
4465
4466
character_polynom(a,b)4467 INT character_polynom(a,b) OP a,b;
4468 /* AK 040892 */
4469 /* AK 161006 V3.1 */
4470 {
4471 INT erg = OK;
4472 INT i,wi=0;
4473 OP l,lp,p,res,v;
4474 PART_CHECK_KIND("character_polynom(1)",a,VECTOR);
4475
4476 if (S_PA_LI(a) == (INT)0)
4477 {
4478 erg += m_scalar_polynom(cons_eins,b);
4479 goto endr_ende;
4480 }
4481
4482 CE2(a,b,character_polynom);
4483 C1R(a,"character_polynom",b);
4484
4485
4486 CALLOCOBJECT4(l,lp,p,v);
4487
4488 COPY(S_PA_L(a),l);
4489 INC(l);
4490 COPY(a,lp);
4491 erg += first_permutation(l,p);
4492 erg += young_polynom(a,b);
4493 while (next_apply(p))
4494 {
4495 CLEVER_COPY(S_PA_S(a),v);
4496 for (i=1;i<S_P_LI(p);i++)
4497 {
4498 wi=S_V_II(v,S_V_LI(v)-i)+S_P_II(p,i)-i-1;
4499 if (wi<(INT)0) break;
4500 erg += m_i_i( wi,
4501 S_V_I(v,S_V_LI(v)-i)
4502 );
4503 }
4504 if (wi<(INT)0) continue;
4505 erg += m_v_pa(v,lp);
4506 res = callocobject();
4507 erg += young_polynom(lp,res);
4508 if (oddp(p))
4509 erg += addinvers_apply(res);
4510 insert(res,b,NULL,NULL);
4511
4512 }
4513 FREEALL4(l,lp,p,v);
4514
4515 S1R(a,"character_polynom",b);
4516 ENDR("character_polynom");
4517 }
4518
young_polynom(a,l)4519 INT young_polynom(a,l) OP a,l;
4520 /* AK 040892 */
4521 /* AK 16106 V3.1 */
4522 {
4523 OP b , c ,e , d , n,m ,f;
4524 INT i,j,k,wi,ii;
4525 INT erg = OK;
4526 PART_CHECK_KIND("young_polynom(1)",a,VECTOR);
4527 if (S_PA_LI(a) == 0)
4528 {
4529 erg += m_scalar_polynom(cons_eins,l);
4530 goto endr_ende;
4531 }
4532 C1R(a,"young_polynom",l);
4533
4534 CALLOCOBJECT7(b,f,d,n,c,e,m);
4535
4536 erg += weight(a,b); wi = S_I_I(b);
4537 erg += m_il_v(S_PA_LI(a),b);
4538 erg += m_i_i((INT)0,l);
4539 for (i=(INT)0;i<S_V_LI(b);i++)
4540 erg += first_part_EXPONENT(S_PA_I(a,i),S_V_I(b,i));
4541 do {
4542 erg += m_i_i(1,n);
4543 for (i=(INT)0;i<wi;i++)
4544 {
4545 erg += m_il_nv(S_PA_LI(a),c);
4546 k=(INT)0;
4547 for (ii=(INT)0;ii<S_PA_LI(a);ii++)
4548 {
4549 if (i<S_PA_II(a,ii))
4550 m_i_i(S_PA_II(S_V_I(b,ii),i),S_V_I(c,ii));
4551 if (i<S_PA_II(a,ii))
4552 k+=S_PA_II(S_V_I(b,ii),i);
4553 }
4554 if (k>(INT)0)
4555 {
4556 erg += m_i_i(k,d);
4557 erg += multinom(d,c,e);
4558 erg += m_iindex_monom(i,f);
4559 erg += binom(f,d,m);
4560 MULT_APPLY(e,m);
4561 MULT_APPLY(m,n);
4562 }
4563 }
4564 ADD_APPLY(n,l);
4565 j=(INT)0;
4566 if (S_V_LI(b) == 0) break; /* AK 060498 */
4567 while (not next(S_V_I(b,j),S_V_I(b,j)))
4568 {
4569 j++;
4570 if (j==S_V_LI(b)) break;
4571 }
4572 if (j == S_V_LI(b)) break;
4573 /* links von der stelle wo erhoeht wurd muss auf null gesetzt werden */
4574 for (j--;j>=(INT)0;j--)
4575 erg += first_part_EXPONENT(S_PA_I(a,j),S_V_I(b,j));
4576 } while(1);
4577 /* alle partitionen durchlaufen */
4578
4579 FREEALL7(b,f,d,n,c,e,m);
4580
4581 S1R(a,"young_polynom",l);
4582 ENDR("young_polynom");
4583 }
4584
4585
is_graphical(a)4586 INT is_graphical(a) OP a;
4587 /* return TRUE if graphical partition */
4588 /* i.e. a vertex degree sequence of a simple
4589 undirected graph, uses the criterion of haesselbarth
4590 see: barnes, savage: a reucrrence for counting graphical partitions
4591 */
4592 /* AK 161006 V3.1 */
4593 {
4594 INT erg = OK,r;
4595 CTO(PARTITION,"is_graphical(1)",a);
4596 SYMCHECK(S_PA_K(a) != VECTOR,"is_graphical no vector type");
4597 {
4598 INT i,j=0;
4599 OP b;
4600 INT res = TRUE;
4601
4602 for (i=0; i<S_PA_LI(a);i++) j+=S_PA_II(a,i);
4603 if (j%2 == 1) { res=FALSE; goto ff; } /* AK 111006 */
4604
4605 for (i=1; i<=S_PA_LI(a);i++)
4606 if (S_PA_II(a,S_PA_LI(a)-i) <i) break;
4607 i--;
4608 /* i is the size of the durfee square */
4609
4610 /* printf("durfee size = %d\n",i); */
4611
4612 b=CALLOCOBJECT();
4613 conjugate(a,b);
4614
4615 #ifdef UNDEF
4616 for (j=1; j<=i;j++)
4617 {
4618 INT k,r;
4619 r = 0;
4620 for (k=1;k<=j;k++)
4621 r += (S_PA_II(b,S_PA_LI(b)-k) - S_PA_II(a,S_PA_LI(a)-k));
4622 if (r < j) { res = FALSE; goto ee; }
4623 }
4624 #endif
4625 r=0;
4626 for (j=1; j<=i;j++)
4627 {
4628 r+= (S_PA_II(a,S_PA_LI(a)-j) - S_PA_II(b,S_PA_LI(b)-j));
4629 /* printf("r= %d ",r); */
4630 if (r> -j) { res = FALSE; goto ee; }
4631 }
4632 ee:
4633 FREEALL(b);
4634 ff:
4635 return res;
4636 }
4637 ENDR("is_graphical");
4638 }
4639
multiplicity_part(part,i)4640 INT multiplicity_part(part,i) OP part; INT i;
4641 /* AK 210503 */
4642 /* return the multiplicty of part i in the partition part */
4643 {
4644 INT erg = OK;
4645 CTO(PARTITION,"multiplicity_part",part);
4646 SYMCHECK(i<=0,"multiplicity_part: checked part must be > 0");
4647 if (S_PA_K(part) == VECTOR)
4648 {
4649 OP z;
4650 INT j=S_PA_LI(part)-1;
4651 do {
4652 z = S_PA_I(part,j);
4653 if (S_I_I(z) < i) return 0;
4654 else if (S_I_I(z) == i)
4655 {
4656 erg = 1;
4657 j--;
4658 while (j>=0) { z = S_PA_I(part,j); if (S_I_I(z) != i) return erg;
4659 j--; erg ++; }
4660 return erg;
4661 }
4662 else j--;
4663 } while (j>=0);
4664 return 0;
4665 }
4666 else if (S_PA_K(part) == EXPONENT)
4667 {
4668 if (i > S_PA_LI(part)) return 0;
4669 return S_PA_II(part,i-1);
4670 }
4671 else {
4672 error("multiplicity_part: wrong kind of partition");
4673 }
4674
4675 ENDR("multiplicity_part");
4676 }
4677
durfee_size_part(a,b)4678 INT durfee_size_part(a,b) OP a,b;
4679 /* AK 260603 */
4680 {
4681 INT erg =OK;
4682 CTO(PARTITION,"durfee_size_part(1)",a);
4683 if (S_PA_K(a)==VECTOR)
4684 {
4685 INT i,j;
4686 for (i=1; i<=S_PA_LI(a);i++)
4687 if (S_PA_II(a,S_PA_LI(a)-i) <i) break;
4688 m_i_i(--i,b);
4689 }
4690 else {
4691 erg += error("durfee_size_part:wrong type of partition");
4692 }
4693 ENDR("durfee_size_part");
4694 }
4695
hook_partition(a,i,j,b)4696 INT hook_partition(a,i,j,b) OP a,b; INT i,j;
4697 /* AK 260603 */
4698 /* computes the hook at position (i,j) of the diagram */
4699 {
4700 INT erg = OK;
4701 CTO(PARTITION,"hook_partition(1)",a);
4702 SYMCHECK(i<0,"hook_partition(2)<0");
4703 SYMCHECK(j<0,"hook_partition(3)<0");
4704 if (S_PA_K(a)==VECTOR)
4705 {
4706 if (i>=S_PA_LI(a)) first_partition(cons_null,b);
4707 else if (j>=S_PA_II(a,S_PA_LI(a)-1-i)) first_partition(cons_null,b);
4708 else {
4709 INT armlength, footlength;
4710 OP c;
4711 armlength=S_PA_II(a,S_PA_LI(a)-1-i)-1-j;
4712 for (footlength = 0; footlength < S_PA_LI(a)-1-i; footlength++)
4713 if (S_PA_II(a,S_PA_LI(a)- i-1-footlength) <= j) {footlength--;break;}
4714
4715 c=CALLOCOBJECT();
4716 m_il_v(footlength+1,c);
4717 for (;footlength>=0;footlength--)
4718 M_I_I(1,S_V_I(c,footlength));
4719 M_I_I(armlength+1,S_V_I(c,S_V_LI(c)-1));
4720 C_O_K(c,INTEGERVECTOR);
4721 b_ks_pa(VECTOR,c,b);
4722 }
4723 }
4724 else {
4725 erg += error("hook_partition:wrong type of partition");
4726 }
4727 ENDR("hook_partition");
4728 }
4729
4730
ribbon_partition(a,i,j,b)4731 INT ribbon_partition(a,i,j,b) INT i,j; OP a,b;
4732 /* AK 270603 */
4733 /* computes the ribbon = skew partition
4734 corresponding to the hook at position i,j
4735 */
4736 {
4737 INT erg = OK;
4738 CTO(PARTITION,"ribbon_partition(1)",a);
4739 SYMCHECK(i<0,"ribbon_partition(2):<0");
4740 SYMCHECK(j<0,"ribbon_partition(3):<0");
4741 if (S_PA_K(a) == VECTOR)
4742 {
4743 OP d;
4744 SYMCHECK(i>=S_PA_LI(a),"ribbon_partition(2):> length of partition");
4745 SYMCHECK(j>=S_PA_II(a,S_PA_LI(a)-1-i),"ribbon_partition(3):> size of part");
4746 d = CALLOCOBJECT();
4747 t_VECTOR_FROBENIUS(a,d);
4748 delete_entry_vector(S_V_I(S_PA_S(d),0),i,S_V_I(S_PA_S(d),0));
4749 delete_entry_vector(S_V_I(S_PA_S(d),1),j,S_V_I(S_PA_S(d),1));
4750 t_FROBENIUS_VECTOR(d,d);
4751 m_gk_spa(a,d,b);
4752 FREEALL(d);
4753 }
4754 else
4755 erg += error("ribbon_partition(1): wrong type of partition");
4756 ENDR("ribbon_partition");
4757 }
4758
4759
young_ideal(a,b)4760 INT young_ideal(a,b) OP a,b;
4761 /* input: PARTITION object
4762 output: VECTOR object, i-th entry = i-th level in young ideal */
4763 /* AK 130803 */
4764 {
4765 INT i,j,k;
4766 OP c,d,e,z,f;
4767 INT erg = OK;
4768 CTO(PARTITION,"young_ideal(1)",a);
4769 if (S_PA_K(a) == EXPONENT)
4770 {
4771 CALLOCOBJECT2(c,d);
4772 erg += t_EXPONENT_VECTOR(a,c);
4773 erg += young_ideal(c,d);
4774 m_il_v(S_V_LI(d), b);
4775 for (i=0;i<S_V_LI(b);i++)
4776 {
4777 z = S_V_I(b,i); f = S_V_I(d,i);
4778 m_il_v(S_V_LI(f), z);
4779 for (j=0;j<S_V_LI(f);j++)
4780 t_VECTOR_EXPONENT(S_V_I(f,j), S_V_I(z,j));
4781 }
4782 FREEALL2(c,d);
4783 goto endr_ende;
4784 }
4785 C1R(a,"young_ideal",b);
4786 c = callocobject();
4787 d = callocobject();
4788 e = callocobject();
4789 weight_partition(a,c); inc(c);
4790 b_l_v(c,b);
4791 m_o_v(a,S_V_I(b,0));
4792 for (i=0;i<S_V_LI(b)-1;i++)
4793 {
4794 init(BINTREE,d);
4795 for (j=0;j<S_V_LI(S_V_I(b,i));j++)
4796 {
4797 z = S_V_I(S_V_I(b,i),j);
4798 vorgaenger_young(z,e);
4799 for(k=0;k<S_V_LI(e);k++)
4800 {
4801 f = callocobject();
4802 swap(f,S_V_I(e,k));
4803 insert(f,d,NULL,NULL);
4804 }
4805 }
4806 t_BINTREE_VECTOR(d,S_V_I(b,i+1));
4807 }
4808 freeall(d);
4809 freeall(e);
4810 S1R(a,"young_ideal",b);
4811 ENDR("young_ideal");
4812 }
4813
4814
4815
4816 #endif /* PARTTRUE */
4817