1 #include "def.h"
2 #include "macro.h"
3
tsh_integer__faktor(a,b,f)4 INT tsh_integer__faktor(a,b,f) OP a,b,f;
5 {
6 INT erg = OK;
7 OP m;
8 CTO(INTEGER,"tsh_integer__faktor(1)",a);
9 CTTO(HASHTABLE,HOMSYM,"tsh_integer__faktor(2)",b);
10 SYMCHECK((S_I_I(a) < 0),"tsh_integer__faktor:parameter < 0");
11
12 m = CALLOCOBJECT();
13 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
14 COPY(f,S_MO_K(m));
15 erg += first_partition(a,S_MO_S(m));
16 if (S_O_K(b) == HASHTABLE)
17 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
18 else
19 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
20 ENDR("tsh_integer__faktor");
21 }
22
t_schur_jacobi_trudi(a,b,f,intf,multf)23 INT t_schur_jacobi_trudi(a,b,f,intf,multf)
24 /* implementiert die jacobi trudi determinante
25 fuer basis wechsel schur -> ... */
26 OP a,b,f;
27 INT (*intf)(), (*multf)();
28 {
29 OP ff;
30 INT i,j;
31 OP p,h2; OP h1;
32 INT erg = OK;
33 CTO(PARTITION,"t_schur_jacobi_trudi(1)",a);
34 CTTTTTO(HASHTABLE,HOMSYM,MONOMIAL,ELMSYM,POWSYM,"t_schur_jacobi_trudi(2)",b);
35
36 if (S_PA_LI(a) == 0) { (*intf)(cons_null,b,f); goto eee; }
37 if (S_PA_LI(a) == 1) { (*intf)(S_PA_I(a,0),b,f); goto eee; }
38
39 p = CALLOCOBJECT();
40 b_ks_pa(VECTOR,CALLOCOBJECT(),p);
41 m_il_integervector(S_PA_LI(a)-1,S_PA_S(p));
42 h2 = CALLOCOBJECT();
43 b_ks_pa(VECTOR,CALLOCOBJECT(),h2);
44 m_il_integervector(1,S_PA_S(h2));
45
46 NEW_HASHTABLE(h1);
47 ff = CALLOCOBJECT();
48 for (j=0,i=S_PA_LI(a)-1;i>= 0; i--,j++)
49 {
50 if (( S_PA_II(a,i) - j ) >= 0 ) {
51 INT k;
52 FREESELF(ff);
53 for (k=0;k<S_PA_LI(a);k++)
54 {
55 if (k<i) M_I_I(S_PA_II(a,k), S_PA_I(p,k) );
56 else if (k>i) M_I_I(S_PA_II(a,k)+1, S_PA_I(p,k-1));
57 }
58
59 if (( S_PA_II(a,i) - j ) == 0)
60 {
61 if (j%2 == 1) { ADDINVERS(f,ff); } else { COPY(f,ff); }
62 erg += t_schur_jacobi_trudi(p,b,ff,intf,multf);
63 }
64 else {
65 if (j%2 == 1) { ADDINVERS(f,ff); } else { COPY(f,ff); }
66 erg += t_schur_jacobi_trudi(p,h1,ff,intf,multf);
67
68 M_I_I(S_PA_II(a,i) - j,S_PA_I(h2,0));
69 erg += (*multf)(h2,h1,b,cons_eins); /* erster parameter homsym */
70
71 CLEAR_HASHTABLE(h1);
72 }
73 }
74 else break;
75 }
76 FREEALL(p);
77 FREEALL(h2);
78 FREEALL(h1);
79 FREEALL(ff);
80
81 eee:
82 ENDR("t_schur_jacobi_trudi");
83 }
84
t_schur_naegelsbach(a,b,f,intf,multf)85 INT t_schur_naegelsbach(a,b,f,intf,multf)
86 /* implementiert die naegelsbach determinante
87 fuer basis wechsel schur -> ... */
88 OP a,b,f;
89 INT (*intf)(), (*multf)();
90 {
91 OP z,ac;
92 INT i,j;
93 OP p,h2; OP h1;
94 INT erg = OK;
95 CTO(PARTITION,"t_schur_naegelsbach(1)",a);
96 CTTTTTO(HASHTABLE,HOMSYM,MONOMIAL,ELMSYM,POWSYM,"t_schur_naegelsbach(2)",b);
97
98 if (S_PA_LI(a) == 0) { (*intf)(cons_null,b,f); goto eee; }
99
100 ac = CALLOCOBJECT();
101 conjugate_partition(a,ac);
102 a = ac;
103
104
105 if (S_PA_LI(a) == 1) { (*intf)(S_PA_I(a,0),b,f); goto bbb; }
106
107 p = CALLOCOBJECT();
108 b_ks_pa(VECTOR,CALLOCOBJECT(),p);
109 m_il_integervector(S_PA_LI(a)-1,S_PA_S(p));
110 h2 = CALLOCOBJECT();
111 b_ks_pa(VECTOR,CALLOCOBJECT(),h2);
112 m_il_integervector(1,S_PA_S(h2));
113
114 h1 = CALLOCOBJECT();init_hashtable(h1);
115 for (j=0,i=S_PA_LI(a)-1;i>= 0; i--,j++)
116 {
117 if (( S_PA_II(a,i) - j ) >= 0 ) {
118 INT k;
119 OP ff;
120 ff = CALLOCOBJECT();
121 for (k=0;k<S_PA_LI(a);k++)
122 {
123 if (k<i) M_I_I(S_PA_II(a,k), S_PA_I(p,k) );
124 else if (k>i) M_I_I(S_PA_II(a,k)+1, S_PA_I(p,k-1));
125 }
126
127 if (( S_PA_II(a,i) - j ) == 0)
128 {
129 if (j%2 == 1) ADDINVERS(f,ff); else COPY(f,ff);
130 erg += t_schur_jacobi_trudi(p,b,ff,intf,multf);
131 }
132 else {
133 if (j%2 == 1) ADDINVERS(f,ff); else COPY(f,ff);
134 erg += t_schur_jacobi_trudi(p,h1,ff,intf,multf);
135
136 M_I_I(S_PA_II(a,i) - j,S_PA_I(h2,0));
137 erg += (*multf)(h2,h1,b,cons_eins); /* erster parameter elmsym */
138
139 FORALL(z,h1, { FREESELF(z); });
140 M_I_I(0,S_V_I(h1,S_V_LI(h1)));
141
142
143 }
144 FREEALL(ff);
145 }
146 else break;
147 }
148 FREEALL(p);
149 FREEALL(h2);
150 FREEALL(h1);
151 bbb:
152 FREEALL(a); /* die conjugierte partition */
153
154 eee:
155 CTTTTTO(HASHTABLE,HOMSYM,MONOMIAL,ELMSYM,POWSYM,"t_schur_naegelsbach(2-ende)",b);
156 ENDR("t_schur_naegelsbach");
157 }
158
159 INT mhh_partition__();
160 INT mhh_partition_hashtable_();
161
tsh_jt(a,m)162 INT tsh_jt(a,m) OP a,m;
163 /* jacobi trudi matrix with integer entries */
164 /* -1 = zero contribution */
165 {
166 INT erg = OK,i,j;
167 CTTO(PARTITION,SKEWPARTITION,"jt(1)",a);
168 CTO(EMPTY,"jt(2)",m);
169 if (S_O_K(a) == PARTITION)
170 {
171 m_ilih_nm(S_PA_LI(a),S_PA_LI(a),m);
172 for (j=0;j<S_M_LI(m);j++)
173 for (i=0;i<S_M_HI(m);i++)
174 if (S_PA_II(a,i)+i-j < 0) M_I_I(-1,S_M_IJ(m,i,j));
175 else M_I_I(S_PA_II(a,i)+i-j, S_M_IJ(m,i,j));
176 }
177 else /* SKEW */
178 {
179 OP g,k;
180 INT kl;
181 g = S_SPA_G(a);
182 k = S_SPA_K(a);
183 m_ilih_nm(S_PA_LI(g),S_PA_LI(g),m);
184 for (j=0;j<S_M_LI(m);j++)
185 for (i=0;i<S_M_HI(m);i++)
186 if (S_PA_II(g,i)+i-j < 0) M_I_I(-1,S_M_IJ(m,i,j));
187 else M_I_I(S_PA_II(g,i)+i-j, S_M_IJ(m,i,j));
188 println(m);
189 /* now shift in the columns */
190 for (j=S_M_LI(m)-1,kl=S_PA_LI(k)-1;kl>=0;kl--,j--)
191 for (i=0;i<S_M_HI(m);i++)
192 {
193 if (S_M_IJI(m,i,j) == -1);
194 else if ((S_M_IJI(m,i,j) - S_PA_II(k,kl)) < 0) M_I_I(-1,S_M_IJ(m,i,j));
195 else M_I_I((S_M_IJI(m,i,j) - S_PA_II(k,kl)), S_M_IJ(m,i,j));
196 }
197 }
198 ENDR("jt");
199 }
200
tsh_eval_jt(b,f,m)201 INT tsh_eval_jt(b,f,m) OP b,f,m;
202 {
203 INT i,j;
204 INT erg = OK;
205 OP p,pv;
206 CTTO(HASHTABLE,HOMSYM,"tsh_eval_jt(1)",b);
207 p = CALLOCOBJECT();
208 pv = CALLOCOBJECT();
209 first_permutation(S_M_H(m),p);
210 first_permutation(S_M_H(m),pv);
211 do {
212 OP c,v;
213 INT z,k;
214 nn:
215 for (i=0,z=0;i<S_P_LI(p);i++)
216 if (S_M_IJI(m,i,S_P_II(p,i)-1) == -1) goto next;
217 else if (S_M_IJI(m,i,S_P_II(p,i)-1) == 0) z++;
218 /* valid contribution to result */
219 c = CALLOCOBJECT();
220 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),c);
221 signum_permutation(p,S_MO_K(c));
222 v = CALLOCOBJECT();
223 m_il_integervector(S_M_LI(m)-z,v);
224 for (i=0,j=0;i<S_P_LI(p);i++)
225 if (S_M_IJI(m,i,S_P_II(p,i)-1) > 0)
226 {
227 M_I_I(S_M_IJI(m,i,S_P_II(p,i)-1),S_V_I(v,j));
228 j++;
229 }
230 qsort(S_V_S(v), S_V_LI(v), sizeof(struct object), comp_integer_integer);
231 b_ks_pa(VECTOR,v,S_MO_S(c));
232 MULT_APPLY(f,S_MO_K(c));
233
234 INSERT_HOMSYMMONOM_(c,b);
235 continue;
236
237 next: /* we can increase the permutation */
238 if (i==0) goto jj;
239 i--;
240 for (j=S_P_LI(p)-1;j>=i;j--) ADDINVERS_APPLY_INTEGER(S_P_I(pv,S_P_II(p,j)-1));
241 /* now all used entries are marked */
242 /* check where you can increase */
243 aa: k = S_P_II(p,i);
244 for (j=k; j<S_P_LI(p);j++)
245 if (S_P_II(pv,j) < 0) {
246 /* it works */
247 M_I_I(- S_P_II(pv,j), S_P_I(p,i));
248 ADDINVERS_APPLY_INTEGER(S_P_I(pv,j));
249 i++;
250 for (k=0;k<S_P_LI(pv);k++)
251 if (S_P_II(pv,k) < 0) { M_I_I(- S_P_II(pv,k), S_P_I(p,i));
252 ADDINVERS_APPLY_INTEGER(S_P_I(pv,k));
253 i++;
254 }
255 goto nn;
256 }
257 i--;
258 if (i==0) goto jj;
259 ADDINVERS_APPLY_INTEGER(S_P_I(pv,S_P_II(p,i)-1));
260 goto aa;
261 ;
262 } while(next_apply(p));
263
264 jj:
265 FREEALL(p);
266 FREEALL(pv);
267 ENDR("tsh_eval_jt");
268 }
269
tsh_partition__faktor(a,b,f)270 INT tsh_partition__faktor(a,b,f) OP a,b,f;
271 {
272 INT erg = OK;
273 CTO(PARTITION,"tsh_partition__faktor(1)",a);
274 CTTO(HASHTABLE,HOMSYM,"tsh_partition__faktor(2)",b);
275 if (S_PA_LI(a) == 0) {
276 tsh_integer__faktor(cons_null,b,f);
277 goto eee;
278 }
279 else if (S_PA_LI(a) == 1) {
280 tsh_integer__faktor(S_PA_I(a,0),b,f);
281 goto eee;
282 }
283 else {
284 OP m;
285 m = CALLOCOBJECT();
286 tsh_jt(a,m);
287 tsh_eval_jt(b,f,m);
288 FREEALL(m);
289 goto eee;
290 }
291
292 eee:
293 ENDR("tsh_partition__faktor");
294 }
295
296
297
298
299 #ifdef UNDEF
tsh_partition__faktor_pre310102(a,b,f)300 INT tsh_partition__faktor_pre310102(a,b,f) OP a,b,f;
301 {
302 INT erg = OK;
303 CTO(PARTITION,"tsh_partition__faktor(1)",a);
304 CTTO(HASHTABLE,HOMSYM,"tsh_partition__faktor(2)",b);
305 if (S_PA_LI(a) == 0) {
306 tsh_integer__faktor(cons_null,b,f);
307 goto eee;
308 }
309 else if (S_PA_LI(a) == 1) {
310 tsh_integer__faktor(S_PA_I(a,0),b,f);
311 goto eee;
312 }
313 else
314 {
315 OP m,p;
316 INT i,j;
317 m = CALLOCOBJECT();
318 m_ilih_nm(S_PA_LI(a),S_PA_LI(a),m);
319 for (j=0;j<S_M_LI(m);j++)
320 for (i=0;i<S_M_HI(m);i++)
321 if (S_PA_II(a,i)+i-j < 0) M_I_I(-1,S_M_IJ(m,i,j));
322 else M_I_I(S_PA_II(a,i)+i-j, S_M_IJ(m,i,j));
323
324
325 p = CALLOCOBJECT();
326 first_permutation(S_PA_L(a),p);
327 do {
328 OP c,v;
329 INT z=0;
330 for (i=0;i<S_P_LI(p);i++)
331 if (S_M_IJI(m,i,S_P_II(p,i)-1) == -1) goto next;
332 else if (S_M_IJI(m,i,S_P_II(p,i)-1) == 0) z++;
333 /* valid contribution to result */
334 c = CALLOCOBJECT();
335 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),c);
336 signum_permutation(p,S_MO_K(c));
337 MULT_APPLY(f,S_MO_K(c));
338 v = CALLOCOBJECT();
339 m_il_integervector(S_PA_LI(a)-z,v);
340 for (i=0,j=0;i<S_P_LI(p);i++)
341 if (S_M_IJI(m,i,S_P_II(p,i)-1) > 0)
342 {
343 M_I_I(S_M_IJI(m,i,S_P_II(p,i)-1),S_V_I(v,j));
344 j++;
345 }
346 qsort(S_V_S(v), S_V_LI(v), sizeof(struct object), comp_integer_integer);
347 b_ks_pa(VECTOR,v,S_MO_S(c));
348
349 INSERT_HOMSYMMONOM_(c,b);
350 next: ;
351 } while(next_apply(p));
352
353 FREEALL(m);
354 FREEALL(p);
355 goto eee;
356 }
357 eee:
358 ENDR("tsh_partition__faktor");
359 }
360
tsh_partition__faktor_pre240102(a,b,f)361 INT tsh_partition__faktor_pre240102(a,b,f) OP a,b,f;
362 {
363 INT erg = OK;
364 CTO(PARTITION,"tsh_partition__faktor(1)",a);
365 CTTO(HASHTABLE,HOMSYM,"tsh_partition__faktor(2)",b);
366
367 /* nach der ersten spalte entwickeln bei jacobi trudi det */
368 if (S_PA_LI(a) == 0) {
369 tsh_integer__faktor(cons_null,b,f);
370 goto eee;
371 }
372 if (S_PA_LI(a) == 1) {
373 tsh_integer__faktor(S_PA_I(a,0),b,f);
374 goto eee;
375 }
376 if (S_PA_LI(a) == 2) {
377 OP m;
378 /* s_a,b = h_a,b - h_a--,b++ */
379 m = CALLOCOBJECT();
380 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
381 b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(m));
382 if (S_PA_II(a,0) > 1) {
383 m_il_integervector(2,S_PA_S(S_MO_S(m)));
384 M_I_I(S_PA_II(a,0)-1, S_PA_I(S_MO_S(m),0));
385 M_I_I(S_PA_II(a,1)+1, S_PA_I(S_MO_S(m),1));
386 }
387 else {
388 m_il_integervector(1,S_PA_S(S_MO_S(m)));
389 M_I_I(S_PA_II(a,1)+1, S_PA_I(S_MO_S(m),0));
390 }
391 ADDINVERS(f,S_MO_K(m));
392 if (S_O_K(b) == HOMSYM)
393 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
394 else
395 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,
396 hash_monompartition);
397
398 m = CALLOCOBJECT();
399 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
400 copy_partition(a,S_MO_S(m));
401 COPY(f,S_MO_K(m));
402 if (S_O_K(b) == HOMSYM)
403 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
404 else
405 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,
406 hash_monompartition);
407 goto eee;
408 }
409
410 if (S_PA_II(a,S_PA_LI(a)-1) == 1) /* elmsym */
411 {
412 INT teh_integer__faktor();
413 erg += teh_integer__faktor(S_PA_L(a),b,f);
414 goto eee;
415 }
416 t_schur_jacobi_trudi(a,b,f,tsh_integer__faktor,mhh_partition_hashtable_);
417
418 eee:
419 ENDR("tsh_partition__faktor");
420 }
421 #endif
422
tsh_schur__faktor(a,b,f)423 INT tsh_schur__faktor(a,b,f) OP a,b,f;
424 {
425 INT erg = OK;
426 CTTO(HASHTABLE,SCHUR,"tsh_schur__faktor(1)",a);
427 CTTO(HASHTABLE,HOMSYM,"tsh_schur__faktor(2)",b);
428
429 T_FORALL_MONOMIALS_IN_A(a,b,f,tsh_partition__faktor);
430
431 ENDR("tsh_schur__faktor");
432 }
433
tsh_hashtable__faktor(a,b,f)434 INT tsh_hashtable__faktor(a,b,f) OP a,b,f;
435 {
436 INT erg = OK;
437 CTO(HASHTABLE,"tsh_hashtable__faktor(1)",a);
438 CTTO(HASHTABLE,HOMSYM,"tsh_hashtable__faktor(2)",b);
439 T_FORALL_MONOMIALS_IN_A(a,b,f,tsh_partition__faktor);
440 ENDR("tsh_hashtable__faktor");
441 }
442
443
tsh___faktor(a,b,f)444 INT tsh___faktor(a,b,f) OP a,b,f;
445 {
446 INT erg = OK;
447 CTTTTO(HASHTABLE,INTEGER,SCHUR,PARTITION,"tsh___faktor(1)",a);
448 CTTO(HASHTABLE,HOMSYM,"tsh___faktor(2)",b);
449 if (S_O_K(a) == INTEGER) {
450 erg += tsh_integer__faktor(a,b,f);
451 goto eee;
452 }
453 else if (S_O_K(a) == PARTITION) {
454 erg += tsh_partition__faktor(a,b,f);
455 goto eee;
456 }
457 else if (S_O_K(a) == SCHUR) {
458 erg += tsh_schur__faktor(a,b,f);
459 goto eee;
460 }
461 else /* HASHTABLE */ {
462 erg += tsh_hashtable__faktor(a,b,f);
463 goto eee;
464 }
465 eee:
466 ENDR("tsh___faktor");
467 }
468
469
t_SCHUR_HOMSYM(a,b)470 INT t_SCHUR_HOMSYM(a,b) OP a,b;
471 {
472 INT erg = OK;
473 INT t = 0;
474 CTTTTO(INTEGER,HASHTABLE,SCHUR,PARTITION,"t_SCHUR_HOMSYM",a);
475 TCE2(a,b,t_SCHUR_HOMSYM,HOMSYM);
476
477 if (S_O_K(b) == EMPTY)
478 {
479 erg += init_hashtable(b);
480 t=1;
481 }
482 tsh___faktor(a,b,cons_eins);
483 if (t==1) t_HASHTABLE_HOMSYM(b,b);
484
485 ENDR("t_SCHUR_HOMSYM");
486 }
487
488
489