1 #include "def.h"
2 #include "macro.h"
3
4 INT mps_integer_partition_();
5 INT mxx_null__();
6 INT mps_hashtable__();
7
8 static OP mps_ip_d = NULL;
9 static INT mps_ip_l = 50;
mps_ende()10 INT mps_ende()
11 {
12 INT erg = OK;
13 if (mps_ip_d != NULL)
14 {
15 CTO(MONOM,"mps_ende(i1)",mps_ip_d);
16 FREEALL(mps_ip_d);
17 mps_ip_d = NULL;
18 }
19 ENDR("mps_ende");
20 }
21
mult_power_schur(a,b,c)22 INT mult_power_schur(a,b,c) OP a,b,c;
23 /* for compability */
24 { return mult_powsym_schur(a,b,c); }
25
mps_null__(b,c,f)26 INT mps_null__(b,c,f) OP b,c,f;
27 /* c = c + p_0 * s_b * f */
28 {
29 INT erg = OK;
30
31 CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mps_null__(1)",b);
32 CTTO(SCHUR,HASHTABLE,"mps_null__(2)",c);
33 erg += mxx_null__(b,c,f);
34 ENDR("mps_null");
35 }
36
mps_integer__(a,b,c,f)37 INT mps_integer__(a,b,c,f) OP a,b,c,f;
38 {
39 INT erg = OK;
40 CTO(INTEGER,"mps_integer__(1)",a);
41 CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mps_integer__(2)",b);
42 CTTO(SCHUR,HASHTABLE,"mps_integer__(3)",c);
43 CTO(ANYTYPE,"mps_integer__(4)",f);
44 SYMCHECK((S_I_I(a) < 0),"mps_integer__:parameter<0");
45
46 if (S_I_I(a) == 0)
47 {
48 erg += mps_null__(b,c,f);
49 goto eee;
50 }
51 else if (S_O_K(b) == INTEGER) {
52 OP ff;
53 ff = CALLOCOBJECT();
54 erg += first_partition(b,ff);
55 erg += mps_integer_partition_(a,ff,c,f);
56 FREEALL(ff);
57 goto eee;
58 }
59 else if (S_O_K(b) == PARTITION) {
60 erg += mps_integer_partition_(a,b,c,f);
61 goto eee;
62 }
63 else /* SCHUR HASHTABLE */ {
64 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mps_integer_partition_);
65 goto eee;
66 }
67 eee:
68 CTTO(SCHUR,HASHTABLE,"mps_integer__(e3)",c);
69 ENDR("mps_integer__");
70 }
71
mps_partition__(a,b,c,f)72 INT mps_partition__(a,b,c,f) OP a,b,c; OP f;
73 {
74 INT erg = OK;
75 CTO(PARTITION,"mps_partition__(1)",a);
76 CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mps_partition__(2)",b);
77 CTTO(HASHTABLE,SCHUR,"mps_partition__(3)",c);
78 if (S_PA_LI(a) == 0)
79 {
80 erg += mps_integer__(cons_null,b,c,f);
81 }
82 else if (S_PA_LI(a) == 1)
83 {
84 erg += mps_integer__(S_PA_I(a,0),b,c,f);
85 }
86 else {
87
88 INT i; OP d,e;
89
90 d=CALLOCOBJECT();
91 e=CALLOCOBJECT();
92
93 erg += init_hashtable(e);
94 erg += mps_integer__(S_PA_I(a,0),b,e,f);
95 for (i=1;i<S_PA_LI(a);i++)
96 {
97 FREESELF(d);
98 erg += init_hashtable(d);
99 SWAP(d,e);
100 erg += mps_integer__(S_PA_I(a,i),d,e,cons_eins);
101 }
102 FREEALL(d);
103 if (S_O_K(c) == SCHUR)
104 INSERT_LIST(e,c,add_koeff,comp_monomschur);
105 else
106 INSERT_HASHTABLE(e,c,add_koeff,eq_monomsymfunc,hash_monompartition);
107
108 }
109
110 ENDR("mps_partition__");
111 }
112
113
mps_powsym__(a,b,c,f)114 INT mps_powsym__(a,b,c,f) OP a,b,c,f;
115 {
116 INT erg = OK;
117 CTO(POWSYM,"mps_powsym__(1)",a);
118 CTTTTO(HASHTABLE,INTEGER,PARTITION,SCHUR,"mps_powsym__(2)",b);
119 CTTO(HASHTABLE,SCHUR,"mps_powsym__(3)",c);
120
121 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mps_partition__);
122
123 ENDR("mps_powsym__");
124 }
125
mps_hashtable__pre100102(a,b,c,f)126 INT mps_hashtable__pre100102(a,b,c,f) OP a,b,c,f;
127 {
128 INT erg = OK;
129 CTO(HASHTABLE,"mps_hashtable__(1)",a);
130 CTTTTO(HASHTABLE,INTEGER,PARTITION,SCHUR,"mps_hashtable__(2)",b);
131 CTTO(HASHTABLE,SCHUR,"mps_hashtable__(3)",c);
132
133 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mps_partition__);
134
135 ENDR("mps_hashtable__");
136 }
137
mps___(a,b,c,f)138 INT mps___(a,b,c,f) OP a,b,c,f;
139 {
140 INT erg = OK;
141 CTTTTO(HASHTABLE,INTEGER,PARTITION,POWSYM,"mps___(1)",a);
142 CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mps___(2)",b);
143 CTTO(SCHUR,HASHTABLE,"mps___(3)",c);
144
145 if (S_O_K(a) == INTEGER)
146 {
147 erg += mps_integer__(a,b,c,f);
148 }
149 else if (S_O_K(a) == PARTITION)
150 {
151 erg += mps_partition__(a,b,c,f);
152 }
153 else if (S_O_K(a) == POWSYM)
154 {
155 erg += mps_powsym__(a,b,c,f);
156 }
157 else /* if (S_O_K(a) == HASHTABLE) */
158 {
159 erg += mps_hashtable__(a,b,c,f);
160 }
161 ENDR("mps___");
162 }
163
164
165
166
mult_powsym_schur(a,b,c)167 INT mult_powsym_schur(a,b,c) OP a,b,c;
168 /* a is INTEGER, PARTITION b is SCHUR c becomes SCHUR */
169 /* AK 200891 V1.3 */
170 {
171 INT erg = OK;
172 INT t=0;
173 CTTTTO(HASHTABLE,INTEGER,PARTITION,POWSYM,"mult_powsym_schur(1)",a);
174 CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mult_powsym_schur(2)",b);
175 CTTTO(SCHUR,HASHTABLE,EMPTY,"mult_powsym_schur(3)",c);
176
177 if (S_O_K(a) == INTEGER)
178 {
179 if (S_O_K(c) == EMPTY) {
180 if (S_O_K(b) == PARTITION) init_schur(c);
181 else if (S_O_K(b) == INTEGER) init_schur(c);
182 else { t=1; init_hashtable(c); }
183 }
184 }
185 else if (S_O_K(c) == EMPTY)
186 { t=1; init_hashtable(c); }
187
188 mps___(a,b,c,cons_eins);
189
190 if (t==1) t_HASHTABLE_SCHUR(c,c);
191
192
193 CTTTO(SCHUR,HASHTABLE,EMPTY,"mult_powsym_schur(e3)",c);
194 ENDR("mult_powsym_schur");
195 }
196
197
mps_integer_partition_(a,b,c,f)198 INT mps_integer_partition_(a,b,c,f) OP a,b,c; OP f;
199 /* a is INTEGER b is PARTITION c is SCHUR or HASHTABLE */
200 /* AK 200891 V1.3 */
201 /* called from mms_integer_partition() */
202 {
203 OP d;
204 INT i,j;
205 INT erg=OK;
206
207 EOP("mps_integer_partition_(4)",f);
208
209 CTO(INTEGER,"mps_integer_partition_(1)",a);
210 CTO(PARTITION,"mps_integer_partition_(2)",b);
211 CTTO(HASHTABLE,SCHUR,"mps_integer_partition_(3)",c);
212 CTO(ANYTYPE,"mps_integer_partition_(4)",f);
213 SYMCHECK(S_I_I(a) < 0, "mps_integer_partition_:integer < 0");
214
215
216
217 if (mps_ip_d == NULL)
218 {
219 d = CALLOCOBJECT();
220 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
221 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(d));
222 erg += m_il_v(mps_ip_l,S_PA_S(S_MO_S(d)));
223 C_O_K(S_PA_S(S_MO_S(d)),INTEGERVECTOR);
224 mps_ip_d = d;
225 }
226
227 d = mps_ip_d;
228
229 if (S_I_I(a)+S_PA_LI(b) > mps_ip_l) {
230 M_I_I(mps_ip_l, S_PA_L(S_MO_S(d)));
231 inc_vector_co(S_PA_S(S_MO_S(d)), S_I_I(a)+S_PA_LI(b)-mps_ip_l);
232 mps_ip_l = S_I_I(a)+S_PA_LI(b);
233 }
234
235 C_I_I( S_PA_L(S_MO_S(d)) , S_I_I(a)+S_PA_LI(b));
236
237 for (i=(INT)0; i<S_I_I(a)+S_PA_LI(b); i++)
238 {
239 for (j=(INT)0;j<S_I_I(a);j++)
240 M_I_I((INT)0,S_PA_I(S_MO_S(d),j));
241 for (j=(INT)0;j<S_PA_LI(b);j++)
242 M_I_I(S_PA_II(b,j),S_PA_I(S_MO_S(d),j+S_I_I(a)));
243 /* now we have copied the partition with leading zeros */
244 M_I_I(S_I_I(a)+S_PA_II(S_MO_S(d),i),S_PA_I(S_MO_S(d),i));
245
246 j = reorder_vector_apply(S_PA_S(S_MO_S(d)));
247 if (j == 0) { continue; }
248 else {
249 if ((S_O_K(S_MO_K(d)) == BRUCH) && (S_O_K(f) == BRUCH) )
250 {
251 FREESELF(S_B_O(S_MO_K(d)));
252 FREESELF(S_B_U(S_MO_K(d)));
253 COPY(S_B_U(f),S_B_U(S_MO_K(d)));
254 if (j==1)
255 COPY(S_B_O(f),S_B_O(S_MO_K(d)));
256 else
257 ADDINVERS(S_B_O(f),S_B_O(S_MO_K(d)));
258 }
259 else {
260 FREESELF(S_MO_K(d));
261 if (j==1)
262 COPY(f,S_MO_K(d));
263 else
264 ADDINVERS(f,S_MO_K(d));
265 }
266
267 if (S_O_K(c) == SCHUR)
268 {
269 OP dd;
270 dd = CALLOCOBJECT();
271 copy_monom(d,dd);
272 INSERT_LIST(dd,c,add_koeff,comp_monomschur);
273 }
274 else
275 {
276 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(d)),j);
277 C_PA_HASH(S_MO_S(d),j);
278 add_apply_hashtable(d,c,add_koeff,eq_monomsymfunc,hash_monompartition);
279 }
280 }
281
282 C_I_I(S_PA_L(S_MO_S(d)), S_I_I(a)+S_PA_LI(b));
283 }
284
285
286 CTTO(HASHTABLE,SCHUR,"mps_integer_partition_(e3)",c);
287 ENDR("mps_integer_partition_");
288 }
289
290
mps_hashtable__(a,b,c,f)291 INT mps_hashtable__(a,b,c,f) OP a,b,c,f;
292 {
293 INT erg = OK;
294 INT w;
295 CTO(HASHTABLE,"mps_hashtable__(1)",a);
296 CTTTTO(HASHTABLE,INTEGER,PARTITION,SCHUR,"mps_hashtable__(2)",b);
297 CTTO(HASHTABLE,SCHUR,"mps_hashtable__(3)",c);
298
299 w = WEIGHT_HASHTABLE(a);
300 if (w == 0) goto ende;
301 if (w == 1) {
302 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mps_partition__);
303 goto ende;
304 }
305
306 {
307 OP z=NULL,zz=NULL;
308 OP v;
309 OP h1,h2,h3;
310 INT m;
311 INT h2s, h3s;
312 v = CALLOCOBJECT();
313 z = findmax_powsym(a,maxpart_comp_part);
314 if (S_PA_LI(S_MO_S(z)) == 0) {
315 SYMCHECK(w != 1, "mps_hashtable__(i2)");
316 FREESELF(v);
317 MULT(S_MO_K(z),f,v);
318 erg += mxx_null__(b,c,v);
319 FREEALL(v);
320 goto ende;
321 }
322
323 m = 100000;
324 FORALL(z,a,{if (S_PA_II(S_MO_S(z),0) < m) m = S_PA_II(S_MO_S(z),0); });
325 zz = CALLOCOBJECT(); M_I_I(m,zz);
326
327 CTO(INTEGER,"mps_hashtable__(i2)",zz);
328 NEW_HASHTABLE(h1);
329 mps_integer__(zz,b,h1,cons_eins);
330 CTO(HASHTABLE,"mps_hashtable__(h1)",h1);
331 NEW_HASHTABLE(h2);
332 NEW_HASHTABLE(h3);
333 /* h2 partitionen ohne zz */
334 /* h3 partitionen wo zz gestrichen */
335 h2s = h3s = 0;
336 FORALL(z,a,{
337 if (S_PA_II(S_MO_S(z),0) != m) {
338 OP h;
339 h = CALLOCOBJECT();
340 SWAP(z,h);
341 insert_scalar_hashtable(h,h2,add_koeff,eq_monomsymfunc,hash_monompartition);
342 h2s++;
343 DEC_INTEGER(S_V_I(a,S_V_LI(a)));
344 }
345 else {
346 OP h;
347 h = CALLOCOBJECT();
348 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),h);
349 COPY(S_MO_K(z),S_MO_K(h));
350 remove_part_integer(S_MO_S(z),zz,S_MO_S(h));
351 if (S_PA_LI(S_MO_S(h)) == 0) {
352 FREESELF(h);
353 MULT(S_MO_K(z),f,h);
354 erg += mxx_null__(h1,c,h);
355 FREEALL(h);
356 }
357 else {
358 C_PA_HASH(S_MO_S(h),-1);
359 insert_scalar_hashtable(h,h3,add_koeff,eq_monomsymfunc,hash_monompartition);
360 h3s++;
361 }
362 }
363 } );
364 CTO(HASHTABLE,"mps_hashtable__(i3)",h2);
365 CTO(HASHTABLE,"mps_hashtable__(i4)",h3);
366 if (h3s) mps_hashtable__(h3,h1,c,f);
367 if (h2s) mps_hashtable__(h2,b,c,f);
368
369 insert_hashtable_hashtable(h2,a,NULL,eq_monomsymfunc,hash_monompartition);
370
371
372
373 FREEALL(h1);
374 FREEALL(h3);
375 FREEALL(v);
376 FREEALL(zz);
377 }
378 ende:
379 CTTO(HASHTABLE,SCHUR,"mps_hashtable__(e3)",c);
380 ENDR("mps_hashtable__");
381 }
382
383