1 
2 #include "def.h"
3 #include "macro.h"
4 
5 static INT m_k_to_h_lambda();
6 
7 static OP mh_speicher = NULL;
8 INT mult_hashtable_hashtable_faktor();
9 INT mult_hashtable_hashtable();
10 INT tmh___faktor();
11 INT teh_integer__faktor();
12 INT add_apply_hashtable();
13 INT monomial_recursion();
14 INT splitpart();
15 INT mmm_partition_partition_();
16 INT binom_small();
17 
18 
19 
tmh_ende()20 INT tmh_ende()
21 {
22     INT erg = OK;
23     if (mh_speicher != NULL)
24         {
25         FREEALL(mh_speicher);
26         }
27     mh_speicher=NULL;
28     ENDR("tmh_ende");
29 }
30 
t_MONOMIAL_HOMSYM(a,b)31 INT t_MONOMIAL_HOMSYM(a,b) OP a,b;
32 /* AK 301001 */
33 {
34     INT erg = OK;
35     INT t=0;
36     INT i,w=0;
37     OP z=NULL;
38     CTTTTO(HASHTABLE,INTEGER,MONOMIAL,PARTITION,"t_MONOMIAL_HOMSYM(1)",a);
39     TCE2(a,b,t_MONOMIAL_HOMSYM,HOMSYM);
40 
41     /* check for the size of the result */
42     if (S_O_K(a) == INTEGER)
43         {
44         w = numberofpart_i(a);
45         goto ww;
46         }
47     else if (S_O_K(a) == PARTITION) {
48         for (i=0;i<S_PA_LI(a);i++) w += S_PA_II(a,i);
49         z = CALLOCOBJECT(); M_I_I(w,z);
50         w = numberofpart_i(z);
51         FREEALL(z);
52         goto ww;
53         }
54 
55     if (NULLP(a))
56         {
57         if (a == b) {
58             if (S_O_K(a) == MONOMIAL) erg += init(HOMSYM,b);
59             goto endr_ende;
60             }
61         init(HOMSYM,b);
62         goto endr_ende;
63         }
64 
65     if (S_O_K(a) == MONOMIAL) {
66         z = S_S_S(a);
67         for (i=0;i<S_PA_LI(z);i++) w += S_PA_II(z,i);
68         z = CALLOCOBJECT(); M_I_I(w,z);
69         w = numberofpart_i(z);
70         FREEALL(z);
71         }
72     else {
73         FORALL(z,a,{ goto fff; } );
74 
75 fff:
76         z = S_MO_S(z);
77         for (i=0;i<S_PA_LI(z);i++) w += S_PA_II(z,i);
78         z = CALLOCOBJECT(); M_I_I(w,z);
79         w = numberofpart_i(z);
80         FREEALL(z);
81         }
82     /* w ist die geschaetzte ergebnis groesse, ist korrekt fuer
83        homogenes m */
84 ww:
85     if (a == b) {
86         OP c;
87         c = CALLOCOBJECT();
88         *c = *a;
89         C_O_K(a,EMPTY);
90         erg += init_size_hashtable(a,2*w);
91         t = 1;
92         erg += tmh___faktor(c,b,cons_eins);
93         FREEALL(c);
94         }
95     else if (S_O_K(b) == HOMSYM)
96         {
97         OP c;
98         c = CALLOCOBJECT();
99         erg += init_size_hashtable(c,2*w);
100         erg += tmh___faktor(a,c,cons_eins);
101         INSERT_LIST(c,b,add_koeff,comp_monomhomsym);
102         }
103     else {
104         if (S_O_K(b) == EMPTY) {
105             erg += init_size_hashtable(b,2*w);
106             t = 1;
107             }
108         if (S_O_K(b) != HASHTABLE)
109             {
110             FREESELF(b);
111             erg += init_size_hashtable(b,2*w);
112             t = 1;
113             }
114         erg += tmh___faktor(a,b,cons_eins);
115         }
116     if (t == 1)
117         erg += t_HASHTABLE_HOMSYM(b,b);
118 
119 
120     ENDR("t_MONOMIAL_HOMSYM");
121 }
122 
123 INT tmh_integer__faktor();
find_tmh_integer(a)124 OP find_tmh_integer(a) OP a;
125 /* AK 300102 */
126 {
127     INT erg = OK;
128     CTO(INTEGER,"find_tmh_integer(1)",a);
129     SYMCHECK( (S_I_I(a) < 0) ,"find_tmh_integer:integer < 0");
130     if (
131          (mh_speicher == NULL)
132          ||
133          (S_I_I(a) >= S_V_LI(mh_speicher) )
134          ||
135          (EMPTYP(S_V_I(mh_speicher,S_I_I(a))) )
136        )
137            {
138            OP c;
139            NEW_HASHTABLE(c);
140            tmh_integer__faktor(a,c,cons_eins);
141            FREEALL(c);
142            }
143 
144 
145     return S_V_I(mh_speicher,S_I_I(a));
146 
147     ENDO("find_tmh_integer");
148 }
149 
tmh_integer__faktor(a,b,faktor)150 INT tmh_integer__faktor(a,b,faktor) OP a,b;OP faktor;
151 /* called from tme_integer__faktor */
152 {
153     INT erg = OK;
154     OP p,c;
155     CTO(INTEGER,"tmh_integer__faktor(1)",a);
156     CTO(HASHTABLE,"tmh_integer__faktor(2)",b);
157     SYMCHECK( (S_I_I(a) < 0) ,"tmh_integer__faktor:integer < 0");
158 
159 
160     if (mh_speicher == NULL) { mh_speicher=CALLOCOBJECT();
161                                m_il_v(20,mh_speicher); }
162 
163     if (S_I_I(a) >= S_V_LI(mh_speicher) ) {
164         erg += inc_vector_co(mh_speicher, S_I_I(a)+5- S_V_LI(mh_speicher));
165         }
166 
167 again:
168     if (not EMPTYP(S_V_I(mh_speicher,S_I_I(a)) ) )
169         {
170         OP d,m;
171         FORALL(d,S_V_I(mh_speicher,S_I_I(a)), {
172             m = CALLOCOBJECT();
173             b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
174             copy_partition(S_MO_S(d),S_MO_S(m));
175             MULT(faktor,S_MO_K(d),S_MO_K(m));
176             insert_scalar_hashtable(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
177             });
178         goto eee;
179         }
180 
181     SYMCHECK(not EMPTYP(S_V_I(mh_speicher,S_I_I(a))),"tmh_integer__faktor:i1");
182     init_size_hashtable(S_V_I(mh_speicher,S_I_I(a)), 2 * numberofpart_i(a)+1);
183     /* erg += init(HASHTABLE,S_V_I(mh_speicher,S_I_I(a))); */
184 
185     if (S_I_I(a) == 0) {
186         OP m;
187         m = CALLOCOBJECT();
188         b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
189         first_partition(cons_null,S_MO_S(m));
190         M_I_I(1,S_MO_K(m));
191         insert_scalar_hashtable(m,
192                                 S_V_I(mh_speicher,0),
193                                 add_koeff,
194                                 eq_monomsymfunc,
195                                 hash_monompartition);
196         goto again;
197         }
198 
199 
200     p  = CALLOCOBJECT();
201     erg += first_partition(a,p);
202 
203     c = CALLOCOBJECT();
204     do {
205          OP m;
206          m = CALLOCOBJECT();
207          b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
208          erg += copy_partition(p,S_MO_S(m));
209          erg += m_k_to_h_lambda(a,p,S_MO_K(m));
210          if (EINSP(faktor)) {
211              add_apply_hashtable(m,b,add_koeff,eq_monomsymfunc,
212                                       hash_monompartition);
213              insert_scalar_hashtable(m,S_V_I(mh_speicher,S_I_I(a)),add_koeff,
214                            eq_monomsymfunc,hash_monompartition);
215              }
216          else{
217              OP k1,k2;
218              k1 = CALLOCOBJECT();
219              k2 = S_MO_K(m);
220              MULT(faktor,k2,k1);
221              C_MO_K(m,k1);
222              add_apply_hashtable(m,b,add_koeff,eq_monomsymfunc,
223                                       hash_monompartition);
224              C_MO_K(m,k2); FREEALL(k1);
225              insert_scalar_hashtable(m,S_V_I(mh_speicher,S_I_I(a)),add_koeff,
226                            eq_monomsymfunc,hash_monompartition);
227              }
228 
229     } while(next_apply(p));
230 
231     FREEALL(c);
232     FREEALL(p);
233 
234 eee:
235     ENDR("tmh_integer__faktor");
236 }
237 
238 INT mhh_hashtable_hashtable_();
tmh_partition__faktor(a,b,faktor)239 INT tmh_partition__faktor(a,b,faktor) OP a,b;OP faktor;
240 {
241     INT erg = OK;
242     CTO(PARTITION,"tmh_partition__faktor(1)",a);
243     CTO(HASHTABLE,"tmh_partition__faktor(2)",b);
244     if (S_PA_LI(a) == 0)
245         {
246         OP d;
247         d = CALLOCOBJECT();
248         erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
249         COPY(faktor,S_MO_K(d));
250         erg += first_partition(cons_null,S_MO_S(d));
251         insert_scalar_hashtable(d,b,add_koeff,eq_monomsymfunc,
252                                    hash_monompartition);
253         goto eee;
254         }
255     else if (S_PA_LI(a) == 1)
256         {
257         erg += tmh_integer__faktor(S_PA_I(a,0),b,faktor);
258         goto eee;
259         }
260     else if (S_PA_II(a,S_PA_LI(a)-1) == 1)
261         { /* AK 191001 */
262         erg += teh_integer__faktor(S_PA_L(a),b,faktor);
263         goto eee;
264         }
265     else {
266         erg += monomial_recursion(a,b,faktor,
267                tmh_partition__faktor,
268                tmh___faktor,
269                mhh_hashtable_hashtable_);
270 
271         goto eee;
272         }
273 eee:
274     ENDR("tmh_partition__faktor");
275 }
276 
monomial_recursion2(a,b,faktor,partf,integerf,elmsymf,multf)277 INT monomial_recursion2(a,b,faktor,partf,integerf,elmsymf,multf) OP a,b;OP faktor;
278      INT (*partf)(); INT (*multf)(); INT (*integerf)();
279      INT (*elmsymf)();
280 /* implementiert die zweite rekursion fuer monomial symmetric functions */
281 {
282     INT erg = OK;
283     OP z,ha,h2,h3;
284     /* static INT level=0; */
285     CTTO(HASHTABLE,MONOMIAL,"monomial_recursion2(1)",a);
286     CTO(HASHTABLE,"monomial_recursion2(2)",b);
287 
288 
289     ha = CALLOCOBJECT();
290     if (S_O_K(a) == HASHTABLE)
291         COPY(a,ha);
292     else
293         t_MONOMIAL_HASHTABLE(a,ha);
294 
295 /* die partitionen in ha werden immer kuerzer */
296     NEW_HASHTABLE(h2);
297     NEW_HASHTABLE(h3);
298 
299     while (not NULLP_HASHTABLE(ha)) {
300         OP c,p1,p2,m1,m2,coeff;
301         /* step one */
302         /* find a partition of maximal length */
303         z = findmax_monomial(ha,length_comp_part);
304 
305         if (S_PA_LI(S_MO_S(z)) == 0) { /* constant term only  */
306             OP f;
307             f = CALLOCOBJECT();
308             MULT(S_MO_K(z),faktor,f);
309             (*integerf)(cons_null,b,f);
310             FREESELF(z);
311             DEC_INTEGER(S_V_I(ha,S_V_LI(ha)));
312             FREEALL(f);
313             continue;
314             }
315         if (S_PA_LI(S_MO_S(z)) == 1) { /* powsym */
316             OP f;
317             f = CALLOCOBJECT();
318             MULT(S_MO_K(z),faktor,f);
319             (*integerf)(S_PA_I(S_MO_S(z),0),b,f);
320             FREESELF(z);
321             DEC_INTEGER(S_V_I(ha,S_V_LI(ha)));
322             FREEALL(f);
323             continue;
324             }
325         if (S_PA_II(S_MO_S(z), S_PA_LI(S_MO_S(z))-1)  == 1) { /* elmsym */
326             OP f;
327             f = CALLOCOBJECT();
328             MULT(S_MO_K(z),faktor,f);
329             (*elmsymf)(S_PA_L(S_MO_S(z)),b,f);
330             FREESELF(z);
331             DEC_INTEGER(S_V_I(ha,S_V_LI(ha)));
332             FREEALL(f);
333             continue;
334             }
335         p1 = CALLOCOBJECT();
336         p2 = CALLOCOBJECT();
337         splitpart(S_MO_S(z),p1,p2);
338 
339         NEW_HASHTABLE(m1);
340         erg += mmm_partition_partition_(p1,p2,m1,cons_eins);
341 
342         m2 = CALLOCOBJECT();
343         erg += b_sk_mo(NULL,NULL,m2);
344         C_MO_S(m2,S_MO_S(z));
345 
346 
347         c = find_hashtable(m2,m1,eq_monomsymfunc,hash_monompartition);
348         SYMCHECK( (c == NULL) ,"monomial_recursion2:wrong leading monomial");
349         coeff = CALLOCOBJECT();
350         erg += div(S_MO_K(z),S_MO_K(c),coeff); /* leitkoeff */
351         MULT_APPLY(coeff,m1);
352 
353         /* es gilt jetzt m_a = (m_p1 * m_p2 )*coeff - m1 */
354 
355         /* m1 von ha abziehen */
356         addinvers_apply_hashtable(m1);
357 
358         INSERT_HASHTABLE(m1,ha,add_koeff,eq_monomsymfunc,hash_monompartition);
359         /* ha ist jetzt ohne maximale monom und m1 wurde abgezogen */
360 
361         erg += (*partf)(p1,h2,coeff);
362         C_MO_S(m2,p1);
363         C_MO_K(m2,coeff);
364         FREEALL(m2); /* wg NULL in b_sk_mo *//* p1, coeff freed */
365 
366         erg += (*partf)(p2,h3,faktor);
367         FREEALL(p2);
368 
369         erg += (*multf)(h3,h2,b);
370 
371 
372         CLEAR_HASHTABLE(h2);
373         CLEAR_HASHTABLE(h3);
374         }
375     FREEALL(ha);
376     FREEALL(h2);
377     FREEALL(h3);
378     /* level--; */
379     ENDR("monomial_recursion2");
380 }
381 
382 
tmh_monomial__faktor(a,b,faktor)383 INT tmh_monomial__faktor(a,b,faktor) OP a,b;OP faktor;
384 {
385     INT erg = OK;
386     CTTO(HASHTABLE,MONOMIAL,"tmh_monomial__faktor(1)",a);
387     CTO(HASHTABLE,"tmh_monomial__faktor(2)",b);
388 
389     monomial_recursion2(a,b,faktor,
390              tmh_partition__faktor,tmh_integer__faktor,teh_integer__faktor,
391              mult_homsym_homsym);
392 
393 
394     ENDR("tmh_monomial__faktor");
395 }
396 
tmh___faktor(a,b,faktor)397 INT tmh___faktor(a,b,faktor) OP a,b;OP faktor;
398 /* AK 180901 */
399 /* after multiplication by the faktor
400    the result will be inserted in the hashtable b
401 */
402 /* not static used from tme.c */
403 {
404     INT erg = OK;
405     CTTTTO(HASHTABLE,INTEGER,MONOMIAL,PARTITION,"tmh___faktor(1)",a);
406     CTO(HASHTABLE,"tmh___faktor(2)",b);
407     CTO(ANYTYPE,"tmh___faktor(3)",faktor);
408     if (mh_speicher == NULL) { mh_speicher=CALLOCOBJECT();
409                                m_il_v(20,mh_speicher); }
410     if (S_O_K(a) == INTEGER)
411         {
412         erg += tmh_integer__faktor(a,b,faktor);
413         goto eee;
414         }
415     else if (S_O_K(a) == PARTITION)
416         {
417         erg += tmh_partition__faktor(a,b,faktor);
418         goto eee;
419         }
420     else /* HASHTABLE MONOMIAL */
421         {
422         erg += tmh_monomial__faktor(a,b,faktor);
423         goto eee;
424         }
425 eee:
426     ENDR("tmh___faktor");
427 }
428 
429 
430 
m_k_to_h_lambda(a,b,c)431 static INT m_k_to_h_lambda(a,b,c) OP a,b,c;
432 /* AK 180901 */
433 /* computes the single coefficient */
434 /* of h_b in the expansion of m_k */
435 {
436     INT erg = OK,w,i,l;
437     OP exp,oben,mn,bn,unten;
438     CTO(INTEGER,"m_k_to_h_lambda",a);
439     CTO(PARTITION,"m_k_to_h_lambda",b);
440 
441     for (w=0,i=0;i<S_PA_LI(b);i++)
442         w += S_PA_II(b,i);
443 
444     if (w != S_I_I(a)) {
445         error("different weights");
446         goto endr_ende; }
447 
448 
449     exp = CALLOCOBJECT();
450     erg += t_VECTOR_EXPONENT(b,exp);
451 
452 
453     w = w - S_PA_II(exp,0);
454     l = S_PA_LI(b)-S_PA_II(exp,0);
455     FREESELF(c);
456 
457     if (l <= 0) {
458         M_I_I(1,c);
459 	FREEALL(exp);
460 	goto faktor;
461 	}
462 
463     oben = CALLOCOBJECT();
464     mn = CALLOCOBJECT();
465     M_I_I(l,oben);
466     M_I_I(0,S_PA_I(exp,0));
467     if (l > 12)
468         erg += multinom(oben,S_PA_S(exp),mn);
469     else
470         erg += multinom_small(oben,S_PA_S(exp),mn);
471 
472     FREEALL(exp);
473     M_I_I(w,c);
474     MULT_APPLY(mn,c);
475     GANZDIV_APPLY(c,oben);
476     /* erg += div(c,oben,c); */
477 
478     if ((S_I_I(a)-w-1+l)  > 0) {
479         M_I_I(S_I_I(a)-w-1+l,oben);
480         unten = CALLOCOBJECT();
481         M_I_I(l-1,unten);
482         bn = CALLOCOBJECT();
483 
484         if (S_I_I(oben) <= 12) {
485             erg += binom_small(oben,unten,bn);
486             MULT_APPLY_INTEGER(bn,c);
487             M_I_I(l,unten);
488             C_O_K(bn,EMPTY);
489             erg += binom_small(oben,unten,bn);
490             MULT_APPLY_INTEGER(mn,bn);
491             }
492         else {
493             erg += binom(oben,unten,bn);
494             MULT_APPLY(bn,c);
495             M_I_I(l,unten);
496             erg += binom(oben,unten,bn);
497             MULT_APPLY(mn,bn);
498             }
499         ADD_APPLY(bn,c);
500         FREEALL(unten);
501         FREEALL(bn);
502         }
503 
504 
505 
506     FREEALL(oben);
507     FREEALL(mn);
508 faktor:
509     if ((S_PA_LI(b)%2)==0)
510         {
511         ADDINVERS_APPLY(c);
512         }
513     ENDR("internal to tmh___faktor");
514 }
515 
516 
mult_hashtable_hashtable_faktor(a,b,d,faktor)517 INT mult_hashtable_hashtable_faktor(a,b,d,faktor) OP a,b,d; OP faktor;
518 /* AK 171001 */
519 /* a und b sind hashtable */
520 /* sind beides homogene homsym functions
521    sind beide sehr voll besetzt d.h. fast alle partitionenmit coeff != 0
522 
523    das ergebnis wird mit faktor in d eingefuegt */
524 {
525     OP x=NULL,y=NULL,c;
526     OP wx,wy,p;
527     INT erg = OK,i,j,k;
528 
529     CTTTTO(HOMSYM,POWSYM,ELMSYM,HASHTABLE,"mult_hashtable_hashtable(1)",a);
530     CTTTTO(HOMSYM,POWSYM,ELMSYM,HASHTABLE,"mult_hashtable_hashtable(2)",b);
531     CTO(HASHTABLE,"mult_hashtable_hashtable(3)",d);
532 
533 
534 
535     FORALL(x,a, { goto ee; });
536 ee:
537     FORALL(y,b, { goto ff; });
538 ff: /* x und y sind jetzt monome, das gemeinsame gewicht bestimmen */
539     wx=CALLOCOBJECT(); weight(S_MO_S(x),wx);
540     wy=CALLOCOBJECT(); weight(S_MO_S(y),wy);
541     ADD_APPLY(wx,wy);
542     p = CALLOCOBJECT();
543 
544 
545     b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),p);
546     M_I_I(0,S_MO_K(p));
547     b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(p));
548     m_il_integervector(S_I_I(wy),S_PA_S(S_MO_S(p)));
549 
550     /* wy ist das gewicht der ergebnispartition
551        p ist ein monom mit platz fuer die maximale partition */
552 
553 
554     FORALL(x,a, {
555 
556         FORALL(y,b, {
557             i=j=k=0;
558             while ( (i<S_PA_LI(S_MO_S(y))) || (j<S_PA_LI(S_MO_S(x))) )
559                 {
560                 if (j==S_PA_LI(S_MO_S(x)))
561                     { M_I_I(S_PA_II(S_MO_S(y),i), S_PA_I(S_MO_S(p),k) ); k++;i++; }
562                 else if (i==S_PA_LI(S_MO_S(y)))
563                     { M_I_I(S_PA_II(S_MO_S(x),j), S_PA_I(S_MO_S(p),k) ); k++;j++; }
564                 else if (S_PA_II(S_MO_S(x),j) < S_PA_II(S_MO_S(y),i) )
565                     { M_I_I(S_PA_II(S_MO_S(x),j), S_PA_I(S_MO_S(p),k) ); k++;j++; }
566                 else
567                     { M_I_I(S_PA_II(S_MO_S(y),i), S_PA_I(S_MO_S(p),k) ); k++;i++; }
568                 }
569 
570             M_I_I(k,S_PA_L(S_MO_S(p)));
571             HASH_INTEGERVECTOR(S_PA_S(S_MO_S(p)),j);
572             C_PA_HASH(S_MO_S(p),j);
573             /* jetzt suchen in der hashtable */
574             c = find_hashtable(p,d,eq_monomsymfunc,hash_monompartition);
575             if (c == NULL) { /* einfuegen */
576                           OP m;
577                           m = CALLOCOBJECT();
578                           b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
579                           MULT(S_MO_K(x),S_MO_K(y),S_MO_K(m));
580                           MULT_APPLY(faktor,S_MO_K(m));
581                           copy_partition(S_MO_S(p),S_MO_S(m));
582                           INSERT_HASHTABLE(m,d,NULL,eq_monomsymfunc,hash_monompartition);
583                           }
584             else          {
585                           FREESELF(wx);
586                           MULT(S_MO_K(x),S_MO_K(y),wx);
587                           MULT_APPLY(faktor,wx);
588                           ADD_APPLY(wx,S_MO_K(c));
589                           }
590             } );
591         } );
592      FREEALL(p);
593      FREEALL(wx);
594      FREEALL(wy);
595      ENDR("mult_hashtable_hashtable_faktor");
596 }
597 
598 
mult_hashtable_hashtable(a,b,d)599 INT mult_hashtable_hashtable(a,b,d) OP a,b,d;
600 /* AK 171001 */
601 /* a und b sind hashtable */
602 /* sind beides homogene homsym functions
603    sind beide sehr voll besetzt d.h. fast alle partitionenmit coeff != 0
604    das ergebnis wird in d eingefuegt */
605 {
606     OP x=NULL,y=NULL,c;
607     OP wx,wy,p;
608     INT erg = OK,i,j,k;
609 
610     CTTTTO(HOMSYM,POWSYM,ELMSYM,HASHTABLE,"mult_hashtable_hashtable(1)",a);
611     CTTTTO(HOMSYM,POWSYM,ELMSYM,HASHTABLE,"mult_hashtable_hashtable(2)",b);
612     CTO(HASHTABLE,"mult_hashtable_hashtable(3)",d);
613 
614 
615 
616     FORALL(x,a, { goto ee; });
617 ee:
618     FORALL(y,b, { goto ff; });
619 ff: /* x und y sind jetzt monome, das gemeinsame gewicht bestimmen */
620     wx=CALLOCOBJECT(); weight(S_MO_S(x),wx);
621     wy=CALLOCOBJECT(); weight(S_MO_S(y),wy);
622     ADD_APPLY(wx,wy);
623     p = CALLOCOBJECT();
624 
625 
626     b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),p);
627     M_I_I(0,S_MO_K(p));
628     b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(p));
629     m_il_integervector(S_I_I(wy),S_PA_S(S_MO_S(p)));
630 
631     /* wy ist das gewicht der ergebnispartition
632        p ist ein monom mit platz fuer die maximale partition */
633 
634 
635     FORALL(x,a, {
636 
637         FORALL(y,b, {
638             i=j=k=0;
639             while ( (i<S_PA_LI(S_MO_S(y))) || (j<S_PA_LI(S_MO_S(x))) )
640                 {
641                 if (j==S_PA_LI(S_MO_S(x)))
642                     { M_I_I(S_PA_II(S_MO_S(y),i), S_PA_I(S_MO_S(p),k) ); k++;i++; }
643                 else if (i==S_PA_LI(S_MO_S(y)))
644                     { M_I_I(S_PA_II(S_MO_S(x),j), S_PA_I(S_MO_S(p),k) ); k++;j++; }
645                 else if (S_PA_II(S_MO_S(x),j) < S_PA_II(S_MO_S(y),i) )
646                     { M_I_I(S_PA_II(S_MO_S(x),j), S_PA_I(S_MO_S(p),k) ); k++;j++; }
647                 else
648                     { M_I_I(S_PA_II(S_MO_S(y),i), S_PA_I(S_MO_S(p),k) ); k++;i++; }
649                 }
650 
651             M_I_I(k,S_PA_L(S_MO_S(p)));
652             HASH_INTEGERVECTOR(S_PA_S(S_MO_S(p)),j);
653             C_PA_HASH(S_MO_S(p),j);
654             /* jetzt suchen in der hashtable */
655             c = find_hashtable(p,d,eq_monomsymfunc,hash_monompartition);
656             if (c == NULL) { /* einfuegen */
657                           OP m;
658                           m = CALLOCOBJECT();
659                           b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
660                           MULT(S_MO_K(x),S_MO_K(y),S_MO_K(m));
661                           copy_partition(S_MO_S(p),S_MO_S(m));
662                           INSERT_HASHTABLE(m,d,NULL,eq_monomsymfunc,hash_monompartition);
663                           }
664             else          {
665                           FREESELF(wx);
666                           MULT(S_MO_K(x),S_MO_K(y),wx);
667                           ADD_APPLY(wx,S_MO_K(c));
668                           }
669             } );
670         } );
671      FREEALL(p);
672      FREEALL(wx);
673      FREEALL(wy);
674      ENDR("mult_hashtable_hashtable_faktor");
675 }
676 
677