1
2 #include "def.h"
3 #include "macro.h"
4
5 static INT l_schur_monomial_mult_new();
6
cc_muir_mms_partition_partition_(a,b,c,f)7 INT cc_muir_mms_partition_partition_(a,b,c,f) OP a,b,c,f;
8 /* AK 071201 called from mms_partition_partition_ */
9 {
10 INT erg = OK;
11 OP wa,wb;
12 CTO(PARTITION,"cc_muir_mms_partition_partition_(1)",a);
13 CTO(PARTITION,"cc_muir_mms_partition_partition_(2)",b);
14 CTO(HASHTABLE,"cc_muir_mms_partition_partition_(3)",c);
15 wa = CALLOCOBJECT();
16 weight_partition(a,wa);
17 wb = CALLOCOBJECT();
18 weight_partition(b,wb);
19 add_apply(wa,wb);
20 l_schur_monomial_mult_new(wb,b,a,c,f);
21 FREEALL2(wa,wb);
22 ENDR("cc_muir_mms_partition_partition_");
23 }
24
25 typedef INT PLETCHAR;
26
27 struct cel{
28 struct cel *prec;
29 struct cel *suiv;
30 PLETCHAR *tab;
31 long coef;
32 };
33
34 struct lst{ struct cel *deb; };
35
36
37
38
muir_lim_new(limit,cond,s,psi,plst)39 static INT muir_lim_new(limit,cond,s,psi,plst)
40 PLETCHAR limit,cond,*s,*psi;
41 struct lst *plst;
42 /* CC */
43 {
44 PLETCHAR lg_s, avv=0, lg_psi, sig, sigav=0, j, bl=0, max,mv;
45 PLETCHAR *uu, *av, *def, *pos, *tb, *bav, *bdef, *bpos, *btb;
46 register PLETCHAR *buu,*bs;
47 register PLETCHAR k,tp,tmp;
48 struct cel *pcrt,*q=NULL,*ins;
49 long lp;
50
51
52 bs=s+1;
53 while(*bs) bs++;
54 tmp=bs-(s+1);
55 lg_s=tmp; tp=0;
56 bs=psi+1;
57 while(*bs) tp+= *bs++;
58 lg_psi=bs-(psi+1);
59 tmp=lg_s+tp;
60
61 s=(PLETCHAR *) SYM_realloc(s,(tmp+20)*sizeof(PLETCHAR));
62 buu=s+lg_s+2;
63 for(k=0;k<= tp;k++,buu++) *buu=0;
64
65 uu=(PLETCHAR *)SYM_calloc(tmp+2,sizeof(PLETCHAR));
66 av=(PLETCHAR *)SYM_calloc(tmp+2,sizeof(PLETCHAR));
67 def=(PLETCHAR *)SYM_calloc(tmp+2,sizeof(PLETCHAR));
68 tb=(PLETCHAR *)SYM_MALLOC((lg_psi+2)*sizeof(PLETCHAR));
69 pos=(PLETCHAR *)SYM_MALLOC((lg_psi+2)*sizeof(PLETCHAR));
70
71 pcrt=(struct cel *)SYM_MALLOC(sizeof(struct cel));
72 pcrt->prec=pcrt->suiv=NULL;
73 plst->deb=pcrt;
74 mv=0;
75 pcrt->coef=1L;
76
77 if(cond==0 || (cond==1 && limit >= *(s+1) + *(psi+1)))
78 {
79 pcrt->coef=1L;
80 bav=av+1; bdef=def+1; buu=s+1;
81 while(*buu)
82 {
83 *bav=*bdef=*buu; buu++;bav++,bdef++;
84 }
85
86 bpos=pos+1; btb=tb+1; bdef=def+1; bav= av+1; buu= psi+1;
87 for(k=1; k<=lg_psi; bpos++,btb++,bdef++,bav++,k++,buu++)
88 {
89 *bpos=k;
90 *btb= *buu;
91 *bdef += *buu;
92 *bav += *buu;
93 }
94 *bpos=0; *btb=0;
95
96 avv=lg_psi-1; *(bav-1)=0;
97 if(lg_psi>lg_s)
98 {
99 buu=(PLETCHAR *)SYM_MALLOC((lg_psi+1)*sizeof(PLETCHAR));
100 *bdef=0;
101 }
102 else
103 {
104 buu=(PLETCHAR *)SYM_MALLOC((lg_s+1)*sizeof(PLETCHAR));
105 *(def+lg_s+1)=0;
106 }
107
108 bs=def+1; pcrt->tab=buu;
109 while(*bs) *buu++ = *bs++;
110 *buu=0;
111
112 sigav=1; j=lg_psi;
113 bpos=pos+lg_psi; btb=tb+lg_psi;
114 }
115
116 else
117 {
118 if(lg_psi> lg_s)
119 {
120 buu=(PLETCHAR *)SYM_MALLOC((lg_psi+1)*sizeof(PLETCHAR));
121 pcrt->tab=buu;
122 bs=s+1;bdef=psi+1;
123 for(k=0;k<lg_s;k++,bdef++,bs++,buu++)
124 *buu= *bs+ *bdef;
125 for(;k<lg_psi;k++,bdef++,buu++) *buu= *bdef;
126 *buu=0;
127 }
128 else
129 {
130 buu=(PLETCHAR *)SYM_MALLOC((lg_s+1)*sizeof(PLETCHAR));
131 pcrt->tab=buu;
132 bs=s+1;bdef=psi+1;
133 for(k=0;k<lg_psi;k++,bdef++,bs++,buu++)
134 *buu= *bs+ *bdef;
135 for(;k<lg_s;k++,bs++,buu++) *buu= *bs;
136 *buu=0;
137 }
138
139 bs=tb+1;
140 buu=psi+1;
141 while(*buu) *bs++ = *buu++;
142 *bs=0;
143
144 bs=s+1; buu=uu+1; bdef=def+1;
145 while(*bs) *buu++ = *bdef++ = *bs++;
146 *buu=0;
147
148 bdef=def+1; btb=tb+1; buu=uu+1; bpos=pos+1;
149 sig=1;
150 for(j=1;j<=tmp;j++,bdef++,buu++)
151 {
152 tp= *bdef + *btb -1; bs=buu-1; bl=0;
153 for(k=j-1;k>=1;k--,tp--,bs--)
154 {
155 if(*bs==tp){bl=1;break;}
156 if(*bs>tp){bl=2;break;}
157 }
158
159 if(bl==1) continue;
160 if(bl==0 && *bdef+ *btb -(j-1) > limit) continue;
161 if(btb-tb==lg_psi)
162 {
163 avv=j-1;
164 bs=av+1;
165 sigav=sig;
166 buu= uu+1;
167 for(k=1;k<=avv;k++,bs++,buu++)
168 *bs= *buu;
169 *bs=0;
170 }
171 *bpos++ =j; *bdef += *btb++;
172 *buu = *bdef; bs=buu;
173 for(tp=j;tp>k+1;tp--,bs--)
174 {
175 mv= *bs; *bs= *(bs-1)+1;
176 *(bs-1)=mv-1; sig= -sig;
177 }
178 if(btb-tb==lg_psi+1) break;
179 }
180
181 ins=(struct cel *)SYM_MALLOC(sizeof(struct cel));
182 ins->prec=pcrt;pcrt->suiv=ins; ins->suiv=NULL;
183 ins->coef=sig;
184 if (j>lg_s) bs=(PLETCHAR *)SYM_MALLOC((j+1)*sizeof(PLETCHAR));
185 else bs=(PLETCHAR *)SYM_MALLOC((lg_s+1)*sizeof(PLETCHAR));
186 ins->tab=bs;
187 buu=uu+1;
188 while(*buu) *bs++ = *buu++;
189 *bs=0;
190 pcrt=ins;
191
192 *bpos-- =0;
193 *btb-- =0;
194 mv=0;bl=1;
195 j=lg_psi;
196 }
197 aa:
198 for(;j>=1;j--,btb--,bpos--)
199 {
200 bdef=def+ *bpos; bs=s+ *bpos;
201 while(1)
202 {
203 tp= *bpos+1- *btb;
204 if(
205 (
206 (tp>lg_s)
207 &&
208 ( (j>1&&tp> *(bpos-1)) || (j==1))
209 )
210 ||
211 (
212 (cond==0) && (*bpos+1+lg_psi-j>limit)
213 )
214 )
215 { /*Shift is finished*/
216
217 tmp=*btb; max= -1; buu=btb+1;
218 for(k=j+1;k<=lg_psi;k++,buu++)
219 if(*buu<tmp && *buu>max)
220 {
221 max= *buu;tp=k;
222 }
223
224 if(max!= -1)
225 { /*Can put *buu at the position *bpos*/
226 *btb=max;tb[tp]=tmp;
227 if(j>1) *bpos= *(bpos-1)+1;
228 else *bpos= 1;
229 bdef= def+ *bpos; bs=s+ *bpos;
230 *bdef= *btb+ *bs;
231
232 tp= *bpos>*btb+1? *bpos- *btb:1;
233 tmp= *bdef-1; buu=bdef-1;
234 for(k= *bpos-1;k>=tp;k--,tmp--,buu--)
235 if(*buu==tmp)break;
236
237 if(k==tp-1)
238 { /*Succeed*/
239 j++;bpos++;btb++;
240 bs++;bdef++;
241 goto bb;
242 }
243 }/*End of if(max!= -1)*/
244 else break;
245 }/*End of if(tp>lg_s&&(j>1&&tp> *(bpos-1)||j==1))*/
246 else
247 { /*Shift*/
248 (*bpos)++; bdef++;bs++;
249 *bdef= *btb+ *bs;
250 *(bdef-1) -= *btb;
251
252 tp= *bpos>*btb+1? *bpos- *btb:1;
253 tmp= *bdef-1; buu=bdef-1;
254 for(k= *bpos-1;k>=tp;k--,tmp--,buu--)
255 if(*buu==tmp)break;
256
257 if(k==tp-1)
258 { /*Succeed*/
259 j++;bpos++;btb++;
260 bs++;bdef++;
261 goto bb;
262 }
263 }/*End of else if(tp>lg_s&&(j>1&&tp> *(bpos-1)||j==1))*/
264 }/*End of while(1)*/
265 }/*End of for(;j>=1;...)*/
266
267 goto cc;
268
269 bb: for(;j<=lg_psi;j++,bpos++,btb++,bs++,bdef++)
270 {
271 bl=1;
272 if(j!=lg_psi)
273 {
274 max= -1; buu=btb;
275 for(k=j;k<=lg_psi;k++,buu++)
276 if(max< *buu)
277 {
278 max= *buu;tp=k;
279 }
280 /*max must be different from -1*/
281 tmp= *btb; *btb=max; tb[tp]=tmp;
282 }
283 /*not else because nothing changes if(j==lg_psi)*/
284 *bpos= *(bpos-1)+1; /*j must be >1*/
285 *bdef= *btb+ *bs;
286
287 tp= *bpos>*btb+1? *bpos- *btb:1;
288 tmp= *bdef-1; buu=bdef-1;
289 for(k= *bpos-1;k>=tp;k--,tmp--,buu--)
290 if(*buu==tmp)break;
291
292 if(k!=tp-1) goto aa;
293 }/* End of for(;j<=lg_psi;...*/
294
295
296 bpos--;btb--;j--;
297
298 if(cond==0)
299 {
300 if(bl==1)
301 { /*bs is free*/
302 bdef=def+1; buu=uu+1;
303 for(k=1;k<= *bpos;k++,bdef++,buu++) *buu= *bdef;
304
305 sig=1; bs=uu+2;
306 for(k=2;k<= *(bpos-1);k++,bs++)
307 {
308 buu=bs;
309 for(tp=k;tp>1;tp--,buu--)
310 {
311 if(*buu> *(buu-1))
312 {
313 tmp= *buu; *buu= *(buu-1)+1;
314 *(buu-1)=tmp-1; sig= -sig;
315 }
316 else break;
317 }
318 }
319 sigav=sig;
320
321 bav=av+1;buu=uu+1;avv= *bpos-1;
322 for(k=1;k<=avv;k++,buu++,bav++) *bav= *buu;
323 }
324 else
325 {
326
327 sig=sigav;
328
329 buu=uu+1;bav=av+1;
330 for(k=1;k<=avv;k++,buu++,bav++) *buu= *bav;
331
332 bs=s+avv+1;
333 for(;k<= *bpos-1;k++,buu++,bs++,bav++) *bav= *buu= *bs;
334
335 *buu= *btb+ *bs; avv= *bpos-1;
336 }
337
338 /*buu is equal to uu + *bpos*/
339 for(k= *bpos;k>1;k--,buu--)
340 if(*buu> *(buu-1))
341 {
342 tmp= *buu; *buu= *(buu-1)+1;
343 *(buu-1)=tmp-1; sig= -sig;
344 }
345 else break;
346 }
347 else
348 {
349
350 if(bl==1)
351 { /*bs is free*/
352 bdef=def+1;
353 if(*bdef>limit){ goto aa;}
354 buu=uu+1;
355 for(k=1;k<= *bpos;k++,bdef++,buu++) *buu= *bdef;
356
357 sig=1; bs=uu+2;
358 for(k=2;k<= *bpos-1;k++,bs++)
359 {
360 buu=bs;
361 for(tp=k;tp>1;tp--,buu--)
362 {
363 if(*buu> *(buu-1))
364 {
365 tmp= *buu; *buu= *(buu-1)+1;
366 *(buu-1)=tmp-1; sig= -sig;
367 }
368 else break;
369 }
370 if(tp==1 && tmp-1 >limit){ goto aa;}
371 }
372 sigav=sig;
373
374 bav=av+1;buu=uu+1;avv= *bpos-1;
375 for(k=1;k<=avv;k++,buu++,bav++) *bav= *buu;
376 for(k= *bpos;k>1;k--,buu--)
377 if(*buu> *(buu-1))
378 {
379 tmp= *buu; *buu= *(buu-1)+1;
380 *(buu-1)=tmp-1; sig= -sig;
381 }
382 else break;
383 if(tp==1 && tmp-1 >limit) goto aa;
384 }
385 else
386 {
387 if(*(def+1)>limit){bl=1;goto aa;}
388 sig=sigav;
389
390 buu=uu+1;bav=av+1;
391 for(k=1;k<=avv;k++,buu++,bav++) *buu= *bav;
392
393 bs=s+avv+1;
394 for(;k<= *bpos-1;k++,buu++,bs++,bav++) *bav= *buu= *bs;
395
396 *buu= *btb+ *bs; avv= *bpos-1;
397
398 /*buu is equal to uu + *bpos*/
399 for(k= *bpos;k>1;k--,buu--)
400 if(*buu> *(buu-1))
401 {
402 tmp= *buu; *buu= *(buu-1)+1;
403 *(buu-1)=tmp-1; sig= -sig;
404 }
405 else break;
406
407 }
408
409 }
410
411 bs=s+ *bpos+1; buu=uu+ *bpos+1;
412 while(*bs) *buu++ = *bs++;
413 *buu=0;
414 tmp=buu-uu;
415 if(bl==1)
416 {
417 buu=uu+1; bs=pcrt->tab;
418 while(*buu)
419 {
420 if(*buu< *bs)
421 {
422 q=pcrt;pcrt=pcrt->suiv;
423 if(pcrt==NULL)
424 {
425 pcrt=(struct cel *)SYM_MALLOC(sizeof(struct cel));
426 pcrt->prec=q; pcrt->suiv=NULL;
427 q->suiv=pcrt;
428 bs=(PLETCHAR *)SYM_MALLOC(tmp*sizeof(PLETCHAR));
429 pcrt->tab=bs;
430 buu=uu+1;
431 while(*buu) *bs++ = *buu++;
432 *bs=0;
433 pcrt->coef= sig;
434 bl=0;goto aa;
435 }/*End of if(pcrt==NULL)*/
436 else
437 {
438 mv=1; /*to right*/
439 break;
440 }
441 }/*End of if(*buu < *bs*/
442 else if (*buu > *bs)
443 {
444 q=pcrt; pcrt=pcrt->prec;
445 mv= -1; /*to left*/
446 break;
447 }
448 bs++; buu++;
449 }/*End of while(*buu)*/
450
451 if(*buu==0)
452 {
453 lp=pcrt->coef+sig;
454 if(lp==0L)
455 {
456 pcrt->prec->suiv=pcrt->suiv; /*Always a preceeding term*/
457 if(pcrt->suiv !=NULL) pcrt->suiv->prec=pcrt->prec;
458 q=pcrt->prec;
459 SYM_free((char *)pcrt->tab);
460 SYM_free((char *)pcrt);
461 pcrt=q;
462 }
463 else pcrt->coef=lp;
464 bl=0;goto aa;
465 }
466 }/*End of if(bl==1)*/
467 else
468 {
469 mv=1;
470 q=pcrt; pcrt=pcrt->suiv;
471 }
472 if(mv==1)
473 {
474 while(pcrt!=NULL)
475 {
476 buu=uu+1; bs=pcrt->tab;
477 while(*bs) /*buu==0 => *bs==0*/
478 {
479 if(*buu< *bs)
480 {
481 q=pcrt; pcrt=pcrt->suiv; break;
482 }
483 else if(*buu>*bs)
484 {
485 ins=(struct cel *)SYM_MALLOC(sizeof(struct cel));
486 ins->prec=q; ins->suiv=pcrt;
487 q->suiv=ins; pcrt->prec=ins;
488
489 bs=(PLETCHAR *)SYM_MALLOC(tmp*sizeof(PLETCHAR));ins->tab=bs;
490 buu=uu+1;
491 while(*buu) *bs++= *buu++;
492 *bs=0;
493 ins->coef=sig;
494 pcrt=ins;mv=0;bl=0;goto aa;
495 }
496 buu++; bs++;
497 }/*End of while(*buu)*/
498
499 if(*bs==0)
500 {
501 lp=pcrt->coef+sig;
502 if(lp==0L)
503 {
504 q->suiv=pcrt->suiv;
505 if(pcrt->suiv != NULL) pcrt->suiv->prec=q;
506 SYM_free((char *)pcrt->tab);
507 SYM_free((char *)pcrt);
508 pcrt=q;
509 }
510 else pcrt->coef=lp;
511 mv=0;bl=0;goto aa;
512 }
513 }/*End of while pcrt!=NULL*/
514 if(pcrt==NULL)
515 {
516 pcrt=(struct cel *)SYM_MALLOC(sizeof(struct cel));
517 pcrt->prec=q; pcrt->suiv=NULL;
518 q->suiv=pcrt;
519 bs=(PLETCHAR *)SYM_MALLOC(tmp*sizeof(PLETCHAR)); pcrt->tab=bs;
520 buu=uu+1;
521 while(*buu) *bs++ = *buu++;
522 *bs=0;
523 pcrt->coef= sig;
524 mv=0;bl=0;goto aa;
525 }
526 }/*End of if(mv==1)*/
527
528 else if(mv== -1)
529 {
530 while(pcrt!=NULL)
531 {
532 buu=uu+1; bs=pcrt->tab;
533 while(*buu)
534 {
535 if(*buu> *bs)
536 {
537 q=pcrt;pcrt=pcrt->prec;break;
538 }
539 else if(*buu<*bs)
540 {
541 ins=(struct cel *)SYM_MALLOC(sizeof(struct cel));
542 ins->prec=pcrt; ins->suiv=q;
543 q->prec=ins; pcrt->suiv=ins;
544
545 bs=(PLETCHAR *)SYM_MALLOC(tmp*sizeof(PLETCHAR));
546 ins->tab=bs;
547 buu=uu+1;
548 while(*buu) *bs++= *buu++;
549 *bs=0;
550 ins->coef=sig;
551 pcrt=ins;mv=0;bl=0;goto aa;
552 }
553 buu++; bs++;
554 }/*End of while(*buu)*/
555
556 if(*buu==0)
557 {
558 lp=pcrt->coef+sig;
559 if(lp==0L)
560 {
561 pcrt->prec->suiv=q;
562 q->prec=pcrt->prec;
563 SYM_free((char *)pcrt->tab);
564 SYM_free((char *)pcrt);
565 pcrt=q->prec;
566 }
567 else pcrt->coef=lp;
568 mv=0; bl=0;goto aa;
569 }
570 }/*End of while pcrt!=NULL*/
571 /*Never pcrt==NULL => pg never in this part*/
572 }/*End of if(mv==-1)*/
573
574 cc:
575 if(cond==1 && plst->deb->suiv!=NULL && limit < *(s+1)+ *(psi+1)) plst->deb=plst->deb->suiv;
576 SYM_free((char *)pos);
577 SYM_free((char *)av);
578 SYM_free((char *)s);
579 SYM_free((char *)def);
580 SYM_free((char *)tb);
581 SYM_free((char *)uu);
582 return OK;
583 }
584
t_lst_SYM_new(lst,res,f)585 static INT t_lst_SYM_new(lst,res,f)struct cel * lst;
586 OP res; OP f;
587 {
588 INT erg = OK;
589 register PLETCHAR *baf,i;
590 PLETCHAR lg;
591 struct cel *q;
592 OP pol,pa,v,cf;
593 COP("t_lst_SYM_new(2)",res);
594
595 if(lst==NULL) { return OK;}
596 while(lst!=NULL)
597 {
598 pol=CALLOCOBJECT();
599 v=CALLOCOBJECT();
600 pa=CALLOCOBJECT();
601 cf=CALLOCOBJECT();
602
603 baf=lst->tab;
604
605 while(*baf) baf++;
606 lg=baf-lst->tab;
607 m_il_v((INT)lg,v);
608 baf--;
609
610 for(i=0L;i<lg-1L;i++)
611 {
612 M_I_I((INT)(*baf),S_V_I(v,i));
613 baf--;
614 }
615 M_I_I((INT)(*baf),S_V_I(v,i));
616 b_ks_pa(VECTOR,v,pa);
617 M_I_I((INT)lst->coef,cf); /* coeff must be int */
618 MULT_APPLY(f,cf);
619 b_sk_mo(pa,cf,pol);
620 insert_scalar_hashtable(pol,res,add_koeff,eq_monomsymfunc,hash_monompartition);
621 /* AK 031001 wrong order otherwise */
622 q=lst;
623 lst=lst->suiv;
624 SYM_free(q->tab);
625 SYM_free((char *)q);
626 }
627
628 ENDR("plet.c:internal");
629 }
630
l_schur_monomial_mult_new(lg,a,b,c,f)631 static INT l_schur_monomial_mult_new(lg,a,b,c,f) OP lg,a,b,c,f;
632 {
633 INT i;
634 register PLETCHAR *bs;
635 PLETCHAR *s,*psi;
636 struct lst lst;
637
638 lst.deb=NULL;
639 bs=(PLETCHAR *)SYM_MALLOC((S_PA_LI(a)+2)*sizeof(PLETCHAR));
640 s=bs++;
641 for(i=S_PA_LI(a)-1L;i>=0L;i--,bs++)
642 *bs=(PLETCHAR)S_PA_II(a,i);
643 *bs=(PLETCHAR)0;
644
645 bs=(PLETCHAR *)SYM_MALLOC((S_PA_LI(b)+2)*sizeof(PLETCHAR));
646 psi=bs++;
647 for(i=S_PA_LI(b)-1L;i>=0L;i--,bs++)
648 *bs=(PLETCHAR)S_PA_II(b,i);
649 *bs=(PLETCHAR)0;
650
651 muir_lim_new((PLETCHAR)S_I_I(lg),(PLETCHAR)0,s,psi,&lst);
652 t_lst_SYM_new(lst.deb,c,f);
653 SYM_free(psi);
654 return OK;
655 }
656
657