1 #include "def.h"
2 #include "macro.h"
3
4 INT mmm_integer_partition_();
5 INT mmm_partition_partition_();
6 INT mmm_integer_hashtable_();
7 INT mmm_null_partition_();
8 INT mmm___();
9 static INT verf2();
10 static INT coeff_mmm();
11
12
mmm_integer__(a,b,c,f)13 INT mmm_integer__(a,b,c,f) OP a,b,c; OP f;
14 /* AK 311001 */
15 {
16 INT erg = OK;
17
18 CTO(INTEGER,"mmm_integer__(1)",a);
19 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm_integer__(2)",b);
20 CTTO(HASHTABLE,MONOMIAL,"mmm_integer__(3)",c);
21
22 if (S_O_K(b) == PARTITION)
23 erg += mmm_integer_partition_(a,b,c,f);
24 else
25 erg += mmm_integer_hashtable_(a,b,c,f);
26 ENDR("mmm_integer__");
27 }
28
mmm_partition__(a,b,c,f)29 INT mmm_partition__(a,b,c,f) OP a,b,c; OP f;
30 /* AK 311001 */
31 {
32 INT erg = OK;
33 CTO(PARTITION,"mmm_partition__(1)",a);
34 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm_partition__(2)",b);
35 CTTO(HASHTABLE,MONOMIAL,"mmm_partition__(3)",c);
36
37 if (S_O_K(b) == PARTITION)
38 {
39 erg += mmm_partition_partition_(a,b,c,f);
40 goto ende;
41 }
42 else {
43 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mmm_partition_partition_);
44 goto ende;
45 }
46
47 ende:
48 ENDR("mmm_partition__");
49 }
50
mmm_monomial__(a,b,c,f)51 INT mmm_monomial__(a,b,c,f) OP a,b,c,f;
52 /* AK 061101 */
53 /* c += h_a \times s_b \times f */
54 {
55 INT erg = OK;
56 CTO(MONOMIAL,"mmm_monomial__(1)",a);
57 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm_monomial__(2)",b);
58 CTTO(HASHTABLE,MONOMIAL,"mmm_monomial__(3)",c);
59
60 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mmm_partition__);
61
62 ENDR("mmm_monomial__");
63 }
64
mmm_hashtable__(a,b,c,f)65 INT mmm_hashtable__(a,b,c,f) OP a,b,c,f;
66 /* AK 061101 */
67 /* c += m_a \times m_b \times f */
68 {
69 INT erg = OK;
70 CTO(HASHTABLE,"mmm_hashtable__(1)",a);
71 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm_hashtable__(2)",b);
72 CTTO(HASHTABLE,MONOMIAL,"mmm_hashtable__(3)",c);
73
74 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mmm_partition__);
75
76 ENDR("mmm_hashtable__");
77 }
78
mmm_hashtable_hashtable_(a,b,c,f)79 INT mmm_hashtable_hashtable_(a,b,c,f) OP a,b,c,f;
80 /* AK 051201 */
81 /* c += m_a \times m_b \times f */
82 {
83 INT erg = OK;
84 CTO(HASHTABLE,"mmm_hashtable_hashtable_(1)",a);
85 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm_hashtable_hashtable_(2)",b);
86 CTTO(HASHTABLE,MONOMIAL,"mmm_hashtable_hashtable_(3)",c);
87
88 M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mmm_partition_partition_);
89
90 ENDR("mmm_hashtable_hashtable_");
91 }
92
93
mmm_integer_partition_(a,b,c,f)94 INT mmm_integer_partition_(a,b,c,f) OP a,b,c,f;
95 /* AK 061101 */
96 {
97 INT erg = OK;
98 OP m;
99 INT i,k;
100
101 CTO(INTEGER,"mmm_integer_partition_(1)",a);
102 CTO(PARTITION,"mmm_integer_partition_(2)",b);
103 CTTO(MONOMIAL,HASHTABLE,"mmm_integer_partition_(3)",c);
104 SYMCHECK((S_I_I(a) < 0), "mmm_integer_partition_:integer < 0");
105 if (S_I_I(a) == 0) {
106 erg += mmm_null_partition_(b,c,f);
107 goto eee;
108 }
109
110
111 m = CALLOCOBJECT();
112 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
113 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(m));
114 erg += m_il_v(S_PA_LI(b)+1,S_PA_S(S_MO_S(m)));
115 C_O_K(S_PA_S(S_MO_S(m)),INTEGERVECTOR);
116
117 for (i=0,k=0; k<S_PA_LI(S_MO_S(m)); k++,i++)
118 if (k == S_PA_LI(b))
119 M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
120 else if (S_PA_II(b,i) < S_I_I(a))
121 M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
122 else
123 {
124 M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
125 break;
126 }
127
128 for (k++;k<S_PA_LI(S_MO_S(m)); k++,i++)
129 M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
130
131 COPY(f, S_MO_K(m));
132 if (S_O_K(c) == MONOMIAL)
133 INSERT_LIST(m,c,add_koeff,comp_monommonomial);
134 else
135 insert_scalar_hashtable(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
136
137 eee:
138 ENDR("mmm_integer_partition_");
139 }
140
mmm_integer_hashtable_(a,b,c,f)141 INT mmm_integer_hashtable_(a,b,c,f) OP a,b,c,f;
142 /* AK 061101 */
143 {
144 INT erg = OK;
145
146 CTO(INTEGER,"mmm_integer_hashtable_(1)",a);
147 CTTO(HASHTABLE,MONOMIAL,"mmm_integer_hashtable_(2)",b);
148 CTTO(MONOMIAL,HASHTABLE,"integer_hashtable_(3)",c);
149
150 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mmm_integer_partition_);
151
152 ENDR("mmm_integer_hashtable_");
153 }
154
155 OP mmm_ce = NULL;
mmm_ende()156 INT mmm_ende()
157 {
158 INT erg = OK;
159 if (mmm_ce != NULL)
160 {
161 FREEALL(mmm_ce);
162 mmm_ce = NULL;
163 }
164 ENDR("mmm_ende");
165 }
166
mmm_null_partition_(b,c,f)167 INT mmm_null_partition_(b,c,f) OP b,c,f;
168 /* AK 051201 */
169 {
170 INT erg = OK;
171 _NULL_PARTITION_(b,c,f);
172 ENDR("mmm_null_partition");
173 }
174
mmm_partition_partition_(a,b,c,f)175 INT mmm_partition_partition_(a,b,c,f) OP a,b,c; OP f;
176 /* AK 091101 */
177 /* mit der routine verf2 werden alle partitionen im ergebnis geliefert */
178 {
179 INT erg = OK;
180 INT i,im;
181 OP w,ae,be,z,m;
182
183 CTO(PARTITION,"mmm_partition_partition_(1)",a);
184 CTO(PARTITION,"mmm_partition_partition_(2)",b);
185 CTTO(HASHTABLE,MONOMIAL,"mmm_partition_partition_(3)",c);
186
187
188 if (S_PA_LI(a) == 0) {
189 erg += mmm_null_partition_(b,c,f);
190 goto eee;
191 }
192
193 if (S_PA_LI(b) == 0) {
194 erg += mmm_null_partition_(a,c,f);
195 goto eee;
196 }
197
198
199
200 if (S_PA_LI(a) > S_PA_LI(b)) { w = a; a = b; b=w; }
201
202 im = S_PA_II(a,S_PA_LI(a)-1) + S_PA_II(b,S_PA_LI(b)-1);
203
204 ae = CALLOCOBJECT();
205 be = CALLOCOBJECT();
206 w = CALLOCOBJECT();
207 if (mmm_ce == NULL) {
208 mmm_ce = CALLOCOBJECT();
209 erg += init_hashtable(mmm_ce);
210 }
211 erg += weight(a,w);
212
213 t_VECTOR_EXPONENT(b,be);
214 if (S_PA_LI(be) >= im) M_I_I(im,S_PA_L(be));
215 else {
216 i = S_PA_LI(be);
217 inc_vector_co(S_PA_S(be),im-S_PA_LI(be));
218 for (;i<S_PA_LI(be);i++) M_I_I(0,S_PA_I(be,i));
219 }
220 t_VECTOR_EXPONENT(a,ae);
221 if (S_PA_LI(ae) >= im) M_I_I(im,S_PA_L(ae));
222 else {
223 i = S_PA_LI(ae);
224 inc_vector_co(S_PA_S(ae),im-S_PA_LI(ae));
225 for (;i<S_PA_LI(ae);i++) M_I_I(0,S_PA_I(ae,i));
226 }
227 erg += m_l_nv(S_PA_L(be),w);
228
229 C_O_K(w,INTEGERVECTOR);
230 erg += verf2(w,a,be,mmm_ce,im-1);
231
232 FORALL(z,mmm_ce,{
233 m = CALLOCOBJECT();
234 *m = *z;
235 C_O_K(z,EMPTY);
236 FREESELF(S_MO_K(m));
237 M_I_I(0,S_MO_K(m));
238 coeff_mmm(S_MO_S(m),ae,be,S_MO_K(m),1,im-1);
239 if (not EINSP(f))
240 {
241 MULT_APPLY(f,S_MO_K(m));
242 }
243 erg += t_EXPONENT_VECTOR_apply(S_MO_S(m));
244 if (S_O_K(c) == MONOMIAL)
245 INSERT_LIST(m,c,add_koeff,comp_monommonomial);
246 else
247 {
248 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(m)),i);
249 C_PA_HASH(S_MO_S(m),i); /* hash value is computed, insert hash is faster */
250 insert_scalar_hashtable(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
251 }
252
253 });
254
255 M_I_I(0,S_V_I(mmm_ce,S_V_LI(mmm_ce)));
256
257
258 FREEALL(ae);
259 FREEALL(be);
260 FREEALL(w);
261 eee:
262 ENDR("mmm_partition_partition_");
263 }
264
coeff_mmm(a,b,c,res,faktor,starti)265 static INT coeff_mmm(a,b,c,res,faktor,starti) OP a,b,c,res; INT faktor,starti;
266 /* a b c sind in exponenten schreibweise */
267 {
268 INT erg = OK;
269 INT i,j;
270 CTO(PARTITION,"coeff_mmm(1)",a);
271 CTO(PARTITION,"coeff_mmm(2)",b);
272 CTO(PARTITION,"coeff_mmm(3)",c);
273
274 for (;starti >=0;starti--)
275 if (S_PA_II(a,starti)>0) break;
276 for (i=starti; i>=0;i--)
277 {
278 /* zuerst schauen ob nicht noch zu grosse teile da sind */
279
280 if (S_PA_II(a,i) == 0) continue;
281 /* nun versuchen i zu zerlegen */
282
283 if ( (S_PA_II(b,i) > 0) && (S_PA_II(c,i) > 0) &&
284 (S_PA_II(b,i) == S_PA_II(c,i))
285 ) {
286 DEC_INTEGER(S_PA_I(b,i));
287 DEC_INTEGER(S_PA_I(a,i));
288 coeff_mmm(a,b,c,res,2*faktor,i);
289 INC_INTEGER(S_PA_I(b,i));
290 INC_INTEGER(S_PA_I(a,i));
291 goto weiter;
292 }
293 if (S_PA_II(b,i) > 0) {
294 DEC_INTEGER(S_PA_I(b,i));
295 DEC_INTEGER(S_PA_I(a,i));
296 coeff_mmm(a,b,c,res,faktor,i);
297 INC_INTEGER(S_PA_I(b,i));
298 INC_INTEGER(S_PA_I(a,i));
299 }
300 if (S_PA_II(c,i) > 0) {
301 DEC_INTEGER(S_PA_I(c,i));
302 DEC_INTEGER(S_PA_I(a,i));
303 coeff_mmm(a,b,c,res,faktor,i);
304 INC_INTEGER(S_PA_I(a,i));
305 INC_INTEGER(S_PA_I(c,i));
306 }
307 weiter:
308 for (j=0;j<i;j++)
309 {
310 if (
311 (S_PA_II(b,j) > 0) && (S_PA_II(c,i-j-1) > 0)
312 /* aber verschieden */
313 )
314 {
315 DEC_INTEGER(S_PA_I(b,j));
316 DEC_INTEGER(S_PA_I(c,i-j-1));
317 DEC_INTEGER(S_PA_I(a,i));
318 coeff_mmm(a,b,c,res,faktor,starti);
319 INC_INTEGER(S_PA_I(a,i));
320 INC_INTEGER(S_PA_I(c,i-j-1));
321 INC_INTEGER(S_PA_I(b,j));
322 }
323
324
325 }
326 goto eee;
327 }
328 if (i<0) /* null , blatt res erhoehen */
329 {
330 M_I_I(1*faktor + S_I_I(res),res);
331 goto eee;
332 }
333 eee:
334 ENDR("internal to mult_monomial_monomial");
335 }
336
337
338
mult_monomial_monomial(a,b,c)339 INT mult_monomial_monomial(a,b,c) OP a,b,c;
340 /* AK 111001
341 */
342 {
343 INT erg = OK;
344 INT t=0; /* is 1 if transfer HASHTABLE->MONOMIAL necessary */
345 CTTTTO(HASHTABLE,INTEGER,PARTITION,MONOMIAL,"mult_monomial_monomial(1)",a);
346 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mult_monomial_monomial(2)",b);
347 CTTTO(EMPTY,HASHTABLE,MONOMIAL,"mult_monomial_monomial(3)",c);
348
349 if (S_O_K(c) == EMPTY) {
350 if (S_O_K(a) == INTEGER)
351 {
352 if (S_O_K(b) == PARTITION) init_monomial(c);
353 else { t=1; init_hashtable(c); }
354 }
355 else { t=1; init_hashtable(c); }
356 }
357
358 erg += mmm___(a,b,c,cons_eins);
359
360 if (t==1) t_HASHTABLE_MONOMIAL(c,c);
361 ENDR("mult_monomial_monomial");
362 }
363
mmm___(a,b,c,f)364 INT mmm___(a,b,c,f) OP a,b,c,f;
365 {
366 INT erg = OK;
367 CTTTTO(HASHTABLE,INTEGER,PARTITION,MONOMIAL,"mmm___(1)",a);
368 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mmm___(2)",b);
369 CTTO(HASHTABLE,MONOMIAL,"mmm___(3)",c);
370
371 if (S_O_K(a) == INTEGER)
372 {
373 erg += mmm_integer__(a,b,c,f);
374 }
375 else if (S_O_K(a) == PARTITION)
376 {
377 erg += mmm_partition__(a,b,c,f);
378 }
379 else if (S_O_K(a) == MONOMIAL)
380 {
381 erg += mmm_monomial__(a,b,c,f);
382 }
383 else /* if (S_O_K(a) == HASHTABLE) */
384 {
385 erg += mmm_hashtable__(a,b,c,f);
386 }
387
388 ENDR("mmm___");
389 }
390
verf2(v,a,b,c,limit)391 static INT verf2(v,a,b,c,limit) OP a,b,c; OP v; INT limit;
392 {
393 INT erg = OK;
394 INT i,j;
395 OP m;
396 CTO(PARTITION,"verf2(1)",a);
397 CTO(PARTITION,"verf2(2)",b);
398 CTO(HASHTABLE,"verf2(3)",c);
399
400
401
402 if (S_PA_LI(a) == 1)
403 {
404 OP d,ps,z,h,h2,p2;
405 d = b;
406
407 m = CALLOCOBJECT();
408 ps = CALLOCOBJECT();
409 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
410 erg += m_il_integervector(S_PA_LI(d),ps);
411 erg += b_ks_pa(EXPONENT,ps,S_MO_S(m));
412
413 for (i = 0,z=S_V_S(S_PA_S(d));i<S_PA_LI(d);i++,z++)
414 {
415 if (S_I_I(z) != 0) {
416 DEC_INTEGER(z);
417 INC_INTEGER(S_PA_I(d,i+S_PA_II(a,0)));
418 for (j=0,h=S_V_S(ps),h2=S_V_S(v),p2=S_V_S(S_PA_S(d));
419 j<S_V_LI(ps);
420 j++,h++,h2++,p2++)
421 M_I_I(S_I_I(h2)+S_I_I(p2), h );
422 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(m)),j);
423 C_PA_HASH(S_MO_S(m),j);
424 M_I_I(S_PA_II(d,i+S_PA_II(a,0)), S_MO_K(m));
425
426 add_apply_hashtable(m,c,add_koeff,eq_monomsymfunc,
427 hash_monompartition);
428 DEC_INTEGER(S_PA_I(d,i+S_PA_II(a,0)));
429 INC_INTEGER(z);
430 }
431 }
432
433 /* noch das monom ohne addition der exponenten */
434
435 INC_INTEGER(S_PA_I(d,S_PA_II(a,0)-1));
436 for (j=0,h=S_V_S(ps),h2=S_V_S(v),p2=S_V_S(S_PA_S(d));
437 j<S_V_LI(ps);
438 j++,h++,h2++,p2++)
439 M_I_I(S_I_I(h2)+S_I_I(p2), h );
440 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(m)),j);
441 C_PA_HASH(S_MO_S(m),j);
442 M_I_I(S_PA_II(d,S_PA_II(a,0)-1), S_MO_K(m));
443 add_apply_hashtable(m,c,add_koeff,eq_monomsymfunc,
444 hash_monompartition);
445
446 DEC_INTEGER(S_PA_I(d,S_PA_II(a,0)-1));
447 FREEALL(m);
448 }
449 else{
450 /* in die rekursion */
451 INT pi;OP z,h;
452
453 pi = S_PA_II(a,S_PA_LI(a)-1);
454 DEC_INTEGER(S_PA_L(a));
455 for (i = 0,z=S_V_S(S_PA_S(b)),h = S_V_I(v,pi);
456 i<S_PA_LI(b);i++,z++,h++)
457 {
458 if (S_I_I(z) != 0) {
459 DEC_INTEGER(z);
460 INC_INTEGER(h);
461 verf2(v,a,b,c,i+pi-1);
462 DEC_INTEGER(h);
463 INC_INTEGER(z);
464 }
465 }
466
467 INC_INTEGER(S_V_I(v, pi-1) );
468 verf2(v,a,b,c,pi-1);
469 DEC_INTEGER(S_V_I(v, pi-1) );
470 INC_INTEGER(S_PA_L(a));
471 }
472
473
474
475 ENDR("verf2");
476 }
477
478
479