1 #include "def.h"
2 #include "macro.h"
3
4 INT mes_integer_partition_();
5
6 static OP mes_ip_limit = NULL;
7 static INT mes_ip_limit_length = 5;
8 static OP mes_ip_s = NULL;
9 static INT mes_ip_s_length = 5;
10 static OP mes_ip_v = NULL;
11 static INT mes_ip_v_length = 5;
mes_ende()12 INT mes_ende()
13 {
14 INT erg = OK;
15 if (mes_ip_limit != NULL) {
16 FREEALL(mes_ip_limit);
17 mes_ip_limit = NULL;
18 mes_ip_limit_length = 5;
19 }
20 if (mes_ip_s != NULL) {
21 FREEALL(mes_ip_s);
22 mes_ip_s = NULL;
23 mes_ip_s_length = 5;
24 }
25 if (mes_ip_v != NULL) {
26 FREEALL(mes_ip_v);
27 mes_ip_v = NULL;
28 mes_ip_v_length = 5;
29 }
30
31 return OK;
32 ENDR("mes_ende");
33 }
34
mes_integer_hashtable_(a,b,c,f)35 INT mes_integer_hashtable_(a,b,c,f) OP a,b,c; OP f;
36 {
37 INT erg = OK;
38 CTO(INTEGER,"mes_integer_hashtable_(1)",a);
39 CTTO(HASHTABLE,SCHUR,"mes_integer_hashtable_(2)",b);
40 CTTO(HASHTABLE,SCHUR,"mes_integer_hashtable_(3)",c);
41 SYMCHECK((S_I_I(a) < 0), "mes_integer_hashtable_:parameter <0");
42
43 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mes_integer_partition_);
44
45 ENDR("mes_integer_hashtable_");
46 }
47
mes_integer__(a,b,c,f)48 INT mes_integer__(a,b,c,f) OP a,b,c; OP f;
49 /* AK 311001 */
50 {
51 INT erg = OK;
52
53 CTO(INTEGER,"mes_integer__(1)",a);
54 CTTTO(HASHTABLE,PARTITION,SCHUR,"mes_integer__(2)",b);
55 CTTO(HASHTABLE,SCHUR,"mes_integer__(3)",c);
56 SYMCHECK((S_I_I(a) < 0), "mes_integer__:parameter <0");
57
58 if (S_O_K(b) == PARTITION) {
59 erg += mes_integer_partition_(a,b,c,f);
60 goto ende;
61 }
62 else {
63 erg += mes_integer_hashtable_(a,b,c,f);
64 goto ende;
65 }
66 ende:
67 ENDR("mes_integer__");
68 }
69
mes_partition__(a,b,c,f)70 INT mes_partition__(a,b,c,f) OP a,b,c; OP f;
71 /* AK 311001 */
72 {
73 INT erg = OK;
74 CTO(PARTITION,"mes_partition__(1)",a);
75 CTTTO(HASHTABLE,PARTITION,SCHUR,"mes_partition__(2)",b);
76 CTTO(HASHTABLE,SCHUR,"mes_partition__(3)",c);
77
78 if (S_PA_LI(a) == 0) {
79 if (S_O_K(b) == PARTITION) {
80 OP d;
81 d = CALLOCOBJECT();
82 erg += m_sk_mo(b,f,d);
83 INSERT_SCHURMONOM_(d,c);
84 }
85 else /* schur or hashtable */
86 {
87 OP z;
88 FORALL(z,b,{
89 OP d;
90 d = CALLOCOBJECT();
91 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
92 erg += copy_partition(S_MO_S(z),S_MO_S(d));
93 if (not EINSP(f))
94 MULT(f,S_MO_K(z),S_MO_K(d));
95 else
96 COPY(S_MO_K(z),S_MO_K(d));
97 INSERT_SCHURMONOM_(d,c);
98 });
99 }
100 goto endr_ende;
101 }
102 else { /* partition of length >= 1 */
103 INT i; OP d,e;
104
105 d=CALLOCOBJECT();
106 e=CALLOCOBJECT();
107
108 erg += init_hashtable(e);
109 erg += mes_integer__(S_PA_I(a,0),b,e,f);
110 for (i=1;i<S_PA_LI(a);i++)
111 {
112 FREESELF(d);
113 erg += init_hashtable(d);
114 SWAP(d,e);
115 erg += mes_integer__(S_PA_I(a,i),d,e,cons_eins);
116 }
117 FREEALL(d);
118 if (S_O_K(c) == SCHUR)
119 INSERT_LIST(e,c,add_koeff,comp_monomschur);
120 else
121 INSERT_HASHTABLE(e,c,add_koeff,eq_monomsymfunc,hash_monompartition);
122 }
123
124
125 ENDR("mes_partition__");
126 }
127
mes_elmsym__(a,b,c,f)128 INT mes_elmsym__(a,b,c,f) OP a,b,c,f;
129 /* AK 061101 */
130 /* c += h_a \times s_b \times f */
131 {
132 INT erg = OK;
133 CTO(ELMSYM,"mes_elmsym__(1)",a);
134 CTTTO(HASHTABLE,PARTITION,SCHUR,"mes_elmsym__(2)",b);
135 CTTO(HASHTABLE,SCHUR,"mes_elmsym__(3)",c);
136 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mes_partition__);
137 ENDR("mes_elmsym__");
138 }
139
mes_hashtable__(a,b,c,f)140 INT mes_hashtable__(a,b,c,f) OP a,b,c,f;
141 /* AK 061101 */
142 /* c += h_a \times s_b \times f */
143 {
144 INT erg = OK;
145 CTO(HASHTABLE,"mes_hashtable__(1)",a);
146 CTTTO(HASHTABLE,PARTITION,SCHUR,"mes_hashtable__(2)",b);
147 CTTO(HASHTABLE,SCHUR,"mes_hashtable__(3)",c);
148 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mes_partition__);
149 ENDR("mes_elmsym__");
150 }
151
152
mult_elmsym_schur(a,b,c)153 INT mult_elmsym_schur(a,b,c) OP a,b,c;
154 /* AK 111001
155 with pieri rule
156 */
157 /* is the result=c empty the result will be a SCHUR object
158 is the result a HASHTABLE or SCHUR object will be the result inserted
159 */
160 {
161 INT erg = OK;
162 INT t=0; /* is 1 if transfer HASHTABLE->SCHUR necessary */
163 CTTTTO(HASHTABLE,INTEGER,PARTITION,ELMSYM,"mult_elmsym_schur(1)",a);
164 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_elmsym_schur(2)",b);
165 CTTTO(EMPTY,HASHTABLE,SCHUR,"mult_elmsym_schur(3)",c);
166
167 if (S_O_K(a) == INTEGER)
168 {
169 if (S_O_K(c) == EMPTY) {
170 if (S_O_K(b) == PARTITION) init_schur(c);
171 else { t=1; init_hashtable(c); }
172 }
173 erg += mes_integer__(a,b,c,cons_eins);
174 }
175 else if (S_O_K(a) == PARTITION)
176 {
177 if (S_O_K(c) == EMPTY)
178 { t=1; init_hashtable(c); }
179 erg += mes_partition__(a,b,c,cons_eins);
180 }
181 else if (S_O_K(a) == ELMSYM)
182 {
183 if (S_O_K(c) == EMPTY)
184 { t=1; init_hashtable(c); }
185 erg += mes_elmsym__(a,b,c,cons_eins);
186 }
187 else /* if (S_O_K(a) == HASHTABLE) */
188 {
189 if (S_O_K(c) == EMPTY)
190 { t=1; init_hashtable(c); }
191 erg += mes_hashtable__(a,b,c,cons_eins);
192 }
193
194 if (t==1) t_HASHTABLE_SCHUR(c,c);
195 ENDR("mult_elmsym_schur");
196 }
197
198
199
mes_first_pieri(a,b,c)200 static INT mes_first_pieri(a,b,c) OP a,b,c;
201 {
202 INT i;
203 /*
204 m_il_nv(S_V_LI(b),c);
205 */
206 if (S_V_LI(b) > mes_ip_v_length) {
207 inc_vector_co(c,S_V_LI(b) - mes_ip_v_length);
208 mes_ip_v_length = S_V_LI(c);
209 }
210 M_I_I(S_V_LI(b),S_V_L(c));
211 for (i=1;i<S_V_LI(c);i++) M_I_I(0,S_V_I(c,i));
212 M_I_I(S_I_I(a),S_V_I(c,0));
213 return OK;
214 }
215
mes_next_pieri_limit_apply(limit,v)216 static INT mes_next_pieri_limit_apply(limit,v) OP limit,v;
217 {
218 INT i,w=0,g=0;
219
220 for (i=S_V_LI(v)-1; i>=0;i--)
221 {
222 if (S_V_II(v,i) > 0)
223 if (w > 0) break;
224 else
225 g+=S_V_II(v,i);
226 if (S_V_II(limit,i) > 0)
227 w+=S_V_II(limit,i)-S_V_II(v,i);
228
229 M_I_I(0,S_V_I(v,i));
230 }
231 /* an der stelle i kann nach rechts geschoben werden */
232 if (i== -1) return FALSE;
233
234 g++;
235 M_I_I(S_V_II(v,i)-1, S_V_I(v,i));
236 for (i++; ;i++)
237 {
238 if (S_V_II(limit,i) >= g)
239 {
240 M_I_I(g,S_V_I(v,i));
241 return TRUE;
242 }
243 else {
244 M_I_I(S_V_II(limit,i),S_V_I(v,i));
245 g = g - S_V_II(limit,i);
246 }
247 }
248 }
249
250
mes_integer_partition_(a,b,c,f)251 INT mes_integer_partition_(a,b,c,f) OP a,b,c,f;
252 /* c += e_a \times s_b \times f*/
253 /* c is already initialised */
254 {
255 INT erg = OK;
256 /* pieri rule */
257 OP limit;
258 OP v;
259 INT i,j,k;
260 OP ps,s;
261
262 CTO(INTEGER,"mes_integer_partition_(1)",a);
263 CTO(PARTITION,"mes_integer_partition_(2)",b);
264 CTTO(SCHUR,HASHTABLE,"mes_integer_partition_(3)",c);
265 SYMCHECK(S_I_I(a) < 0,"mes_integer_partition_:integer < 0");
266
267
268 if (S_PA_LI(b) == 0) {
269 OP s;
270 s = CALLOCOBJECT();
271 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),s);
272 COPY(f,S_MO_K(s));
273 erg += last_partition(a,S_MO_S(s));
274
275 INSERT_SCHURMONOM_(s,c);
276 goto ende;
277 }
278 if (S_I_I(a) == 0) {
279 OP s;
280 s = CALLOCOBJECT();
281 erg += m_sk_mo(b,f,s);
282 INSERT_SCHURMONOM_(s,c);
283 goto ende;
284 }
285
286 if (mes_ip_limit == NULL) {
287 mes_ip_limit=CALLOCOBJECT();
288 m_il_integervector(mes_ip_limit_length,mes_ip_limit);
289 limit = mes_ip_limit;
290 }
291 else {
292 M_I_I(mes_ip_limit_length,S_V_L(mes_ip_limit));
293 limit = mes_ip_limit;
294 }
295 if ((S_PA_II(b,S_PA_LI(b)-1)+1) > mes_ip_limit_length)
296 {
297 inc_vector_co(limit, (S_PA_II(b,S_PA_LI(b)-1)+1) - mes_ip_limit_length);
298 mes_ip_limit_length = S_V_LI(limit);
299 CTO(INTEGERVECTOR,"mes_integer_partition_(i1)",limit);
300 }
301 M_I_I((S_PA_II(b,S_PA_LI(b)-1)+1),S_V_L(mes_ip_limit));
302
303
304 M_I_I(S_I_I(a),S_V_I(limit,0));
305 for (i=1;i<S_V_LI(limit);i++)
306 M_I_I(0,S_V_I(limit,i));
307 for (i=0;i<S_PA_LI(b);i++)
308 INC_INTEGER(S_V_I(limit,S_PA_II(b,i)));
309
310
311 if (mes_ip_s == NULL) {
312 ps = CALLOCOBJECT();
313 erg += m_il_integervector(mes_ip_s_length,ps);
314 mes_ip_s = CALLOCOBJECT();
315 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),mes_ip_s);
316 erg += b_ks_pa(VECTOR,ps,S_MO_S(mes_ip_s));
317 s = mes_ip_s;
318 }
319 else {
320 M_I_I(mes_ip_s_length,S_PA_L(S_MO_S(mes_ip_s)));
321 s = mes_ip_s;
322 ps = S_PA_S(S_MO_S(s));
323 }
324
325 if (S_PA_LI(b)+S_I_I(a) > mes_ip_s_length)
326 {
327 inc_vector_co(S_PA_S(S_MO_S(s)), (S_PA_LI(b)+S_I_I(a)) - mes_ip_s_length);
328 mes_ip_s_length = S_PA_LI(S_MO_S(s));
329 }
330
331 M_I_I(S_PA_LI(b)+S_I_I(a),S_PA_L(S_MO_S(s)));
332 for (i=0;i<S_PA_LI(S_MO_S(s));i++) M_I_I(0,S_PA_I(S_MO_S(s),i));
333 FREESELF(S_MO_K(s));
334 COPY(f,S_MO_K(s));
335
336 /* v = CALLOCOBJECT(); */
337 if (mes_ip_v == NULL)
338 {
339 mes_ip_v = CALLOCOBJECT();
340 erg += m_il_integervector(mes_ip_v_length,mes_ip_v);
341 v = mes_ip_v;
342 }
343 else {
344 M_I_I(mes_ip_v_length,S_V_L(mes_ip_v));
345 v = mes_ip_v;
346 }
347
348 erg += mes_first_pieri(a,limit,v);
349 do {
350
351 for (i=0;i<S_V_II(v,0);i++)
352 M_I_I(1,S_V_I(ps,i));
353
354 for (j=0;j<S_PA_LI(b);j++,i++)
355 M_I_I(S_PA_II(b,j), S_V_I(ps,i));
356
357 M_I_I(S_PA_LI(b)+S_V_II(v,0), S_V_L(ps));
358
359 for (j=S_V_LI(ps)-1,i=S_V_LI(v)-1; i>0;i--)
360 if (S_V_II(v,i) > 0)
361 {
362 while(S_V_II(ps,j) > i) j--;
363 if (S_V_II(ps,j) != i) error("");
364 for (k=0;k<S_V_II(v,i);k++)
365 INC_INTEGER(S_V_I(ps,j-k));
366 j = j - S_V_II(v,i);
367 }
368
369
370
371 if (S_O_K(c) == SCHUR)
372 {
373 OP ss = CALLOCOBJECT();
374 erg += copy_monom(s,ss);
375 insert_list(ss,c,add_koeff,comp_monomschur);
376 }
377 else
378 {
379 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(s)),j);
380 C_PA_HASH(S_MO_S(s),j);
381 erg += add_apply_hashtable(s,c,add_koeff,eq_monomsymfunc,hash_monompartition);
382 }
383
384
385 } while (mes_next_pieri_limit_apply(limit,v) == TRUE);
386
387 ende:
388 ENDR("mes_integer_partition_");
389 }
390
391