1 /* SYMMETRICA file mhs.c */
2 /* multiplication of homsym with schur */
3 /* result will be schur */
4 #include "def.h"
5 #include "macro.h"
6
mhs_integer__(a,b,c,f)7 INT mhs_integer__(a,b,c,f) OP a,b,c; OP f;
8 /* AK 311001 */
9 {
10 INT erg = OK;
11 CTO(INTEGER,"mhs_integer__(1)",a);
12 CTTTO(HASHTABLE,PARTITION,SCHUR,"mhs_integer__(2)",b);
13 CTTO(HASHTABLE,SCHUR,"mhs_integer__(3)",c);
14
15 if (S_O_K(b) == PARTITION) {
16 erg += mhs_integer_partition_(a,b,c,f);
17 goto ende;
18 }
19 else {
20 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mhs_integer_partition_);
21 goto ende;
22 }
23 ende:
24 ENDR("mhs_integer__");
25 }
26
mhs_partition__(a,b,c,f)27 INT mhs_partition__(a,b,c,f) OP a,b,c; OP f;
28 /* AK 311001 */
29 {
30 INT erg = OK;
31 CTO(PARTITION,"mhs_partition__(1)",a);
32 CTTTO(HASHTABLE,PARTITION,SCHUR,"mhs_partition__(2)",b);
33 CTTO(HASHTABLE,SCHUR,"mhs_partition__(3)",c);
34
35 if (S_PA_LI(a) == 0) {
36 if (S_O_K(b) == PARTITION) {
37 OP d;
38 d = CALLOCOBJECT();
39 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
40 erg += copy_partition(b,S_MO_S(d));
41 COPY(f,S_MO_K(d));
42 if (S_O_K(c) == SCHUR)
43 INSERT_LIST(d,c,add_koeff,comp_monomschur);
44 else
45 INSERT_HASHTABLE(d,c,add_koeff,eq_monomsymfunc,hash_monompartition);
46 }
47 else /* schur or hashtable */
48 {
49 OP z;
50 FORALL(z,b,{
51 OP d;
52 d = CALLOCOBJECT();
53 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
54 erg += copy_partition(S_MO_S(z),S_MO_S(d));
55 COPY(S_MO_K(z),S_MO_K(d));
56 if (not EINSP(f))
57 {
58 MULT_APPLY(f,S_MO_K(d));
59 }
60 if (S_O_K(c) == SCHUR)
61 INSERT_LIST(d,c,add_koeff,comp_monomschur);
62 else
63 INSERT_HASHTABLE(d,c,add_koeff,eq_monomsymfunc,hash_monompartition);
64 });
65 }
66 goto endr_ende;
67 }
68 else { /* partition of length >= 1 */
69 INT i; OP d,e;
70
71 d=CALLOCOBJECT();
72 e=CALLOCOBJECT();
73
74 erg += init_hashtable(e);
75 erg += mhs_integer__(S_PA_I(a,0),b,e,f);
76 for (i=1;i<S_PA_LI(a);i++)
77 {
78 FREESELF(d);
79 erg += init_hashtable(d);
80 SWAP(d,e);
81 erg += mhs_integer__(S_PA_I(a,i),d,e,cons_eins);
82 }
83 FREEALL(d);
84 if (S_O_K(c) == SCHUR)
85 INSERT_LIST(e,c,add_koeff,comp_monomschur);
86 else
87 INSERT_HASHTABLE(e,c,add_koeff,eq_monomsymfunc,hash_monompartition);
88 }
89
90
91 ENDR("mhs_partition__");
92 }
93
mhs_homsym__(a,b,c,f)94 INT mhs_homsym__(a,b,c,f) OP a,b,c,f;
95 /* AK 061101 */
96 /* c += h_a \times s_b \times f */
97 {
98 INT erg = OK;
99 CTO(HOMSYM,"mhs_homsym__(1)",a);
100 CTTTO(HASHTABLE,PARTITION,SCHUR,"mhs_homsym__(2)",b);
101 CTTO(HASHTABLE,SCHUR,"mhs_homsym__(3)",c);
102 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mhs_partition__);
103 ENDR("mhs_homsym__");
104 }
105
mhs_hashtable__(a,b,c,f)106 INT mhs_hashtable__(a,b,c,f) OP a,b,c,f;
107 /* AK 061101 */
108 /* c += h_a \times s_b \times f */
109 {
110 INT erg = OK;
111 CTO(HASHTABLE,"mhs_hashtable__(1)",a);
112 CTTTO(HASHTABLE,PARTITION,SCHUR,"mhs_hashtable__(2)",b);
113 CTTO(HASHTABLE,SCHUR,"mhs_hashtable__(3)",c);
114 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mhs_partition__);
115 ENDR("mhs_hashtable__");
116 }
117
118
mult_homsym_schur(a,b,c)119 INT mult_homsym_schur(a,b,c) OP a,b,c;
120 /* AK 111001
121 with pieri rule
122 */
123 /* is the result=c empty the result will be a SCHUR object
124 is the result a HASHTABLE or SCHUR object will be the result inserted
125 */
126 {
127 INT erg = OK;
128 INT t=0; /* is 1 if transfer HASHTABLE->SCHUR necessary */
129 CTTTTO(HASHTABLE,INTEGER,PARTITION,HOMSYM,"mult_homsym_schur(1)",a);
130 CTTTO(HASHTABLE,PARTITION,SCHUR,"mult_homsym_schur(2)",b);
131 CTTTO(EMPTY,HASHTABLE,SCHUR,"mult_homsym_schur(3)",c);
132
133 if (S_O_K(a) == INTEGER)
134 {
135 if (S_O_K(c) == EMPTY) {
136 if (S_O_K(b) == PARTITION) init_schur(c);
137 else { t=1; init_hashtable(c); }
138 }
139 erg += mhs_integer__(a,b,c,cons_eins);
140 }
141 else if (S_O_K(a) == PARTITION)
142 {
143 if (S_O_K(c) == EMPTY)
144 { t=1; init_hashtable(c); }
145 erg += mhs_partition__(a,b,c,cons_eins);
146 }
147 else if (S_O_K(a) == HOMSYM)
148 {
149 if (S_O_K(c) == EMPTY)
150 { t=1; init_hashtable(c); }
151 erg += mhs_homsym__(a,b,c,cons_eins);
152 }
153 else /* if (S_O_K(a) == HASHTABLE) */
154 {
155 if (S_O_K(c) == EMPTY)
156 { t=1; init_hashtable(c); }
157 erg += mhs_hashtable__(a,b,c,cons_eins);
158 }
159
160 if (t==1) t_HASHTABLE_SCHUR(c,c);
161 ENDR("mult_homsym_schur");
162 }
163
164
165
mhs_first_pieri(a,b,c)166 static INT mhs_first_pieri(a,b,c) OP a,b,c;
167 {
168 m_il_nv(S_V_LI(b),c);
169 m_i_i(S_I_I(a),S_V_I(c,0));
170 C_O_K(c,INTEGERVECTOR);
171 return OK;
172 }
173
mhs_next_pieri_limit_apply(limit,v)174 static INT mhs_next_pieri_limit_apply(limit,v) OP limit,v;
175 {
176 INT i,w=0,g=0;
177 INT erg = OK;
178 CTTO(INTEGERVECTOR,VECTOR,"mhs_next_pieri_limit_apply(1)",limit);
179 CTTO(INTEGERVECTOR,VECTOR,"mhs_next_pieri_limit_apply(2)",v);
180
181 for (i=S_V_LI(v)-1; i>=0;i--)
182 {
183 if (S_V_II(v,i) > 0)
184 if (w > 0) break;
185 else
186 g+=S_V_II(v,i);
187 if (S_V_II(limit,i) > 0)
188 w+=S_V_II(limit,i)-S_V_II(v,i);
189
190 M_I_I(0,S_V_I(v,i));
191 }
192 /* an der stelle i kann nach rechts geschoben werden */
193 if (i== -1) return FALSE;
194
195 g++;
196 M_I_I(S_V_II(v,i)-1, S_V_I(v,i));
197 for (i++; ;i++)
198 {
199 if (S_V_II(limit,i) >= g)
200 {
201 M_I_I(g,S_V_I(v,i));
202 return TRUE;
203 }
204 else {
205 M_I_I(S_V_II(limit,i),S_V_I(v,i));
206 g = g - S_V_II(limit,i);
207 }
208 }
209 /* we should never end up here */
210 ENDR("mhs_next_pieri_limit_apply");
211 }
212
mhs_integer_partition_(a,b,c,f)213 INT mhs_integer_partition_(a,b,c,f) OP a,b,c,f;
214 /* c += h_a \times s_b \times f*/
215 /* c is already initialised */
216 {
217 INT erg = OK;
218 /* pieri rule */
219 OP limit;
220 OP v;
221 INT i,j;
222 OP ps,s,pa;
223
224 CTO(INTEGER,"mhs_integer_partition_(1)",a);
225 CTO(PARTITION,"mhs_integer_partition_(2)",b);
226 CTTO(SCHUR,HASHTABLE,"mhs_integer_partition_(3)",c);
227
228 /*printf("mhs_integer_partition_:a=");println(a);
229 printf("mhs_integer_partition_:b=");println(b);
230 printf("mhs_integer_partition_:c=");println(c);
231 printf("mhs_integer_partition_:f=");println(f);*/
232
233
234 if (S_PA_LI(b) == 0) {
235 OP s;
236 s = CALLOCOBJECT();
237 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),s);
238 COPY(f,S_MO_K(s));
239 m_i_pa(a,S_MO_S(s));
240
241 if (S_O_K(c) == SCHUR)
242 insert_list(s,c,add_koeff,comp_monomschur);
243 else
244 insert_scalar_hashtable(s,c,add_koeff,eq_monomsymfunc,hash_monompartition);
245
246 goto ende;
247 }
248
249 limit = CALLOCOBJECT();
250 v = CALLOCOBJECT();
251 m_il_v(S_PA_LI(b)+1,limit);
252 C_O_K(limit,INTEGERVECTOR);
253 M_I_I(S_I_I(a),S_V_I(limit,0));
254 for (j=1,i=S_PA_LI(b)-1;i>0;i--,j++)
255 M_I_I(S_PA_II(b,i)-S_PA_II(b,i-1),S_V_I(limit,j));
256 M_I_I(S_PA_II(b,0),S_V_I(limit,j));
257
258
259
260
261 ps = CALLOCOBJECT();
262 pa = CALLOCOBJECT();
263 s = CALLOCOBJECT();
264
265 erg += b_ks_pa(VECTOR,ps,pa);
266 erg += m_il_nv(S_V_LI(limit),ps);
267 C_O_K(ps,INTEGERVECTOR);
268 erg += b_sk_mo(pa,CALLOCOBJECT(),s);
269 COPY(f,S_MO_K(s));
270
271 mhs_first_pieri(a,limit,v);
272 do {
273
274
275 if (S_V_II(v,S_V_LI(v)-1) > 0)
276 {
277 M_I_I(S_V_LI(v),S_V_L(ps));
278 M_I_I(S_V_II(v,S_V_LI(v)-1), S_V_I(ps,0));
279 }
280 else
281 M_I_I(S_V_LI(v)-1,S_V_L(ps));
282
283 for (i=S_PA_LI(b)-1,j=0;i>=0;i--,j++)
284 M_I_I(S_PA_II(b,i)+S_V_II(v,j), S_V_I(ps,S_V_LI(ps)-1-j));
285
286
287
288 if (S_O_K(c) == SCHUR)
289 {
290 OP ss = CALLOCOBJECT();
291 copy_monom(s,ss);
292 insert_list(ss,c,add_koeff,comp_monomschur);
293 }
294 else
295 {
296 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(s)),j);
297 C_PA_HASH(S_MO_S(s),j);
298 erg += add_apply_hashtable(s,c,add_koeff,eq_monomsymfunc,hash_monompartition);
299 }
300
301 } while (mhs_next_pieri_limit_apply(limit,v) == TRUE);
302
303 FREEALL(s);
304 FREEALL(limit);
305 FREEALL(v);
306 ende:
307 ENDR("mhs_integer_partition_");
308 }
309
310