1 #include "def.h"
2 #include "macro.h"
3 
4 static OP mpp_pp_m = NULL;
mpp_ende()5 INT mpp_ende()
6 {
7     INT erg = OK;
8     if (mpp_pp_m != NULL)
9         {
10         FREEALL(mpp_pp_m);
11         mpp_pp_m=NULL;
12         }
13     ENDR("mpp_ende");
14 }
15 
16 INT m_merge_partition_partition();
17 INT mpp_integer_partition_();
18 INT mpp_integer_hashtable_();
mpp_integer__(a,b,c,f)19 INT mpp_integer__(a,b,c,f) OP a,b,c; OP f;
20 /* AK 311001 */
21 {
22     INT erg = OK;
23     CTO(INTEGER,"mpp_integer__(1)",a);
24     CTTTO(HASHTABLE,PARTITION,POWSYM,"mpp_integer__(2)",b);
25     CTTO(HASHTABLE,POWSYM,"mpp_integer__(3)",c);
26 
27     if (S_O_K(b) == PARTITION) {
28         erg += mpp_integer_partition_(a,b,c,f);
29         goto ende;
30         }
31     else
32         {
33         erg += mpp_integer_hashtable_(a,b,c,f);
34         goto ende;
35         }
36 ende:
37     ENDR("mpp_integer__");
38 }
39 
mpp_partition_partition_(a,b,c,f)40 INT mpp_partition_partition_(a,b,c,f) OP a,b,c; OP f;
41 {
42     INT erg = OK;
43     CTO(PARTITION,"mpp_partition_partition_(1)",a);
44     CTO(PARTITION,"mpp_partition_partition_(2)",b);
45     CTTO(HASHTABLE,POWSYM,"mpp_partition_partition_(3)",c);
46     erg += m_merge_partition_partition(a,b,c,f,comp_monompowsym,eq_monomsymfunc);
47     ENDR("mpp_partition_partition_");
48 }
49 
m_merge_partition_partition(a,b,c,f,lf,hf)50 INT m_merge_partition_partition(a,b,c,f,lf,hf) OP a,b,c; OP f;
51      INT (*lf)();
52      INT (*hf)();
53 /* multiplication of two partitions bei merging */
54 {
55     INT erg = OK;
56     INT i,j,k;
57     static INT ms=0;
58     OP ap,bp,mp;
59     CTO(PARTITION,"m_merge_partition_partition(1)",a);
60     CTO(PARTITION,"m_merge_partition_partition(2)",b);
61     CTTTTO(HASHTABLE,POWSYM,HOMSYM,ELMSYM,"m_merge_partition_partition(3)",c);
62 
63 
64     if (mpp_pp_m == NULL) {
65         mpp_pp_m = CALLOCOBJECT();
66         erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),mpp_pp_m);
67         erg += b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(mpp_pp_m));
68         erg += m_il_nv(50,S_PA_S(S_MO_S(mpp_pp_m)));
69         C_O_K(S_PA_S(S_MO_S(mpp_pp_m)), INTEGERVECTOR);
70         ms = 50;
71         }
72     if (S_PA_LI(b)+S_PA_LI(a) > ms) {
73         INT inkr;
74         inkr=S_PA_LI(b)+S_PA_LI(a)-ms+10;
75         M_I_I(ms,S_PA_L(S_MO_S(mpp_pp_m)));
76         erg += inc_vector_co(S_PA_S(S_MO_S(mpp_pp_m)), inkr);
77         ms = S_PA_LI(S_MO_S(mpp_pp_m));
78         for (i=ms-1; inkr > 0; inkr--)
79             M_I_I(0,S_PA_I(S_MO_S(mpp_pp_m),i));
80         }
81 
82     C_I_I(S_PA_L(S_MO_S(mpp_pp_m)), S_PA_LI(b)+S_PA_LI(a) );
83 
84 
85     for (
86         ap = S_V_S(S_PA_S(a)),
87         bp = S_V_S(S_PA_S(b)),
88         mp = S_V_S(S_PA_S(S_MO_S(mpp_pp_m))),
89         i=S_PA_LI(a),
90         j=S_PA_LI(b),
91         k=S_PA_LI(S_MO_S(mpp_pp_m));
92 
93         k>0;
94 
95         k--,mp++
96         )
97         {
98 
99         if (j == 0)
100             {
101             C_I_I(mp, S_I_I(ap) );
102             i--; ap++;
103             }
104         else if (i == 0)
105             {
106             C_I_I(mp, S_I_I(bp) );
107             j--; bp++;
108             }
109         else if (S_I_I(bp) < S_I_I(ap) )
110             {
111             C_I_I(mp, S_I_I(bp) );
112             j--; bp++;
113             }
114         else
115             {
116             C_I_I(mp, S_I_I(ap) );
117             i--; ap++;
118             }
119         }
120 
121 
122     CLEVER_COPY(f,S_MO_K(mpp_pp_m));
123     if (S_O_K(c) == HASHTABLE)
124         {
125         HASH_INTEGERVECTOR(S_PA_S(S_MO_S(mpp_pp_m)),j);
126         C_PA_HASH(S_MO_S(mpp_pp_m),j);
127         erg += add_apply_hashtable(mpp_pp_m,c,add_koeff,hf,hash_monompartition);
128         }
129     else /* LIST */
130         {
131         OP mm;
132         mm = CALLOCOBJECT();
133         COPY(mpp_pp_m,mm);
134         INSERT_LIST(mm,c,add_koeff,lf);
135         }
136 
137     C_I_I(S_PA_L(S_MO_S(mpp_pp_m)), ms);
138     ENDR("m_merge_partition_partition");
139 }
140 
mpp_partition__(a,b,c,f)141 INT mpp_partition__(a,b,c,f) OP a,b,c; OP f;
142 /* AK 311001 */
143 {
144     INT erg = OK;
145     CTO(PARTITION,"mpp_partition__(1)",a);
146     CTTTO(HASHTABLE,PARTITION,POWSYM,"mpp_partition__(2)",b);
147     CTTO(HASHTABLE,POWSYM,"mpp_partition__(3)",c);
148 
149     if (S_O_K(b) == PARTITION)
150         {
151         erg += mpp_partition_partition_(a,b,c,f);
152         goto ende;
153         }
154     else {
155         M_FORALL_MONOMIALS_IN_B(a,b,c,f,mpp_partition_partition_);
156         goto ende;
157         }
158 ende:
159     ENDR("mpp_partition__");
160 }
161 
mpp_powsym__(a,b,c,f)162 INT mpp_powsym__(a,b,c,f) OP a,b,c,f;
163 /* AK 061101 */
164 /* c += h_a \times s_b  \times f */
165 {
166     INT erg = OK;
167     CTO(POWSYM,"mpp_powsym__(1)",a);
168     CTTTO(HASHTABLE,PARTITION,POWSYM,"mpp_powsym__(2)",b);
169     CTTO(HASHTABLE,POWSYM,"mpp_powsym__(3)",c);
170     if (S_O_K(b) == PARTITION)
171         {
172         M_FORALL_MONOMIALS_IN_A(a,b,c,f,mpp_partition_partition_);
173         goto ende;
174         }
175     else {
176         M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mpp_partition_partition_);
177         goto ende;
178         }
179 ende:
180     ENDR("mpp_powsym__");
181 }
182 
mpp_hashtable__(a,b,c,f)183 INT mpp_hashtable__(a,b,c,f) OP a,b,c,f;
184 /* AK 061101 */
185 /* c += h_a \times s_b  \times f */
186 {
187     INT erg = OK;
188     CTO(HASHTABLE,"mpp_hashtable__(1)",a);
189     CTTTO(HASHTABLE,PARTITION,POWSYM,"mpp_hashtable__(2)",b);
190     CTTO(HASHTABLE,POWSYM,"mpp_hashtable__(3)",c);
191     if (S_O_K(b) == PARTITION)
192         {
193         M_FORALL_MONOMIALS_IN_A(a,b,c,f,mpp_partition_partition_);
194         goto ende;
195         }
196     else {
197         M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mpp_partition_partition_);
198         goto ende;
199         }
200 ende:
201     ENDR("mpp_hashtable__");
202 }
203 
mpp_hashtable_hashtable_(a,b,c,f)204 INT mpp_hashtable_hashtable_(a,b,c,f) OP a,b,c,f;
205 /* AK 051201 */
206 /* c += p_a \times p_b  \times f */
207 {
208     INT erg = OK;
209     CTO(HASHTABLE,"mpp_hashtable_hashtable_(1)",a);
210     CTO(HASHTABLE,"mpp_hashtable_hashtable_(2)",b);
211     CTTO(HASHTABLE,POWSYM,"mpp_hashtable_hashtable_(3)",c);
212     M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mpp_partition_partition_);
213     ENDR("mpp_hashtable_hashtable_");
214 }
215 
216 
mpp_integer_partition_(a,b,c,f)217 INT mpp_integer_partition_(a,b,c,f) OP a,b,c,f;
218 /* AK 061101 */
219 {
220     INT erg = OK;
221     OP m;
222     INT i,k;
223 
224     CTO(INTEGER,"mpp_integer_partition_(1)",a);
225     CTO(PARTITION,"mpp_integer_partition_(2)",b);
226     CTTO(POWSYM,HASHTABLE,"mpp_integer_partition_(3)",c);
227 
228 
229     m = CALLOCOBJECT();
230     erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
231     erg += b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(m));
232     erg += m_il_v(S_PA_LI(b)+1,S_PA_S(S_MO_S(m)));
233     C_O_K(S_PA_S(S_MO_S(m)),INTEGERVECTOR);
234 
235     for (i=0,k=0; k<S_PA_LI(S_MO_S(m)); k++,i++)
236         if (k == S_PA_LI(b))
237             M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
238         else if (S_PA_II(b,i) < S_I_I(a))
239             M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
240         else
241             {
242             M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
243             break;
244             }
245 
246     for (k++;k<S_PA_LI(S_MO_S(m)); k++,i++)
247         M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
248 
249     COPY(f, S_MO_K(m));
250     if (S_O_K(c) == POWSYM)
251         INSERT_LIST(m,c,add_koeff,comp_monompowsym);
252     else
253         INSERT_HASHTABLE(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
254 
255     ENDR("mpp_integer_partition_");
256 }
257 
mpp_integer_hashtable_(a,b,c,f)258 INT mpp_integer_hashtable_(a,b,c,f) OP a,b,c,f;
259 /* AK 061101 */
260 {
261     INT erg = OK;
262     CTO(INTEGER,"mpp_integer_hashtable_(1)",a);
263     CTTO(HASHTABLE,POWSYM,"mpp_integer_hashtable_(2)",b);
264     CTTO(POWSYM,HASHTABLE,"integer_hashtable_(3)",c);
265     M_FORALL_MONOMIALS_IN_B(a,b,c,f,mpp_integer_partition_);
266     ENDR("mpp_integer_hashtable_");
267 }
268 
269 
270 
mult_powsym_powsym(a,b,c)271 INT mult_powsym_powsym(a,b,c) OP a,b,c;
272 /* AK 111001
273 */
274 {
275     INT erg = OK;
276     INT t=0; /* is 1 if transfer HASHTABLE->POWSYM necessary */
277     CTTTTO(HASHTABLE,INTEGER,PARTITION,POWSYM,"mult_powsym_powsym(1)",a);
278     CTTTO(HASHTABLE,PARTITION,POWSYM,"mult_powsym_powsym(2)",b);
279     CTTTO(EMPTY,HASHTABLE,POWSYM,"mult_powsym_powsym(3)",c);
280 
281     if (S_O_K(a) == INTEGER)
282         {
283         if (S_O_K(c) == EMPTY) {
284            if (S_O_K(b) == PARTITION) init_powsym(c);
285            else { t=1; init_hashtable(c); }
286            }
287         erg += mpp_integer__(a,b,c,cons_eins);
288         }
289     else if (S_O_K(a) == PARTITION)
290         {
291         if (S_O_K(c) == EMPTY)
292             { t=1; init_hashtable(c); }
293         erg += mpp_partition__(a,b,c,cons_eins);
294         }
295     else if (S_O_K(a) == POWSYM)
296         {
297         if (S_O_K(c) == EMPTY)
298             { t=1; init_hashtable(c); }
299         erg += mpp_powsym__(a,b,c,cons_eins);
300         }
301     else /* if (S_O_K(a) == HASHTABLE) */
302         {
303         if (S_O_K(c) == EMPTY)
304             { t=1; init_hashtable(c); }
305         erg += mpp_hashtable__(a,b,c,cons_eins);
306         }
307 
308     if (t==1) t_HASHTABLE_POWSYM(c,c);
309     ENDR("mult_powsym_powsym");
310 }
311 
mpp___(a,b,c,f)312 INT mpp___(a,b,c,f) OP a,b,c,f;
313 {
314     INT erg = OK;
315     CTTTTO(HASHTABLE,INTEGER,PARTITION,POWSYM,"mpp___(1)",a);
316     CTTTO(HASHTABLE,PARTITION,POWSYM,"mpp___(2)",b);
317     CTTO(HASHTABLE,POWSYM,"mpp___(3)",c);
318     if (S_O_K(a) == INTEGER)
319         {
320          erg += mpp_integer__(a,b,c,f);
321         }
322     else if (S_O_K(a) == PARTITION)
323         {
324         erg += mpp_partition__(a,b,c,f);
325         }
326     else if (S_O_K(a) == POWSYM)
327         {
328          erg += mpp_powsym__(a,b,c,f);
329         }
330     else /* if (S_O_K(a) == HASHTABLE) */
331         {
332          erg += mpp_hashtable__(a,b,c,f);
333         }
334 
335     ENDR("mpp___");
336 }
337 
338