1 #include "def.h"
2 #include "macro.h"
3
4 static INT ek_to_h();
5
6 static OP teh_speicher = NULL;
teh_ende()7 INT teh_ende()
8 {
9 INT erg = OK;
10 if (teh_speicher != NULL)
11 {
12 FREEALL(teh_speicher);
13 teh_speicher=NULL;
14 }
15
16 ENDR("teh_ende");
17 }
18
find_teh_integer(a)19 OP find_teh_integer(a) OP a;
20 {
21 INT erg = OK;
22 CTO(INTEGER,"teh_integer__faktor(1)",a);
23 SYMCHECK((S_I_I(a) < 0),"teh_integer__faktor:parameter < 0");
24
25 if (teh_speicher == NULL) {
26 teh_speicher = CALLOCOBJECT();
27 erg += m_il_v(100,teh_speicher);
28 }
29 if (S_I_I(a) > S_V_LI(teh_speicher)) {
30 inc_vector_co(teh_speicher, S_I_I(a)-S_V_LI(teh_speicher)+5);
31 }
32
33 if (not EMPTYP(S_V_I(teh_speicher, S_I_I(a))))
34 {
35 return S_V_I(teh_speicher, S_I_I(a));
36 }
37 else {
38 ek_to_h(a,S_V_I(teh_speicher, S_I_I(a)));
39 return S_V_I(teh_speicher, S_I_I(a));
40 }
41
42 ENDO("find_teh_integer");
43
44 }
45
teh_integer__faktor(a,b,f)46 INT teh_integer__faktor(a,b,f) OP a,b,f;
47 /* also called from tsh_partition__faktor */
48 /* also called from the_integer__faktor */
49 {
50 INT erg = OK;
51 OP m;
52 CTO(INTEGER,"teh_integer__faktor(1)",a);
53 CTTTO(HASHTABLE,HOMSYM,ELMSYM,"teh_integer__faktor(2)",b);
54 SYMCHECK((S_I_I(a) < 0),"teh_integer__faktor:parameter < 0");
55
56 if (teh_speicher == NULL) {
57 teh_speicher = CALLOCOBJECT();
58 erg += m_il_v(100,teh_speicher);
59 }
60 if (S_I_I(a) > S_V_LI(teh_speicher)) {
61 inc_vector_co(teh_speicher, S_I_I(a)-S_V_LI(teh_speicher)+5);
62 }
63 if (not EMPTYP(S_V_I(teh_speicher, S_I_I(a))))
64 {
65 m = CALLOCOBJECT();
66 COPY(S_V_I(teh_speicher, S_I_I(a)),m);
67 MULT_APPLY(f,m);
68 if (S_O_K(b) == HASHTABLE)
69 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
70 else
71 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
72 goto eee;
73 }
74
75 m = CALLOCOBJECT();
76 ek_to_h(a,m);
77 COPY(m,S_V_I(teh_speicher, S_I_I(a)));
78
79 MULT_APPLY(f,m);
80 if (S_O_K(b) == HASHTABLE)
81 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
82 else
83 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
84 eee:
85 ENDR("teh_integer__faktor");
86 }
87
teh_partition__faktor_pre290102(a,b,f)88 INT teh_partition__faktor_pre290102(a,b,f) OP a,b,f;
89 {
90 INT erg = OK;
91 CTO(PARTITION,"teh_partition__faktor(1)",a);
92 CTTO(HASHTABLE,HOMSYM,"teh_partition__faktor(2)",b);
93
94 if (S_PA_LI(a) == 0) {
95 OP m;
96 m = CALLOCOBJECT();
97 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
98 erg += first_partition(cons_null,S_MO_S(m));
99 COPY(f,S_MO_K(m));
100 INSERT_HOMSYMMONOM_(m,b);
101 }
102 else if ( S_PA_LI(a) == 1 ){
103 erg += teh_integer__faktor(S_PA_I(a,0),b,f);
104 }
105 else {
106 INT t_loop_partition();
107 erg += t_loop_partition(a,b,f,teh_integer__faktor,mult_homsym_homsym,mult_apply_homsym_homsym);
108
109 /* slower one
110
111 INT t_splitpart();;
112 erg += t_splitpart(a,b,f,teh_partition__faktor,mult_homsym_homsym);
113 */
114 }
115
116 ENDR("teh_partition__faktor");
117 }
118
119
special_teh_integer(a,b,w,ff)120 static INT special_teh_integer(a,b,w,ff) OP a,b; INT w; OP (*ff)();
121 {
122 INT erg = OK,i;
123 OP h,z,m;
124 CTO(HASHTABLE,"special_teh_integer(2)",b);
125 h = (*ff)(a);
126 FORALL(z,h, {
127 m = CALLOCOBJECT();
128 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
129 COPY(S_MO_K(z),S_MO_K(m));
130 b_ks_pa(EXPONENT,CALLOCOBJECT(),S_MO_S(m));
131 m_il_nv(w,S_PA_S(S_MO_S(m)));
132 C_O_K(S_PA_S(S_MO_S(m)), INTEGERVECTOR);
133 for (i=0;i<S_PA_LI(S_MO_S(z));i++) INC_INTEGER(S_PA_I(S_MO_S(m), S_PA_II(S_MO_S(z),i)-1));
134 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(z)),i);
135 C_PA_HASH(S_MO_S(z),i);
136 INSERT_HOMSYMMONOM_(m,b);
137 });
138 CTO(HASHTABLE,"special_teh_integer(e2)",b);
139 ENDR("special_teh_integer");
140 }
141
special_eq(a,b)142 INT special_eq(a,b) OP a,b; {
143 /* both partitions of equal length */
144 OP av,bv;
145 INT l;
146 av = S_V_S(S_PA_S(S_MO_S(a)));
147 bv = S_V_S(S_PA_S(S_MO_S(b)));
148 l = S_PA_LI(S_MO_S(b)) -1;
149 for (; l>=0;l--,av++,bv++)
150 if (S_I_I(av) != S_I_I(bv)) return FALSE;
151 return TRUE;
152 }
153
special_mult_apply_homsym_homsym(a,b,mpm)154 INT special_mult_apply_homsym_homsym(a,b,mpm) OP a,b,mpm;
155 /* both are hashtable */
156 /* both labelling partitions are are of expnent type */
157 /* both labelling partitions are of the same length */
158 /* the external variable mpm is initialised */
159 {
160 OP c,z1,z2,p1,p2,p3;
161 INT erg = OK,i,j;
162 CTO(HASHTABLE,"special_mult_apply_homsym_homsym(1)",a);
163 CTO(HASHTABLE,"special_mult_apply_homsym_homsym(2)",b);
164 CTO(MONOM,"special_mult_apply_homsym_homsym(3)",mpm);
165
166 NEW_VECTOR(c,WEIGHT_HASHTABLE(b));
167 i=0;
168 FORALL_HASHTABLE(z2,b, { SWAP(S_V_I(c,i),z2); i++; });
169
170 /* entries in c */
171 /* b is empty */
172
173 for (i=S_V_LI(b)-1,z1=S_V_S(b);i>=0; i--,z1++)
174 {
175 if (not EMPTYP(z1) )
176 FREESELF_INTEGERVECTOR(z1);
177 C_I_I(z1,-1);
178 }
179 M_I_I(0,S_V_I(b,S_V_LI(b)));
180
181 /* b is a empty */
182
183 FORALL_HASHTABLE(z1,a, {
184 for (j=0,z2 = S_V_S(c);j<S_V_LI(c);j++,z2++)
185 {
186 for (i=0,p1=S_V_S(S_PA_S(S_MO_S(z1))),p2=S_V_S(S_PA_S(S_MO_S(z2))),
187 p3 = S_V_S(S_PA_S(S_MO_S(mpm)));
188 i<S_PA_LI(S_MO_S(z1));
189 i++,p1++,p2++,p3++)
190
191 C_I_I(p3,S_I_I(p1) + S_I_I(p2)); /* addition der exponentenvectoren */
192
193
194 CLEVER_MULT(S_MO_K(z1),S_MO_K(z2),S_MO_K(mpm));
195 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(mpm)),i);
196 C_PA_HASH(S_MO_S(mpm),i);
197 add_apply_hashtable(mpm,b,add_koeff,special_eq,hash_monompartition);
198 }
199 });
200 FREEALL(c);
201
202 ENDR("special_mult_apply_homsym_homsym");
203 }
204
205 INT t_productexponent();
206
207
teh_partition__faktor(a,b,f)208 INT teh_partition__faktor(a,b,f) OP a,b,f;
209 /* AK 300102 */
210 {
211 return t_productexponent(a,b,f,teh_integer__faktor,find_teh_integer);
212 }
213
t_productexponent(a,b,f,tf,ff)214 INT t_productexponent(a,b,f,tf,ff) OP a,b,f; INT (*tf)(); OP (*ff)();
215 /* AK 300102 */
216 /* ff is find function for integer */
217 /* tf is trans function for integer */
218 {
219 INT erg = OK;
220 CTO(PARTITION,"t_productexponent(1)",a);
221 CTTTO(HASHTABLE,HOMSYM,POWSYM,"t_productexponent(2)",b);
222
223 if (S_PA_LI(a) == 0) {
224 OP m;
225 m = CALLOCOBJECT();
226 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
227 erg += first_partition(cons_null,S_MO_S(m));
228 COPY(f,S_MO_K(m));
229 if (S_O_K(b) == HASHTABLE)
230 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
231 else
232 INSERT_LIST(m,b,add_koeff,comp_monomhomsym);
233
234 goto ende;
235 }
236 else if ( S_PA_LI(a) == 1 ){
237 erg += (*tf)(S_PA_I(a,0),b,f);
238 goto ende;
239 }
240 else {
241 INT i,w;
242 OP c,d,mpm;
243
244
245 w = S_PA_II(a,S_PA_LI(a)-1);
246 NEW_HASHTABLE(d);
247 special_teh_integer(S_PA_I(a,0),d,w,ff);
248
249 mpm = CALLOCOBJECT();
250 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),mpm);
251 b_ks_pa(EXPONENT,CALLOCOBJECT(),S_MO_S(mpm));
252 m_il_nv(w,S_PA_S(S_MO_S(mpm)));
253 C_O_K(S_PA_S(S_MO_S(mpm)), INTEGERVECTOR);
254
255
256 NEW_HASHTABLE(c);
257 for (i=1;i<S_PA_LI(a);i++)
258 {
259 special_teh_integer(S_PA_I(a,i),c,w,ff);
260 special_mult_apply_homsym_homsym(c,d,mpm);
261 CLEAR_HASHTABLE(c);
262 }
263
264 FREEALL(mpm);
265 FREEALL(c);
266
267 { OP z,mm;
268 FORALL(z,d,{
269 t_EXPONENT_VECTOR_apply(S_MO_S(z));
270 HASH_INTEGERVECTOR(S_PA_S(S_MO_S(z)),i);
271 C_PA_HASH(S_MO_S(z),i);
272 if (not EINSP(f))
273 MULT_APPLY(f,S_MO_K(z));
274 mm = CALLOCOBJECT();
275 SWAP(mm,z);
276 if (S_O_K(b) == HASHTABLE)
277 INSERT_HASHTABLE(mm,b,
278 add_koeff,
279 eq_monomsymfunc,hash_monompartition);
280 else
281 INSERT_LIST(mm,b,add_koeff,comp_monomhomsym);
282
283 DEC_INTEGER(S_V_I(d,S_V_LI(d)));
284 });
285 }
286 FREEALL(d);
287
288 goto ende;
289 }
290
291 ende:
292 ENDR("t_productexponent");
293 }
294
295
teh_elmsym__faktor(a,b,f)296 INT teh_elmsym__faktor(a,b,f) OP a,b,f;
297 {
298 INT erg = OK;
299 CTTO(HASHTABLE,ELMSYM,"teh_elmsym__faktor(1)",a);
300 CTTO(HASHTABLE,HOMSYM,"teh_elmsym__faktor(2)",b);
301 T_FORALL_MONOMIALS_IN_A(a,b,f,teh_partition__faktor);
302 ENDR("teh_elmsym__faktor");
303 }
304
teh_hashtable__faktor(a,b,f)305 INT teh_hashtable__faktor(a,b,f) OP a,b,f;
306 {
307 INT erg = OK;
308 CTO(HASHTABLE,"teh_hashtable__faktor(1)",a);
309 CTTO(HASHTABLE,HOMSYM,"teh_hashtable__faktor(2)",b);
310 T_FORALL_MONOMIALS_IN_A(a,b,f,teh_partition__faktor);
311 ENDR("teh_hashtable__faktor");
312 }
313
314
315
teh___faktor(a,b,f)316 INT teh___faktor(a,b,f) OP a,b; OP f;
317 {
318 INT erg = OK;
319 CTTTTO(INTEGER,HASHTABLE,ELMSYM,PARTITION,"teh___faktor(1)",a);
320 CTTO(HASHTABLE,HOMSYM,"teh___faktor(2)",b);
321
322 if (teh_speicher == NULL) {
323 teh_speicher = CALLOCOBJECT();
324 erg += m_il_v(100,teh_speicher);
325 }
326
327 if (S_O_K(a) == INTEGER) {
328 erg += teh_integer__faktor(a,b,f);
329 goto eee;
330 }
331 else if (S_O_K(a) == PARTITION) {
332 erg += teh_partition__faktor(a,b,f);
333 goto eee;
334 }
335 else if (S_O_K(a) == ELMSYM) {
336 erg += teh_elmsym__faktor(a,b,f);
337 goto eee;
338 }
339 else /* HASHTABLE */ {
340 erg += teh_hashtable__faktor(a,b,f);
341 goto eee;
342 }
343
344
345 eee:
346 ENDR("internal to t_ELMSYM_HOMSYM");
347 }
348
ek_to_h(a,b)349 static INT ek_to_h(a,b) OP a,b;
350 /* a is INTEGER */
351 /* AK 060901 */
352 {
353 INT i,l,ml,so,w=S_I_I(a);
354 INT erg = OK;
355 INT binom_small();
356 OP c,d,oben,unten;
357 OP res;
358 CTO(INTEGER,"ek_to_h(1)",a);
359 SYMCHECK((S_I_I(a)<0),"ek_to_h: parameter < 0");
360
361 if (S_I_I(a) == 0) {
362 erg += m_scalar_homsym(cons_eins,b);
363 goto ende;
364 }
365
366 d = CALLOCOBJECT();
367 oben = CALLOCOBJECT();
368 unten = CALLOCOBJECT();
369 c = CALLOCOBJECT();
370 erg += first_partition(a,c);
371 erg += init(HASHTABLE,b);
372 do {
373 l = S_PA_LI(c);
374 if (l == 1) {
375 res = CALLOCOBJECT();
376 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),res);
377 /* first entry in the result */
378 erg += copy_partition(c,S_MO_S(res));
379 if ((w+l)%2 == 1) /* negativ */
380 M_I_I(-1,S_MO_K(res));
381 else
382 M_I_I(1,S_MO_K(res));
383 INSERT_HOMSYMMONOM_(res,b);
384 }
385 else {
386 res=CALLOCOBJECT();
387 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),res);
388 erg += copy_partition(c,S_MO_S(res));
389
390 if (S_PA_II(c,S_PA_LI(c)-1) == 1) {
391 /* last one */
392 M_I_I(1,S_MO_K(res));
393 INSERT_HOMSYMMONOM_(res,b);
394 continue;
395 }
396 erg += t_VECTOR_EXPONENT(c,d);
397 for (ml=0,so=0,i=1;i<S_PA_LI(d);i++)
398 {
399 so += S_PA_II(d,i);
400 if (S_PA_II(d,i) != 0) ml++;
401 }
402 if (so != l) /* einsen da */
403 {
404 FREESELF(unten);
405 M_I_I(so,unten);
406 M_I_I(l,oben);
407
408 if ( (l > 12) )
409 erg += binom(oben,unten,S_MO_K(res));
410 else
411 erg += binom_small(oben,unten,S_MO_K(res));
412
413 }
414 else {
415 M_I_I(1,S_MO_K(res));
416 }
417 /* faktor bestimmen */
418 M_I_I(so,oben);
419 m_il_v(ml,unten);
420 for (ml=0,i=1;i<S_PA_LI(d);i++)
421 if (S_PA_II(d,i) != 0)
422 { M_I_I(S_PA_II(d,i), S_V_I(unten,ml)); ml++; }
423 if (so > 12) {
424 erg += multinom(oben,unten,d);
425 MULT_APPLY(d,S_MO_K(res));
426 }
427 else {
428 FREESELF(d);
429 erg += multinom_small(oben,unten,d);
430 MULT_APPLY_INTEGER(d,S_MO_K(res));
431 }
432 if ((w+l)%2 == 1) /* negativ */
433 ADDINVERS_APPLY(S_MO_K(res));
434
435 INSERT_HOMSYMMONOM_(res,b);
436 }
437 } while (next_apply(c));
438
439 FREEALL(c);
440 FREEALL(d);
441 FREEALL(oben);
442 FREEALL(unten);
443 ende:
444 ENDR("ek_to_h");
445 }
446
t_ELMSYM_HOMSYM(a,b)447 INT t_ELMSYM_HOMSYM(a,b) OP a,b;
448 /* AK 050901 */
449 {
450 INT erg = OK;
451 INT t=0;
452 CTTTTO(HASHTABLE,ELMSYM,PARTITION,INTEGER,"t_ELMSYM_HOMSYM",a);
453 TCE2(a,b,t_ELMSYM_HOMSYM,HOMSYM);
454
455 if (S_O_K(b) == EMPTY)
456 {
457 erg += init_hashtable(b);
458 t=1;
459 }
460 teh___faktor(a,b,cons_eins);
461 if (t==1) t_HASHTABLE_HOMSYM(b,b);
462
463 ENDR("t_ELMSYM_HOMSYM");
464 }
465