1 #include "def.h"
2 #include "macro.h"
3
4
5 #ifdef SCHURTRUE
6 #define SR_LENGTH 1000
7 #define SR_DEPTH 1000
8
9 static char (* ps)[SR_LENGTH] = NULL;/* permutationen */
10 static short (* ms)[4] = NULL;
11 /* maximal place at 0 */
12 /* end of first increasing part at 1 */
13 /* length of the perm at 2 */
14 /* maximal entry as schur partition at 3 */
15 static short stacklevel; /* the actuell level */
16 static short permlength; /* the length of the permutation */
17
18 typedef char axk[SR_LENGTH] ;
19 typedef short axl[4] ;
20 static INT newtrans_main();
21 static INT newtrans_main_hashtable();
22 static INT newtrans_main_limitfunction();
23 static INT newtrans_main_limit_limitfunction();
24 static INT newtrans_nextstep();
25 static INT newtrans_printstack();
26 static INT newtrans_start();
27 INT newtrans_maxpart_maxlength(OP,OP,INT,INT);
28 INT mult_schur_schur_maxpart_maxlength(OP,OP,OP,OP,OP);
29
30 static OP newtrans_koeff = NULL;
31 static OP nmh_ent = NULL;
32
mss_ende()33 INT mss_ende()
34 {
35 INT erg = OK;
36 if (ps != NULL) { SYM_free(ps); ps = NULL; }
37 if (ms != NULL) { SYM_free(ms); ms = NULL; }
38 if (nmh_ent != NULL) { FREEALL(nmh_ent); nmh_ent=NULL; }
39 ENDR("mss_ende");
40 }
41
42
43
newtrans_main(perm,e,maxpart,maxlength)44 static INT newtrans_main(perm,e,maxpart,maxlength)OP perm,e; INT maxpart; INT maxlength;
45 /* AK 020290 V1.1 AK 200891 V1.3 */
46 /* AK 211201 maxpart is the maximal partsize in the result, -1 if no limit */
47 /* AK 120603 maxlength is the maximal partlength in the result, -1 if no limit */
48 {
49 INT erg = OK;
50 short i,j;
51 INT koeff=0;
52 CTTTO(HASHTABLE,SCHUR,BINTREE,"newtrans_main(2)",e);
53 SYMCHECK(maxpart < -1, "newtrans_main:wrong value maxpart");
54 SYMCHECK(maxlength < -1, "newtrans_main:wrong value maxlength");
55
56 if (ps == NULL) {
57 ps = (axk * ) SYM_calloc(SR_DEPTH,sizeof(axk));
58 if (ps == NULL)
59 return no_memory();
60 }
61 if (ms == NULL) {
62 ms = (axl *) SYM_calloc(SR_DEPTH,sizeof(axl));
63 if (ms == NULL)
64 return no_memory();
65 }
66
67 if (S_O_K(e) == HASHTABLE) {
68 erg += newtrans_main_hashtable(perm,e,maxpart,maxlength);
69 goto ende;
70 }
71 if (newtrans_koeff)
72 {
73 if (S_O_K(newtrans_koeff) == INTEGER)
74 koeff = S_I_I(newtrans_koeff);
75 }
76 else koeff = 1;
77
78
79 newtrans_start(perm);
80 mainaa:
81 if ( (maxpart >= 0) && ( maxpart < ms[stacklevel][3]))
82 stacklevel--;
83 else if (ms[stacklevel][1] == ms[stacklevel][0])
84 /* this means it is grassmanian */
85 {
86 OP ent=CALLOCOBJECT(); /* eintrag */
87
88 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),ent);
89 b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(ent));
90 m_il_integervector((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
91 if (koeff != 0) M_I_I(koeff,S_MO_K(ent));
92 else COPY(newtrans_koeff,S_MO_K(ent));
93
94 for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
95 if ( (ps[stacklevel] [i]) - i - 1 > 0 ) {
96 M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
97 S_PA_I(S_MO_S(ent),j)); j++; }
98 if (j>1)
99 M_I_I((INT)j, S_PA_L(S_MO_S(ent))); /* j eingefuegt AK 170790 */
100 else if (j==1) /* AK 121093 */
101 /* noetig da ein vector der laenge 1 ein object ist */
102 {
103 i = S_PA_II(S_MO_S(ent),(INT)0);
104 m_il_integervector((INT)1,S_PA_S(S_MO_S(ent)));
105 M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
106 }
107 if ( (maxlength == -1) && (maxpart == -1) )
108 INSERT_SCHURMONOM_(ent,e);
109 else if ( (maxlength == -1) || (MAXPARTI(S_MO_S(ent)) <=maxpart) )
110 INSERT_SCHURMONOM_(ent,e);
111 else if ( (maxpart == -1) || (S_PA_LI(S_MO_S(ent)) <= maxlength) )
112 INSERT_SCHURMONOM_(ent,e);
113 else
114 FREEALL(ent);
115 stacklevel--;
116 }
117 else newtrans_nextstep();
118 /* compute next level from last entry in stack */
119 if (stacklevel != -1) goto mainaa;
120 ende:
121 ENDR("newtrans_main");
122 }
123
newtrans_main_hashtable(perm,e,maxpart,maxlength)124 static INT newtrans_main_hashtable(perm,e,maxpart,maxlength)OP perm,e; INT maxpart; INT maxlength;
125
126 {
127 INT erg = OK;
128 short i,j;
129 INT koeff=0,k;
130 OP ent;
131
132 CTO(HASHTABLE,"newtrans_main_hashtable(2)",e);
133 SYMCHECK(maxpart < -1, "newtrans_main_hashtable:wrong value maxpart");
134 SYMCHECK(maxlength < -1, "newtrans_main_hashtable:wrong value maxlength");
135
136 if (newtrans_koeff)
137 {
138 if (S_O_K(newtrans_koeff) == INTEGER)
139 koeff = S_I_I(newtrans_koeff);
140 }
141 else koeff = 1;
142
143 if (nmh_ent == NULL) {
144 nmh_ent = CALLOCOBJECT();
145 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),nmh_ent);
146 b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(nmh_ent));
147 m_il_integervector(SR_LENGTH,S_PA_S(S_MO_S(nmh_ent)));
148 }
149
150 ent = nmh_ent;
151
152 newtrans_start(perm);
153 mainaa:
154 if ( (maxpart >= 0) && ( maxpart < ms[stacklevel][3]))
155 stacklevel--;
156 else if (ms[stacklevel][1] == ms[stacklevel][0])
157 /* this means it is grassmanian */
158 {
159 INT w=0;
160 M_I_I((INT) ms[stacklevel][1] + 1, S_PA_L(S_MO_S(ent)));
161 FREESELF(S_MO_K(ent));
162 if (koeff != 0)
163 M_I_I(koeff,S_MO_K(ent));
164 else
165 COPY(newtrans_koeff,S_MO_K(ent));
166 for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
167 if ( (ps[stacklevel] [i]) - i - 1 > 0 ) {
168 M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
169 S_PA_I(S_MO_S(ent),j));
170 w += S_PA_II(S_MO_S(ent),j);
171 j++;
172 }
173 if (j>1)
174 M_I_I((INT)j, S_PA_L(S_MO_S(ent))); /* j eingefuegt AK 170790 */
175 else if (j==1) /* AK 121093 */
176 /* noetig da ein vector der laenge 1 ein object ist */
177 {
178 i = S_PA_II(S_MO_S(ent),(INT)0);
179 M_I_I(1,S_PA_L(S_MO_S(ent)));
180 M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
181 }
182
183 if (
184 ( (maxpart == -1) || (MAXPARTI(S_MO_S(ent)) <=maxpart) )
185 &&
186 ( (maxlength == -1) || (S_PA_LI(S_MO_S(ent)) <=maxlength) )
187 )
188 {
189 INT eq_monomsymfunchash();
190
191 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(ent)),k);
192 C_PA_HASH(S_MO_S(ent),k);
193 if ( w < 70 )
194 add_apply_hashtable(ent,e,add_koeff,eq_monomsymfunchash,hash_monompartition);
195 else
196 add_apply_hashtable(ent,e,add_koeff,eq_monomsymfunc,hash_monompartition);
197 }
198 stacklevel--;
199 }
200 else newtrans_nextstep();
201 /* compute next level from last entry in stack */
202 if (stacklevel != -1) goto mainaa;
203
204 ENDR("newtrans_main_hashtable");
205 }
206
207
208
newtrans_nextstep()209 static INT newtrans_nextstep() /* AK 200891 V1.3 */
210 {
211
212 short i,j;
213 short maxplace = ms [stacklevel][0];
214 /* the position before the last decrease */
215 char maxentry = ps [stacklevel][ms [stacklevel][0]];
216 /* this is the entry at the maximal place */
217 char rightlessvalue,h;
218 /* this is the value on this place */
219 char minimalleftvalue;
220 /* the minimal value to the left which is allowed
221 to be exchanged with entry on the maxplace */
222 short startloop;
223 /* first we look whether we could reduce the length of the perm */
224 char *pss = ps[stacklevel];
225 char *pssp;
226 short *mss = ms[stacklevel];
227
228 for (i=mss[2] -1; i>0; i--)
229 if (pss[i] == (char)i+1) mss[2]--;
230 else break;
231 /* now we have reduced the length of the alphabet */
232
233 /* now we compute these rightvalues */
234 for (i=mss[2] - 1; i> 0 ; i--)
235 if ( pss[i] < maxentry) break;
236 /* i is now the required place */
237 rightlessvalue = pss[i];
238 /* now we have to exchange */
239 pss[i] = maxentry;
240 pss[maxplace] = rightlessvalue;
241
242 /* you must look whether rightlessvalue == 1
243 because this means you have to enlarge the permutation */
244
245 startloop = maxplace-1;
246 if (rightlessvalue == 1)
247 {
248 mss[2]++;
249 for (i=mss[2]-1; i>0 ; i--)
250 pss[i]=pss[i-1]+1;
251 pss[0]=(char)1;
252 mss[0]++;
253 mss[1]++;
254 rightlessvalue=2;
255 maxplace++;
256 startloop=0;
257 }
258
259 /* now we have to compute all possible changes to the left */
260 minimalleftvalue = 0;
261 for (pssp=pss+startloop,i=startloop; i>=0; i--,pssp--)
262 {
263 /* if (( pss[i] < rightlessvalue)
264 && ( pss[i] > minimalleftvalue)) */
265 if (( *pssp < rightlessvalue)
266 && ( *pssp > minimalleftvalue))
267 {
268 /* now these things have to be copied and to be exchanged */
269 if (stacklevel+1 == SR_DEPTH)
270 /* this means the stack is to small */
271 error("newtrans:stackoverflow");/* AK 121192 */
272 /* you generate a copy of the upper stack-entry */
273
274 if (i>0)
275 {
276 memcpy( ps[stacklevel+1], pss, (int)(mss[2]));
277 memcpy( ms[stacklevel+1], mss,8);
278 }
279 /* you got a copy */
280
281
282 pss[maxplace]=pss[i];
283 pss[i]=rightlessvalue;
284 minimalleftvalue = pss[maxplace];
285
286
287 /*
288 pss[maxplace] = *pssp;
289 *pssp = rightlessvalue;
290 minimalleftvalue = pss[maxplace];
291 */
292
293 /* new value for maximal schur part *//* AK 211201 */
294 if ((h=(rightlessvalue - i - 1)) > mss[3])
295 mss[3] = h;
296
297 /* we have now to compute the new values for minstack and ms */
298 for (j=mss[1]+1;j<mss[2];j++)
299 if (pss[j] < pss[j-1])
300 break;
301 mss[1] = j-1;
302 /* this is the new value of the minstackentry */
303
304 for (j=mss[0];j>=0;j--)
305 if (pss[j] > pss[j+1])
306 break;
307 mss[0] = j;
308 /* this is the new value of the msentry */
309 if (minimalleftvalue == (rightlessvalue - 1)) return(0);
310 else {
311 stacklevel++;
312 pss=ps[stacklevel];
313 mss=ms[stacklevel];
314 }
315 }
316 if ((i==0)&&(minimalleftvalue==0))
317 /* you have to enlarge the permutation */
318 {
319 mss[2]++;
320 for (i=mss[2]-1; i>0 ; i--)
321 pss[i]=pss[i-1]+1;
322 pss[0]=(char)1;
323 mss[1]++;
324 mss[0]++;
325 rightlessvalue++;
326 maxplace++;
327 pss[maxplace]=pss[i];
328 pss[i]=rightlessvalue;
329 minimalleftvalue = pss[maxplace];
330 /* we have now to compute the new values for
331 minstack and ms */
332 for (j=mss[1]+1;j<mss[2];j++)
333 if (pss[j] < pss[j-1])
334 break;
335 mss[1] = j-1;
336 /* this is the new value of the minstackentry */
337
338 for (j=mss[0];j>=0;j--)
339 if (pss[j] > pss[j+1])
340 break;
341 mss[0] = j;
342 /* this is the new value of the msentry */
343 return(0);
344 }
345 }
346 stacklevel--;
347 return OK;
348 }
349
350 #ifdef UNDEF
newtrans_printstack()351 static INT newtrans_printstack()
352 /* AK 200891 V1.3 */
353 {
354 /* the routine prints the stack */
355 short i,j;
356 for (i=0;i<=stacklevel;i++)
357 {
358 char *pss = ps[i];
359 for (j=0;j<ms[i][2];j++)
360 {
361 printf(" %d ",(short)pss[j]);
362 }
363 printf(":%d %d %d %d\n",ms[i][0],ms[i][1],ms[i][2],ms[i][3]);
364 };
365 printf("-------------------------------------------\n");
366 return(OK);
367 }
368 #endif
369
370
371
newtrans_start(perm)372 static INT newtrans_start(perm) OP perm; /* AK 221289 V1.1 AK 200891 V1.3 */
373 {
374 short i;
375 INT erg = OK;
376
377 permlength = S_P_LI(perm);
378 if (permlength > SR_LENGTH)
379 /* the error condition the perm do not fit into the stack */
380 {
381 fprintln(stderr,perm);
382 fprintf(stderr,
383 "please enter a permutation of a length <= %d\n",SR_LENGTH);
384 erg += error("newtrans_start:internal error");
385 goto endr_ende;
386 }
387 ms[0][2]=permlength;
388 ms[0][3]=0;
389
390 for (i=0; i<permlength ; i++)
391 {
392 ps [0][i] = (char)S_P_II(perm,i);
393 if ((S_P_II(perm,i) - i - 1) > ms[0][3])
394 ms[0][3]=(S_P_II(perm,i) - i - 1);
395 }
396 /* now we are looking for the first and the last decrease */
397 for (i=1; i<permlength ; i++)
398 if (ps [0][i] < ps [0][i-1]) break;
399 /* now i is the index of the first decrease */
400 ms [0][1] = i-1;
401
402
403 for (i=permlength-2 ;i>=0; i--)
404 if (ps [0][i] > ps [0][i+1]) break;
405 /* now i+1 is the index of the last decrease */
406 ms [0][0] = i;
407
408 stacklevel=0;
409 ENDR("newtrans_start:internal function");
410 }
411
newtrans_lehmer(perm,c)412 INT newtrans_lehmer(perm,c) OP perm,c;
413 /* perm und c may be equal */
414 {
415 OP d;
416 INT erg = OK;
417 CTTO(VECTOR,INTEGERVECTOR,"newtrans_lehmer(1)",perm);
418 erg += lehmercode(perm,d = CALLOCOBJECT());
419 erg += newtrans_maxpart_maxlength(d,c,-1,-1);
420 FREEALL(d);
421 ENDR("newtrans_lehmer");
422 }
423
newtrans_eins(c)424 INT newtrans_eins(c) OP c;
425 /* AK 211201 */
426 {
427 INT erg = OK;
428 OP m;
429 CTTTO(SCHUR,HASHTABLE,BINTREE,"newtrans_eins(1)",c);
430 m = CALLOCOBJECT();
431 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
432 erg += first_partition(cons_null,S_MO_S(m));
433 if (newtrans_koeff != NULL)
434 COPY(newtrans_koeff,S_MO_K(m));
435 else
436 M_I_I(1,S_MO_K(m));
437 INSERT_SCHURMONOM_(m,c);
438 ENDR("newtrans_eins");
439 }
440
441
newtrans(perm,c)442 INT newtrans(perm,c) OP perm,c;
443 /* AK 221289 V1.1 */ /* AK 130891 V1.3 */
444 /* AK 180598 V2.0 */
445 /* perm and c may be equal */
446 /* is c a HASHTABLE,BINTREE,SCHUR it will be used for inserting */
447 /* die globale variable newtrans_koeff may be used for faktor */
448 {
449 INT erg = OK;
450 CTO(PERMUTATION,"newtrans(1)",perm);
451 newtrans_maxpart_maxlength(perm,c,-1,-1);
452 CTTTO(SCHUR,HASHTABLE,BINTREE,"newtrans(res)",c);
453 ENDR("newtrans");
454 }
455
newtrans_maxpart(perm,e,maxpart)456 INT newtrans_maxpart(perm,e,maxpart) OP perm,e; INT maxpart;
457 {
458 return newtrans_maxpart_maxlength(perm,e,maxpart,-1);
459 }
460
newtrans_maxpart_maxlength(perm,e,maxpart,maxlength)461 INT newtrans_maxpart_maxlength(perm,e,maxpart,maxlength) OP perm,e; INT maxpart;INT maxlength;
462 /* AK 211201
463 there is a limit on the maximal size of the parts in the result
464 -1 is no limit */
465 /* AK 120603
466 there is a limit on the maximal length of the parts in the result
467 -1 is no limit */
468 {
469 INT erg = OK;
470 CTO(PERMUTATION,"newtrans_maxpart_maxlength(1)",perm);
471 SYMCHECK(maxpart < -1,"newtrans_maxpart_maxlength:wrong value for maxpart");
472 SYMCHECK(maxlength < -1,"newtrans_maxpart_maxlength:wrong value for maxlength");
473 if (
474 (S_O_K(e) == BINTREE) ||
475 (S_O_K(e) == SCHUR) ||
476 (S_O_K(e) == HASHTABLE)
477 )
478 {
479 if (einsp_permutation(perm))
480 {
481 erg += newtrans_eins(e);
482 goto ende;
483 }
484 else {
485 erg += newtrans_main(perm,e,maxpart,maxlength);
486 goto ende;
487 }
488 }
489 else {
490 if (einsp_permutation(perm))
491 {
492 erg += m_scalar_schur(cons_eins,e);
493 if (newtrans_koeff != NULL)
494 erg += copy(newtrans_koeff,S_S_K(e));
495 goto ende;
496 }
497 SYMCHECK(perm == e, "newtrans_maxpart:identical parameters");
498 erg += init(BINTREE,e);
499 erg += newtrans_main(perm,e,maxpart,maxlength);
500 erg += t_BINTREE_SCHUR(e,e);
501 goto ende;
502 }
503
504 ende:
505 CTTTO(SCHUR,HASHTABLE,BINTREE,"newtrans(res)",e);
506 ENDR("newtrans_maxpart");
507 }
508
newtrans_limit_limitfunction(perm,c,d,f,limit)509 INT newtrans_limit_limitfunction(perm,c,d,f,limit) OP perm,c,d,limit; INT (*f)();
510 /* AK 221289 V1.1 */ /* AK 200891 V1.3 */
511 {
512 INT erg = OK;
513 CTO(PERMUTATION,"newtrans_limit_limitfunction(1)",perm);
514 erg += init(BINTREE,c);
515 erg += newtrans_main_limit_limitfunction(perm,c,d,f,limit);
516 erg += t_BINTREE_SCHUR(c,c);
517 ENDR("newtrans_limit_limitfunction");
518 }
519
520
newtrans_limitfunction(perm,c,f,limit)521 INT newtrans_limitfunction(perm,c,f,limit) OP perm,c,limit; INT (*f)();
522 /* AK 221289 V1.1 */ /* AK 200891 V1.3 */
523 {
524 INT erg = OK;
525 CTO(PERMUTATION,"newtrans_limitfunction(1)",perm);
526 erg += init(BINTREE,c);
527 erg += newtrans_main_limitfunction(perm,c,f,limit);
528 erg += t_BINTREE_SCHUR(c,c);
529 ENDR("newtrans_limitfunction");
530 }
531
532
newtrans_main_limit_limitfunction(perm,c,d,f,limit)533 static INT newtrans_main_limit_limitfunction(perm,c,d,f,limit) OP d,perm,c,limit;
534 INT (*f)();
535 /* d is a limit on the length of the partitions */
536 /* AK 221289 V1.1 */ /* AK 200891 V1.3 */
537 {
538 short i,j;
539
540 if (ps == NULL) {
541 ps= (axk * ) SYM_calloc( SR_DEPTH,sizeof(axk));
542 if (ps== NULL)
543 return no_memory();
544 }
545 if (ms == NULL) {
546 ms = (axl *) SYM_calloc( SR_DEPTH,sizeof(axl));
547 if (ms == NULL)
548 return no_memory();
549 }
550 newtrans_start(perm);
551 mainaa:
552 if (ms[stacklevel][1] == ms[stacklevel][0])
553 /* this means it is grassmanian */
554 {
555 OP ent; /* eintrag */
556 if ((INT)ms[stacklevel][1] + 1 <= S_I_I(d))
557 {
558 /* partition ist kurz genug */
559 ent = callocobject();
560 init(MONOM,ent);
561 init(PARTITION,S_MO_S(ent));
562 m_il_integervector((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
563 M_I_I((INT)1,S_MO_K(ent));
564 for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
565 if ( (ps[stacklevel] [i]) - i - 1 > 0 ) {
566 M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
567 S_PA_I(S_MO_S(ent),j)); j++; }
568 if (j>1)
569 M_I_I((INT)j, S_PA_L(S_MO_S(ent)));
570 else if (j==1) /* AK 121093 */
571 {
572 i = S_PA_II(S_MO_S(ent),(INT)0);
573 m_il_integervector((INT)1,S_PA_S(S_MO_S(ent)));
574 M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
575 }
576
577 if ((*f)(S_MO_S(ent),limit) == TRUE)
578 {
579 insert(ent,c, add_koeff,comp_monomvector_monomvector);
580 }
581 else freeall(ent);
582 }
583 stacklevel--;
584 }
585 else newtrans_nextstep();
586 /* compute next level from last entry in stack */
587 if (stacklevel != -1) goto mainaa;
588 return(OK);
589 }
590
591
newtrans_main_limitfunction(perm,c,f,limit)592 static INT newtrans_main_limitfunction(perm,c,f,limit) OP perm,c,limit;
593 INT (*f)();
594 /* limit is a limit on the length of the partitions */
595 /* AK 221289 V1.1 */ /* AK 200891 V1.3 */
596 {
597 short i,j;
598
599 if (ps == NULL) {
600 ps= (axk * ) SYM_calloc( SR_DEPTH,sizeof(axk));
601 if (ps== NULL)
602 return no_memory();
603 }
604 if (ms == NULL) {
605 ms = (axl *) SYM_calloc( SR_DEPTH,sizeof(axl));
606 if (ms == NULL)
607 return no_memory();
608 }
609 newtrans_start(perm);
610 mainaa:
611 if (ms[stacklevel][1] == ms[stacklevel][0])
612 /* this means it is grassmanian */
613 {
614 OP ent; /* eintrag */
615 ent = callocobject();
616 init(MONOM,ent);
617 init(PARTITION,S_MO_S(ent));
618 m_il_integervector((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
619 M_I_I((INT)1,S_MO_K(ent));
620 for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
621 if ( (ps[stacklevel] [i]) - i - 1 > 0 ) {
622 M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
623 S_PA_I(S_MO_S(ent),j)); j++; }
624 if (j>1)
625 M_I_I((INT)j, S_PA_L(S_MO_S(ent)));
626 else if (j==1) /* AK 121093 */
627 {
628 i = S_PA_II(S_MO_S(ent),(INT)0);
629 m_il_integervector(1,S_PA_S(S_MO_S(ent)));
630 M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
631 }
632
633 if ((*f)(S_MO_S(ent),limit) == TRUE)
634 insert(ent,c, add_koeff,comp_monomschur);
635 else freeall(ent);
636
637 stacklevel--;
638 }
639 else newtrans_nextstep();
640 /* compute next level from last entry in stack */
641 if (stacklevel != -1) goto mainaa;
642 return(OK);
643 }
644
645
646
mss_partition_partition_maxpart_maxlength(a,b,c,f,m,l)647 INT mss_partition_partition_maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
648 {
649 INT erg = OK;
650 OP d;
651 CTO(PARTITION,"mss_partition_partition_maxpart_maxlength(1)",a);
652 CTO(PARTITION,"mss_partition_partition_maxpart_maxlength(2)",b);
653 CTTO(HASHTABLE,SCHUR,"mss_partition_partition_maxpart_maxlength(3)",c);
654 SYMCHECK(m < -1,"mss_partition_partition_maxpart_maxlength:maxpart < -1");
655 SYMCHECK(l < -1,"mss_partition_partition_maxpart_maxlength:maxlength < -1");
656
657 d=CALLOCOBJECT();
658 newtrans_koeff=f;
659 erg += m_part_part_perm(a,b,d);
660 erg += newtrans_maxpart_maxlength(d,c,m,l);
661 newtrans_koeff=NULL;
662 FREEALL(d);
663
664 CTTO(HASHTABLE,SCHUR,"mss_partition_partition_maxpart_maxlength(3-end)",c);
665 ENDR("mss_partition_partition_maxpart_maxlength");
666 }
mss_partition_partition_(a,b,c,f)667 INT mss_partition_partition_(a,b,c,f) OP a,b,c,f; { return mss_partition_partition_maxpart_maxlength(a,b,c,f,-1,-1); }
668
mss_partition__maxpart_maxlength(a,b,c,f,m,l)669 INT mss_partition__maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
670 {
671 INT erg = OK;
672 CTO(PARTITION,"mss_partition__maxpart_maxlength(1)",a);
673 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_partition__maxpart_maxlength(2)",b);
674 CTTO(HASHTABLE,SCHUR,"mss_partition__maxpart_maxlength(3)",c);
675 SYMCHECK(m < -1,"mss_partition__maxpart_maxlength:maxpart < -1");
676 if (S_O_K(b) == PARTITION)
677 {
678 erg += mss_partition_partition_maxpart_maxlength(a,b,c,f,m,l);
679 goto ende;
680 }
681 else if (S_O_K(b) == HASHTABLE)
682 {
683 M3_FORALL_MONOMIALS_IN_B(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
684 goto ende;
685 }
686 else if (S_O_K(b) == SCHUR)
687 {
688 M3_FORALL_MONOMIALS_IN_B(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
689 goto ende;
690 }
691 else{
692 WTO("mss_partition__maxpart_maxlength(2)",b);
693 goto ende;
694 }
695 ende:
696 ENDR("mss_partition__maxpart_maxlength");
697 }
698
mss_partition__(a,b,c,f)699 INT mss_partition__(a,b,c,f) OP a,b,c,f;
700 {
701 return mss_partition__maxpart_maxlength(a,b,c,f,-1,-1);
702 }
703
704
mss_schur__maxpart_maxlength(a,b,c,f,m,l)705 INT mss_schur__maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
706 {
707 INT erg = OK;
708 CTTO(SCHUR,HASHTABLE,"mss_schur__maxpart_maxlength(1)",a);
709 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_schur__maxpart_maxlength(2)",b);
710 CTTO(HASHTABLE,SCHUR,"mss_schur__maxpart_maxlength(3)",c);
711 SYMCHECK(m < -1,"mss_schur__maxpart:maxpart < -1");
712 SYMCHECK(l < -1,"mss_schur__maxpart:maxlength < -1");
713
714 if (S_O_K(b) == PARTITION)
715 {
716 M3_FORALL_MONOMIALS_IN_A(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
717 goto ende;
718 }
719 else if (S_O_K(b) == HASHTABLE)
720 {
721 M3_FORALL_MONOMIALS_IN_AB(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
722 goto ende;
723 }
724 else if (S_O_K(b) == SCHUR)
725 {
726 M3_FORALL_MONOMIALS_IN_AB(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
727 goto ende;
728 }
729 else{
730 WTO("mss_schur__maxpart_maxlength(2)",b);
731 goto ende;
732 }
733
734 ende:
735 ENDR("mss_schur__maxpart_maxlength");
736 }
737
mss_schur__(a,b,c,f)738 INT mss_schur__(a,b,c,f) OP a,b,c,f;
739 {
740 return mss_schur__maxpart_maxlength(a,b,c,f,-1,-1);
741 }
742
mss_hashtable__(a,b,c,f)743 INT mss_hashtable__(a,b,c,f) OP a,b,c,f;
744 {
745 INT erg = OK;
746 CTTO(SCHUR,HASHTABLE,"mss_hashtable__(1)",a);
747 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_hashtable__(2)",b);
748 CTTO(HASHTABLE,SCHUR,"mss_hashtable__(3)",c);
749 erg += mss_schur__(a,b,c,f);
750
751 ENDR("mss_hashtable__");
752 }
753
mss_hashtable_hashtable_(a,b,c,f)754 INT mss_hashtable_hashtable_(a,b,c,f) OP a,b,c,f;
755 /* AK 071201 */
756 /* from pss_..*/
757 {
758 INT erg = OK;
759 CTTO(SCHUR,HASHTABLE,"mss_hashtable_hashtable_(1)",a);
760 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_hashtable_hashtable_(2)",b);
761 CTTO(HASHTABLE,SCHUR,"mss_hashtable_hashtable_(3)",c);
762 M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mss_partition_partition_);
763
764 ENDR("mss_hashtable_hashtable_");
765 }
mss_hashtable__maxpart_maxlength(a,b,c,f,m,l)766 INT mss_hashtable__maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
767 {
768 INT erg = OK;
769 CTTO(SCHUR,HASHTABLE,"mss_hashtable__maxpart_maxlength(1)",a);
770 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_hashtable__maxpart_maxlength(2)",b);
771 CTTO(HASHTABLE,SCHUR,"mss_hashtable__maxpart_maxlength(3)",c);
772 erg += mss_schur__maxpart_maxlength(a,b,c,f,m,l);
773
774 ENDR("mss_hashtable__maxpart_maxlength");
775 }
776
mss_hashtable_hashtable_maxpart_maxlength(a,b,c,f,m,l)777 INT mss_hashtable_hashtable_maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
778 /* AK 071201 */
779 {
780 INT erg = OK;
781 CTTO(SCHUR,HASHTABLE,"mss_hashtable_hashtable_maxpart_maxlength(1)",a);
782 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss_hashtable_hashtable_maxpart_maxlength(2)",b);
783 CTTO(HASHTABLE,SCHUR,"mss_hashtable_hashtable_maxpart_maxlength(3)",c);
784 M3_FORALL_MONOMIALS_IN_AB(a,b,c,f,m,l,mss_partition_partition_maxpart_maxlength);
785
786 ENDR("mss_hashtable_hashtable_maxpart_maxlength");
787 }
788
789
790
791
mss___maxpart_maxlength(a,b,c,f,m,l)792 INT mss___maxpart_maxlength(a,b,c,f,m,l) OP a,b,c,f; INT m,l;
793 {
794 INT erg = OK;
795 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss___maxpart_maxlength(1)",a);
796 CTTTO(PARTITION,SCHUR,HASHTABLE,"mss___maxpart_maxlength(2)",b);
797 CTTO(HASHTABLE,SCHUR,"mss___maxpart_maxlength(3)",c);
798 SYMCHECK(m < -1,"mss___maxpart_maxlength:maxpart < -1");
799 SYMCHECK(l < -1,"mss___maxpart_maxlength:maxlength < -1");
800 if (S_O_K(a) == PARTITION)
801 {
802 erg += mss_partition__maxpart_maxlength(a,b,c,f,m,l);
803 goto ende;
804 }
805 else if (S_O_K(a) == SCHUR)
806 {
807 erg += mss_schur__maxpart_maxlength(a,b,c,f,m,l);
808 goto ende;
809 }
810 else if (S_O_K(a) == HASHTABLE)
811 {
812 erg += mss_hashtable__maxpart_maxlength(a,b,c,f,m,l);
813 goto ende;
814 }
815 else{
816 WTO("mss___maxpart_maxlength(1)",a);
817 goto ende;
818 }
819 ende:
820 ENDR("mss___maxpart_maxlength");
821 }
822
mss___(a,b,c,f)823 INT mss___(a,b,c,f) OP a,b,c,f;
824 {
825 return mss___maxpart_maxlength(a,b,c,f,-1,-1);
826 }
827
mult_schur_schur(a,b,c)828 INT mult_schur_schur(a,b,c) OP a, b, c;
829 /* 221086 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 050891 V1.3 */
830 /* AK 170298 V2.0 */
831 {
832 INT erg = OK;
833 INT t=0;
834 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_schur_schur(1)",a);
835 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_schur_schur(2)",b);
836 CTTTO(EMPTY,SCHUR,HASHTABLE,"mult_schur_schur(3)",c);
837
838 if (S_O_K(c) == EMPTY)
839 {
840 t=1; init_hashtable(c);
841 }
842 erg += mss___maxpart_maxlength(a,b,c,cons_eins,-1,-1);
843 if (t == 1) { erg += t_HASHTABLE_SCHUR(c,c); }
844
845 CTTO(SCHUR,HASHTABLE,"mult_schur_schur(3-end)",c);
846 ENDR("mult_schur_schur");
847 }
848
mult_schur_schur_maxlength(a,b,c,l)849 INT mult_schur_schur_maxlength(a,b,c,l) OP a, b, c,l;
850 {
851 return mult_schur_schur_maxpart_maxlength(a,b,c,cons_negeins,l);
852 }
853
mult_schur_schur_maxpart_maxlength(a,b,c,m,l)854 INT mult_schur_schur_maxpart_maxlength(a,b,c,m,l) OP a, b, c,m,l;
855 /* 221086 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 050891 V1.3 */
856 /* AK 170298 V2.0 */
857 /* if c is HASHTABLE or SCHUR the result will be added */
858 {
859 INT erg = OK;
860 INT t=0;
861 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_schur_schur_maxpart_maxlength(1)",a);
862 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_schur_schur_maxpart_maxlength(2)",b);
863 CTTTO(EMPTY,SCHUR,HASHTABLE,"mult_schur_schur_maxpart_maxlength(3)",c);
864 CTO(INTEGER,"mult_schur_schur_maxpart_maxlength(4)",m);
865 CTO(INTEGER,"mult_schur_schur_maxpart_maxlength(5)",l);
866 SYMCHECK((S_I_I(m) < -1),"mult_schur_schur_maxpart_maxlength:maxpart < -1");
867 SYMCHECK((S_I_I(l) < -1),"mult_schur_schur_maxpart_maxlength:maxlength < -1");
868
869 if (S_O_K(c) == EMPTY)
870 {
871 t=1; init_hashtable(c);
872 }
873 erg += mss___maxpart_maxlength(a,b,c,cons_eins,S_I_I(m),S_I_I(l));
874 if (t == 1) { erg += t_HASHTABLE_SCHUR(c,c); }
875
876 CTTO(SCHUR,HASHTABLE,"mult_schur_schur(3-end)",c);
877 ENDR("mult_schur_schur");
878 }
879
880
881
m_part_part_perm(a,b,c)882 INT m_part_part_perm(a,b,c) OP a,b,c;
883 /* input: two partition objects
884 output: starting permutation for transition for multiplication */
885 /* AK 050988 */
886 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
887 /* AK 060498 V2.0 */
888 /* a,b,c may be equal */
889 {
890 OP d;
891 OP z;
892 INT i,j,erg = OK;
893 CTO(PARTITION,"m_part_part_perm(1)",a);
894 CTO(PARTITION,"m_part_part_perm(2)",b);
895
896 NEW_VECTOR(d, S_PA_LI(a) + S_PA_LI(b) + MAXPARTI(a) + MAXPARTI(b) );
897 z = S_V_S(d);
898 for (i=(INT)0; i< S_PA_LI(a); i++,z++) M_I_I(S_PA_II(a,i),z);
899 for (j=(INT)0 ; j < MAXPARTI(a); j++,i++,z++) M_I_I((INT)0,z);
900 for (j=(INT)0; j < S_PA_LI(b); j++,i++,z++) M_I_I(S_PA_II(b,j),z);
901 for (j=(INT)0 ; j< MAXPARTI(b); j++,i++,z++) M_I_I((INT)0,z);
902 erg += lehmercode_vector(d,c);
903 erg += freeall(d);
904 ENDR("m_part_part_perm");
905 }
906
907
outerproduct_schur(a,b,c)908 INT outerproduct_schur(a,b,c) OP a, b, c;
909 /* AK 071086 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */
910 /* AK 050891 V1.3 */
911 /* a: PARTITION b: PARTITION
912 c: BINTREE,SCHUR,HASHTABLE result will be inserted */
913 {
914 INT erg = OK;
915 OP d;
916 CTO(PARTITION,"outerproduct_schur(1)",a);
917 CTO(PARTITION,"outerproduct_schur(2)",b);
918 CTTTTO(EMPTY,HASHTABLE,SCHUR,BINTREE,"outerproduct_schur(3)",c);
919
920 if (S_O_K(c) == EMPTY) init(SCHUR,c); /* AK 250402 */
921
922
923 d=CALLOCOBJECT();
924 erg += m_part_part_perm(a,b,d);
925 erg += newtrans_maxpart_maxlength(d,c,-1,-1);
926 FREEALL(d);
927
928 ENDR("outerproduct_schur");
929 }
930
931
m_perm_schur(a,b)932 INT m_perm_schur(a,b) OP a,b;
933 /* AK 270788 */
934 /* zerlegt das Schubertpolynom X_a in eine Summe
935 von Schurpolynomen */
936 /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
937 {
938 INT erg = OK;
939 CTO(PERMUTATION,"m_perm_schur",a);
940 erg += newtrans_maxpart_maxlength(a,b,-1,-1);
941 ENDR("m_perm_schur");
942 }
943
outerproduct_schur_limit_limitfunction(a,b,c,k,f,l)944 INT outerproduct_schur_limit_limitfunction(a,b,c,k,f,l) OP k, a, b, c,l;
945 INT (*f)();
946 /* 071086 */ /* a b sind partitionen */ /* AK 071189 */
947 /* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
948 /* k ist ein limit fuer die groesse */
949 {
950 OP d;
951 INT erg = OK;
952 CTO(PARTITION,"outerproduct_schur_limit_limitfunction(1)",a);
953 CTO(PARTITION,"outerproduct_schur_limit_limitfunction(2)",b);
954 d=callocobject();
955 if (not EMPTYP(c))
956 erg += freeself(c);
957 erg += m_part_part_perm(a,b,d);
958 erg += newtrans_limit_limitfunction(d,c,k,f,l);
959 erg += freeall(d);
960 ENDR("outerproduct_schur_limit_limitfunction");
961 }
962
outerproduct_schur_limitfunction(a,b,c,f,l)963 INT outerproduct_schur_limitfunction(a,b,c,f,l) OP a, b, c,l;
964 INT (*f)();
965 /* 071086 */ /* a b sind partitionen */ /* AK 071189 */
966 /* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
967 {
968 OP d;
969 INT erg = OK;
970 CTO(PARTITION,"outerproduct_schur_limitfunction(1)",a);
971 CTO(PARTITION,"outerproduct_schur_limitfunction(2)",b);
972 d=callocobject();
973 if (not EMPTYP(c))
974 erg += freeself(c);
975 erg += m_part_part_perm(a,b,d);
976 erg += newtrans_limitfunction(d,c,f,l);
977 erg += freeall(d);
978 ENDR("outerproduct_schur_limitfunction");
979 }
980
outerproduct_schur_limit(a,b,c,l)981 INT outerproduct_schur_limit(a,b,c,l) OP a, b, c,l;
982 /* 071086 */ /* a b sind partitionen */ /* AK 071189 */
983 /* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
984 {
985 OP d=callocobject();
986 if (not EMPTYP(c))
987 freeself(c);
988 m_part_part_perm(a,b,d);
989 newtrans_limitfunction(d,c,neqparts_partition,l);
990 freeall(d);
991 return(OK);
992 }
993
994
995
996
997
998 #ifdef SKEWPARTTRUE
999
m_skewpart_skewperm(a,b)1000 INT m_skewpart_skewperm(a,b) OP a,b;
1001 /* AK 221289 V1.1 */ /* AK 010791 V1.2 */
1002 /* es wird die permutation fuer die berechnung der skew schur funktion
1003 berechnet */
1004 /* vgl. m_part_part_perm() */
1005 /* AK 130891 V1.3 */
1006 /* a and b may be equal */
1007 {
1008 OP d ; /* d wird der code vector */
1009 INT k,i,j,h;
1010 INT lg = S_SPA_GLI(a);
1011 INT lk = S_SPA_KLI(a); /* die laengen der beiden partitionen */
1012 INT erg = OK;
1013 CTO(SKEWPARTITION,"m_skewpart_skewperm(1)",a);
1014
1015 d = CALLOCOBJECT();
1016
1017 for (i=0,j=0;i<lk;i++) j += S_SPA_KII(a,i); /* AK 121101 */
1018 /* is the weight of the smaller partition */
1019 k = S_PA_II(S_SPA_G(a),lg-(INT)1);
1020 /* k ist der letzte eintrag in der groesseren partition */
1021 erg += m_il_v(j+ k + S_PA_LI(S_SPA_G(a)),d);
1022
1023 for (i=(INT)0;i<lg-lk;i++) M_I_I(S_SPA_GII(a,i),S_V_I(d,i));
1024 /* zuerst werden die teile aus der grossen partition kopiert */
1025 h = i; /* h ist laufindex durch vector */
1026 /* i ist laufindex durch grosse partition j durch kleine */
1027 for (j=(INT)0;j<lk;j++,i++,h++)
1028 {
1029 if (j==(INT)0) /* error in version < 010791 */
1030 for (k=(INT)0;k<S_SPA_KII(a,j);k++,h++)
1031 M_I_I((INT)0,S_V_I(d,h));
1032 else
1033 for (k=(INT)0;k<S_SPA_KII(a,j)-S_SPA_KII(a,j-(INT)1);k++,h++)
1034 M_I_I((INT)0,S_V_I(d,h));
1035 M_I_I(S_SPA_GII(a,i)-S_SPA_KII(a,j),S_V_I(d,h));
1036 }
1037 for (;h<S_V_LI(d);h++)
1038 M_I_I((INT)0,S_V_I(d,h));
1039 erg += lehmercode_vector(d,b);
1040 FREEALL(d);
1041 ENDR("m_skewpart_skewperm");
1042 }
1043
1044 static OP part_part_skewschur_koeff=NULL;
schur_part_skewschur(a,b,c)1045 INT schur_part_skewschur(a,b,c) OP a,b,c;
1046 /* AK 140199 */
1047 /* input SCHUR or HASHTABLE object a,
1048 PARTITION object b
1049 or INTEGER object b
1050 result is the skew schur function a/b
1051 this is a object of the same type as a, so
1052 SCHUR or HASHTABLE.
1053 if the parameter c for the result is a SCHUR or HASHTABLE the result will
1054 be inserted.
1055 if not it is initialised at the beginning
1056 */
1057 {
1058 INT erg = OK,t=0;
1059 OP z;
1060 CTTO(HASHTABLE,SCHUR,"schur_part_skewschur(1)",a);
1061 CTTO(INTEGER,PARTITION,"schur_part_skewschur(2)",b);
1062
1063 if (S_O_K(b) == INTEGER) {
1064 OP d = CALLOCOBJECT();
1065 erg += m_i_pa(b,d);
1066 erg += schur_part_skewschur(a,d,c);
1067 FREEALL(d);
1068 goto ende;
1069 }
1070
1071 if (
1072 (S_O_K(c) != HASHTABLE) &&
1073 (S_O_K(c) != SCHUR)
1074 )
1075 CE3(a,b,c,schur_part_skewschur);
1076
1077 CTTTO(HASHTABLE,SCHUR,EMPTY,"schur_part_skewschur(3)",c);
1078 if (S_O_K(c) == EMPTY) {
1079 if (S_O_K(a) == SCHUR) t=1;
1080 init_hashtable(c);
1081 }
1082
1083 FORALL(z,a,{
1084 part_part_skewschur_koeff=S_MO_K(z);
1085 erg += part_part_skewschur(S_MO_S(z),b,c);
1086 part_part_skewschur_koeff=NULL;
1087 });
1088
1089 if (t==1) t_HASHTABLE_SCHUR(c,c);
1090 ende:
1091 CTTO(HASHTABLE,SCHUR,"schur_part_skewschur(res)",c);
1092 ENDR("schur_part_skewschur");
1093 }
1094
1095
part_part_skewschur(a,b,c)1096 INT part_part_skewschur(a,b,c) OP a,b,c;
1097 /* AK 221289 V1.1 */ /* AK 010791 V1.2 */
1098 /* a ist die groessere partition */
1099 /* AK 130891 V1.3 */
1100 /* AK 170298 V2.0 */
1101 /* input PARTITION object a
1102 PARTITION object b
1103 output c : there are four posibilities
1104 c is empty object at the beginning --> it will become schur object
1105 c is schur object -> result will inserted into c
1106 c is hashtable object -> result will be inserted
1107 c is an other object, it will become schur object
1108
1109 the result is the expansion of the skew schur function a/b in the basis of
1110 schur functions
1111
1112 the global object part_part_skewschur_koeff may be used as a faktor to be inserted
1113 */
1114 {
1115 OP d,e;
1116 INT i,j,t=0;
1117 INT erg = OK;
1118
1119 CTO(PARTITION,"part_part_skewschur(1)",a);
1120 CTO(PARTITION,"part_part_skewschur(2)",b);
1121
1122 if (
1123 (S_O_K(c) != HASHTABLE) &&
1124 (S_O_K(c) != SCHUR)
1125 )
1126 CE3(a,b,c,part_part_skewschur);
1127
1128 CTTTO(EMPTY,SCHUR,HASHTABLE,"part_part_skewschur(3)",c);
1129
1130
1131
1132
1133 i = S_PA_LI(a)-1;
1134 j = S_PA_LI(b)-1;
1135 if (j > i) {
1136 /* result is 0 */
1137 if (S_O_K(c)==EMPTY) init_schur(c);
1138 goto ende;
1139 }
1140 for(;j>=0;j--,i--)
1141 if (S_PA_II(a,i) < S_PA_II(b,j))
1142 {
1143 /* result is 0 */
1144 if (S_O_K(c)==EMPTY) init_schur(c);
1145 goto ende;
1146 }
1147 /* zuerst test ob b kleiner a */
1148 /* falls nicht ist das ergebnis ein leeres schur object */
1149
1150 if (S_O_K(c) == EMPTY) {
1151 erg += init_hashtable(c);
1152 t = 1;
1153 }
1154
1155
1156 d = CALLOCOBJECT();
1157 e = CALLOCOBJECT();
1158 erg += b_gk_spa(CALLOCOBJECT(),CALLOCOBJECT(),d);
1159 erg += copy_partition(a,S_SPA_G(d));
1160 erg += copy_partition(b,S_SPA_K(d));
1161 erg += m_skewpart_skewperm(d,e);
1162 FREEALL(d);
1163
1164 newtrans_koeff = part_part_skewschur_koeff;
1165 erg += newtrans_maxpart_maxlength(e,c,-1,-1);
1166 newtrans_koeff = NULL;
1167 FREEALL(e);
1168
1169 if (t==1) t_HASHTABLE_SCHUR(c,c);
1170 ende:
1171 CTTO(SCHUR,HASHTABLE,"part_part_skewschur(res)",c);
1172 ENDR("part_part_skewschur");
1173 }
1174
1175
1176
1177
1178 #endif /* SKEWPARTTRUE */
1179
mult_apply_schur_schur(a,b)1180 INT mult_apply_schur_schur(a,b) OP a,b;
1181 /* platzhalter */
1182 /* b = b*a */
1183 {
1184 INT erg = OK;
1185 OP c;
1186 CTTO(HASHTABLE,SCHUR,"mult_apply_schur_schur",a);
1187 CTTO(HASHTABLE,SCHUR,"mult_apply_schur_schur",b);
1188
1189 c = CALLOCOBJECT();
1190 if (S_O_K(b) == HASHTABLE) erg += init_hashtable(c);
1191 erg += mult_schur_schur(a,b,c);
1192 SWAP(c,b);
1193 FREEALL(c);
1194
1195 ENDR("mult_apply_schur_schur");
1196 }
1197
1198
1199 #endif /* SCHURTRUE */
1200