1 /* SYMMETRICA sr.c */
2 #include "def.h"
3 #include "macro.h"
4
5 OP me_speicher = NULL;
6
7 INT tme___faktor();
8 INT tme_monomial__faktor();
9 INT tmh_integer__faktor();
10 INT mee_integer_hashtable_();
11 INT mem_integer_hashtable_();
12 INT txx_null__faktor();
13 INT t_splitpart();
14
tme_ende()15 INT tme_ende()
16 {
17 INT erg = OK;
18 if (me_speicher != NULL)
19 {
20 FREEALL(me_speicher);
21 }
22 me_speicher=NULL;
23 ENDR("tme_ende");
24 }
25
t_MONOMIAL_ELMSYM(a,b)26 INT t_MONOMIAL_ELMSYM(a,b) OP a,b;
27 /* AK 121101 */
28 {
29 INT erg = OK;
30 INT t = 0;
31 CTTTTO(INTEGER,PARTITION,MONOMIAL,HASHTABLE,"t_MONOMIAL_ELMSYM(1)",a);
32 if (a == b) {
33 OP c;
34 c = CALLOCOBJECT();
35 *c = *a;
36 C_O_K(a,EMPTY);
37 erg += init_hashtable(b);
38 t = 1;
39 erg += tme___faktor(c,b,cons_eins);
40 FREEALL(c);
41 }
42 else if (S_O_K(b) == ELMSYM)
43 {
44 OP c;
45 c = CALLOCOBJECT();
46 erg += init_hashtable(c);
47 erg += tme___faktor(a,c,cons_eins);
48 insert(c,b,add_koeff,comp_monomelmsym);
49 }
50
51 else {
52 if (S_O_K(b) == EMPTY) {
53 erg += init_hashtable(b);
54 t = 1;
55 }
56 if (S_O_K(b) != HASHTABLE)
57 {
58 FREESELF(b);
59 erg += init_hashtable(b);
60 t = 1;
61 }
62 erg += tme___faktor(a,b,cons_eins);
63 }
64 if (t == 1)
65 erg += t_HASHTABLE_ELMSYM(b,b);
66 ENDR("t_MONOMIAL_ELMSYM");
67 }
68
69 OP find_tmh_integer();
70
find_tme_integer(a)71 OP find_tme_integer(a) OP a;
72 /* AK 300102 */
73 {
74 INT erg = OK;
75 CTO(INTEGER,"find_tme_integer(1)",a);
76 SYMCHECK(S_I_I(a) < 0, "find_tme_integer:integer <0");
77
78 if (S_I_I(a) % 2 == 1)
79 return find_tmh_integer(a);
80
81 if (me_speicher == NULL) {
82 me_speicher=CALLOCOBJECT();
83 erg += m_il_v(40,me_speicher);
84 }
85
86 if (S_I_I(a) >= S_V_LI(me_speicher)) {
87 erg += inc_vector_co(me_speicher,S_I_I(a)-S_V_LI(me_speicher)+5);
88 }
89
90 if (EMPTYP(S_V_I(me_speicher,S_I_I(a))) ) {
91 OP c;
92 c = find_tmh_integer(a);
93 MULT_INTEGER(cons_negeins,c,S_V_I(me_speicher,S_I_I(a) ) ) ;
94 }
95
96 return S_V_I(me_speicher,S_I_I(a));
97
98 ENDO("find_tme_integer");
99 }
100
tme_integer__faktor(a,b,f)101 INT tme_integer__faktor(a,b,f) OP a,b; OP f;
102 {
103 INT erg = OK;
104 CTO(INTEGER,"tme_integer__faktor(1)",a);
105 CTO(HASHTABLE,"tme_integer__faktor(2)",b);
106 SYMCHECK(S_I_I(a) < 0, "tme_integer__faktor:integer <0");
107 if (S_I_I(a) == 0)
108 {
109 txx_null__faktor(b,f);
110 goto ende;
111 }
112 else if (S_I_I(a) %2 == 0)
113 {
114 OP c;
115 c = CALLOCOBJECT();
116 ADDINVERS(f,c);
117 erg += tmh_integer__faktor(a,b,c);
118 FREEALL(c);
119 goto ende;
120 }
121 else
122 {
123 erg += tmh_integer__faktor(a,b,f);
124 goto ende;
125 }
126 ende:
127 ENDR("tme_integer__faktor");
128 }
129
tme_partition__faktor(a,b,f)130 INT tme_partition__faktor(a,b,f) OP a,b; OP f;
131 {
132 INT erg = OK;
133 CTO(PARTITION,"tme_partition__faktor(1)",a);
134 CTO(HASHTABLE,"tme_partition__faktor(2)",b);
135
136 if (S_PA_LI(a) == 0) {
137 txx_null__faktor(b,f);
138 goto ende;
139 }
140 else if (S_PA_LI(a) == 1)
141 {
142 erg += tme_integer__faktor(S_PA_I(a,0),b,f);
143 goto ende;
144 }
145 else{
146
147 OP e;
148 e = CALLOCOBJECT();
149 erg += m_pa_mon(a,e);
150 erg += tme_monomial__faktor(e,b,f);
151 FREEALL(e);
152 goto ende;
153 }
154 ende:
155 ENDR("tme_partition__faktor");
156 }
157
tme_hashtable__faktor(a,b,f)158 INT tme_hashtable__faktor(a,b,f) OP a,b; OP f;
159 {
160 INT erg = OK;
161 CTO(HASHTABLE,"tme_hashtable__faktor(1)",a);
162 CTO(HASHTABLE,"tme_hashtable__faktor(2)",b);
163 erg += tme_monomial__faktor(a,b,f);
164 ENDR("tme_hashtable__faktor");
165 }
166
tme_monomial__faktor(a,b,f)167 INT tme_monomial__faktor(a,b,f) OP a,b; OP f;
168 {
169 INT erg = OK;
170 OP z=NULL,ha,e_i,ohne_i,e_ohne_i;
171 INT i;
172 CTTO(HASHTABLE,MONOMIAL,"tme_monomial__faktor(1)",a);
173 CTO(HASHTABLE,"tme_monomial__faktor(2)",b);
174 CTO(ANYTYPE,"tme_monomial__faktor(3)",f);
175
176
177
178
179 if (S_O_K(a) == MONOMIAL) {
180 if (S_L_S(a) == NULL) {
181 goto endr_ende;
182 }
183 if (S_L_N(a) == NULL) {
184 if (S_PA_LI(S_S_S(a)) == 0) {
185 OP e;
186 e = CALLOCOBJECT();
187 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),e);
188 erg += first_partition(cons_null,S_MO_S(e));
189 COPY(S_S_K(a),S_MO_K(e));
190 MULT_APPLY(f,S_MO_K(e));
191 INSERT_HASHTABLE(e,b,add_koeff,eq_monomsymfunc,hash_monompartition);
192 goto ende;
193 }
194 else if (S_PA_LI(S_S_S(a)) == 1) {
195 OP w;
196 w = CALLOCOBJECT();
197 MULT(f,S_S_K(a),w);
198 erg += tme_integer__faktor(S_PA_I(S_S_S(a),0),b,w);
199 FREEALL(w);
200 goto ende;
201 }
202 }
203 }
204 else if (S_O_K(a) == HASHTABLE) {
205 if (S_V_II(a,S_V_LI(a)) == 0) {
206 goto ende;
207 }
208 if (S_V_II(a,S_V_LI(a)) == 1) {
209 FORALL(z,a, { goto fff; } );
210 fff:
211 if (S_PA_LI(S_MO_S(z)) == 0) {
212 OP e;
213 e = CALLOCOBJECT();
214 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),e);
215 erg += first_partition(cons_null,S_MO_S(e));
216 COPY(S_MO_K(z),S_MO_K(e));
217 MULT_APPLY(f,S_MO_K(e));
218 INSERT_HASHTABLE(e,b,add_koeff,eq_monomsymfunc,hash_monompartition);
219 goto ende;
220 }
221 else if (S_PA_LI(S_MO_S(z)) == 1) {
222 OP w;
223 w = CALLOCOBJECT();
224 MULT(f,S_MO_K(z),w);
225 erg += tme_integer__faktor(S_PA_I(S_MO_S(z),0),b,w);
226 FREEALL(w);
227 goto ende;
228 }
229 }
230 }
231
232
233 /* die eigentliche rekursion */
234
235 /* step one: find the minimum length of the partitions in a */
236 z = findmin_monomial(a,length_comp_part);
237 i = S_PA_LI(S_MO_S(z));
238 ha = CALLOCOBJECT();
239 COPY(a,ha);
240
241 NEW_HASHTABLE(ohne_i);
242 NEW_HASHTABLE(e_ohne_i);
243
244 e_i = CALLOCOBJECT();
245
246 while (i>=0) {
247 /* hole alle partitionen der laenge i aus dem MONOMIAL ha */
248 OP v,m,p;
249 INT j,k;
250
251 CTTO(MONOMIAL,HASHTABLE,"tme_monomial__faktor(i-ha)",ha);
252 if (S_O_K(ha) == MONOMIAL) {
253 /* abbruch bedingung */
254 if (S_L_S(ha) == NULL) break;
255 /* zweite abbruch bedingung */
256 if (S_L_N(ha) == NULL)
257 if ((S_PA_LI(S_S_S(ha)) == 0) ||
258 (S_PA_II(S_S_S(ha), S_PA_LI(S_S_S(ha))-1 ) == 1)
259 )
260 {
261 OP h=CALLOCOBJECT();
262 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),h);
263 erg +=first_partition(S_PA_L(S_S_S(ha)),S_MO_S(h));
264 COPY(S_S_K(ha),S_MO_K(h));
265 if (not EINSP(f))
266 MULT_APPLY(f,S_MO_K(h));
267 INSERT_HASHTABLE(h,b,add_koeff,eq_monomsymfunc,
268 hash_monompartition);
269 break;
270 }
271 }
272 else if (S_O_K(ha) == HASHTABLE) {
273 /* abbruch bedingung */
274 if (S_V_II(ha,S_V_LI(ha)) == 0) break;
275 /* zweite abbruch bedingung */
276 if (S_V_II(ha,S_V_LI(ha)) == 1)
277 {
278 FORALL(z,ha,{goto eee;});
279 eee:
280 if ((S_PA_LI(S_MO_S(z)) == 0) ||
281 (S_PA_II(S_MO_S(z), S_PA_LI(S_MO_S(z))-1 ) == 1)
282 )
283 {
284 OP h=CALLOCOBJECT();
285 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),h);
286 erg +=first_partition(S_PA_L(S_MO_S(z)),S_MO_S(h));
287 COPY(S_MO_K(z),S_MO_K(h));
288 if (not EINSP(f))
289 MULT_APPLY(f,S_MO_K(h));
290 INSERT_HASHTABLE(h,b,add_koeff,eq_monomsymfunc,
291 hash_monompartition);
292 break;
293 }
294 }
295 }
296
297
298 FORALL(z,ha, {
299 if (S_PA_LI(S_MO_S(z)) == i) /* kommt nach ohne_i */
300 {
301 for (j=0;j<i;j++)
302 if (S_PA_II(S_MO_S(z),j) > 1) break;
303 /* an der stelle j geht die eigentliche partition los */
304 v = CALLOCOBJECT();
305 erg +=m_il_v(i-j,v);
306 for (k=0;k<S_V_LI(v);k++)
307 M_I_I(S_PA_II(S_MO_S(z),k+j)-1,S_V_I(v,k));
308 p = CALLOCOBJECT();
309 erg +=b_ks_pa(VECTOR,v,p);
310 m = CALLOCOBJECT();
311 erg +=b_sk_mo(p,CALLOCOBJECT(),m);
312 COPY(S_MO_K(z),S_MO_K(m));
313 CTO(MONOM,"(i1)",m);
314 INSERT_HASHTABLE(m,ohne_i,add_koeff,eq_monomsymfunc,
315 hash_monompartition);
316 }
317 });
318 /* falls ohne_i leer zum naechsten i */
319
320 if (S_V_II(ohne_i,S_V_LI(ohne_i)) == 0) {
321 i++;
322 continue;
323 }
324
325 /* der beitrag zum ergebnis ist jetzt e_i \times ohne_i */
326
327 erg += tme_monomial__faktor(ohne_i,e_ohne_i,f);
328 M_I_I(i,e_i);
329 erg += mee_integer_hashtable_(e_i,e_ohne_i,b,cons_eins);
330
331 /* jetzt muss noch ha geupdatet werden, es wird der entsprechende
332 teil abgezogen */
333
334
335 erg += mem_integer_hashtable_(e_i,ohne_i,ha,cons_negeins);
336
337 i++;
338 /* ohne_i leeren */
339 CLEAR_HASHTABLE(ohne_i);
340 CLEAR_HASHTABLE(e_ohne_i);
341 }
342 FREEALL(ha);
343 FREEALL(ohne_i);
344 FREEALL(e_ohne_i);
345 FREEALL(e_i);
346
347 ende:
348 CTO(HASHTABLE,"tme_monomial__faktor(e2)",b);
349 ENDR("tme_monomial__faktor");
350 }
351
352
tme___faktor(a,b,f)353 INT tme___faktor(a,b,f) OP a,b; OP f;
354 /* AK 161001 */
355 {
356 INT erg = OK;
357 CTTTTO(INTEGER,PARTITION,MONOMIAL,HASHTABLE,"tme___faktor(1)",a);
358 CTO(HASHTABLE,"tme___faktor(2)",b);
359
360 if (S_O_K(a) == INTEGER)
361 {
362 erg += tme_integer__faktor(a,b,f);
363 }
364 else if (S_O_K(a) == PARTITION)
365 {
366 erg += tme_partition__faktor(a,b,f);
367 }
368 else if (S_O_K(a) == MONOMIAL)
369 {
370 erg += tme_monomial__faktor(a,b,f);
371 }
372 else if (S_O_K(a) == HASHTABLE)
373 {
374 erg += tme_hashtable__faktor(a,b,f);
375 }
376 ENDR("t_MONOMIAL_ELMSYM");
377 }
378
379