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