1 #include "def.h"
2 #include "macro.h"
3
4 INT thp___faktor();
5 INT thp_integer__faktor();
6 INT mhp_integer_hashtable_();
7 INT t_splitpart();
8 INT mpp___();
9
t_HOMSYM_POWSYM(a,b)10 INT t_HOMSYM_POWSYM(a,b) OP a,b;
11 /* AK 190901 */
12 {
13 INT erg = OK;
14 INT t=0;
15 CTTTTO(HASHTABLE,INTEGER,PARTITION,HOMSYM,"t_HOMSYM_POWSYM(1)",a);
16 TCE2(a,b,t_HOMSYM_POWSYM,POWSYM);
17
18 if (S_O_K(b) == EMPTY) {
19 init_hashtable(b);t=1;
20 }
21 CTTO(HASHTABLE,POWSYM,"t_HOMSYM_POWSYM(2)",b);
22
23 thp___faktor(a,b,cons_eins);
24 if (t==1) t_HASHTABLE_POWSYM(b,b);
25
26 ENDR("t_HOMSYM_POWSYM");
27 }
28
29 static OP htop_sp=NULL;
thp_ende()30 INT thp_ende()
31 {
32 INT erg = OK;
33 if (htop_sp != NULL)
34 {
35 FREEALL(htop_sp);
36 }
37 htop_sp = NULL;
38 ENDR("thp_ende");
39 }
40
find_thp_integer(a)41 OP find_thp_integer(a) OP a;
42 /* AK 221101 */
43 /* zeiger auf gespeicherten wert */
44 {
45 INT erg = OK;
46 CTO(INTEGER,"find_thp_integer(1)",a);
47
48 SYMCHECK((S_I_I(a) <= 0) , "find_thp_integer:parameter <=0");
49 if (htop_sp == NULL)
50 NEW_VECTOR(htop_sp,20);
51
52 if (S_V_LI(htop_sp) <= S_I_I(a))
53 erg += inc_vector_co(htop_sp , S_I_I(a)-S_V_LI(htop_sp)+2);
54
55 if (not EMPTYP(S_V_I(htop_sp, S_I_I(a))))
56 return S_V_I(htop_sp, S_I_I(a));
57 else {
58 OP c;
59 NEW_HASHTABLE(c);
60 thp_integer__faktor(a,c,cons_eins);
61 FREEALL(c);
62 return S_V_I(htop_sp, S_I_I(a));
63 }
64 ENDO("find_thp_integer");
65 }
66
thp_integer__faktor(a,b,faktor)67 INT thp_integer__faktor(a,b,faktor) OP a,b; OP faktor;
68 /* AK 311001 */
69 /* b = b + h_a * f */
70 {
71 INT erg = OK;
72 OP c,ergebnis,sp;
73 OP bb;
74
75 CTO(INTEGER,"thp_integer__faktor(1)",a);
76 CTTO(HASHTABLE,POWSYM,"thp_integer__faktor(2)",b);
77 CTO(ANYTYPE,"thp_integer__faktor(3)",faktor);
78 SYMCHECK((S_I_I(a) < 0), "thp_integer__faktor:parameter < 0");
79
80 if (S_I_I(a) == 0) {
81 OP m;
82 m = CALLOCOBJECT();
83 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
84 COPY(faktor,S_MO_K(m));
85 erg += first_partition(cons_null,S_MO_S(m));
86 if (S_O_K(b) == POWSYM)
87 INSERT_LIST(m,b,add_koeff,comp_monompowsym);
88 else
89 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
90 goto ende;
91 }
92
93 SYMCHECK((S_I_I(a) <= 0), "thp_integer__faktor:(i1)");
94 if (htop_sp == NULL) { htop_sp = CALLOCOBJECT(); erg += m_il_v(100,htop_sp); }
95 if (S_V_LI(htop_sp) <= S_I_I(a)) erg += inc_vector_co(htop_sp , S_I_I(a)-S_V_LI(htop_sp)+2);
96
97 if (not EMPTYP(S_V_I(htop_sp, S_I_I(a))))
98 {
99 OP m;
100 FORALL(c,S_V_I(htop_sp, S_I_I(a)), {
101 m = CALLOCOBJECT();
102 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
103 MULT(S_MO_K(c), faktor, S_MO_K(m));
104 copy_partition(S_MO_S(c),S_MO_S(m));
105 if (S_O_K(b) == POWSYM)
106 INSERT_LIST(m,b,add_koeff,comp_monompowsym);
107 else
108 INSERT_HASHTABLE(m,b,add_koeff,eq_monomsymfunc,hash_monompartition);
109 });
110 goto ende;
111 }
112
113 c=CALLOCOBJECT();
114 sp=CALLOCOBJECT();
115 bb=CALLOCOBJECT();
116
117 /* erg += init(POWSYM,bb); */
118 erg += init(HASHTABLE,bb);
119 erg += first_partition(a,c);
120 do {
121 OP d;
122 INT i;
123 CTO(PARTITION,"thp_integer__faktor(i1)",c);
124 M_I_I(1,sp);
125 ergebnis=CALLOCOBJECT();
126 M_I_I(1,ergebnis);
127 d = CALLOCOBJECT();
128 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),d);
129 erg += copy_partition(c,S_MO_S(d));
130 /* compute coeff */
131 for (i=(INT)0; i<S_PA_LI(c);i++)
132 {
133 if (i>(INT)0)
134 {
135 if (S_PA_II(c,i) == S_PA_II(c,(i-1L)))
136 {
137 INC_INTEGER(sp);
138 MULT_APPLY_INTEGER(sp,ergebnis);
139 }
140 else M_I_I(1L,sp);
141 };
142 MULT_APPLY_INTEGER(S_PA_I(c,i),ergebnis);
143 };
144 /* in ergebnis ist der coeff, es muss durch ihn geteilt werden */
145
146 erg += b_ou_b(CALLOCOBJECT(),ergebnis,S_MO_K(d));
147 M_I_I(1,S_B_O(S_MO_K(d)));
148 C_B_I(S_MO_K(d), GEKUERZT);
149 /* INSERT_LIST(d,bb,NULL,comp_monompowsym); */
150 insert_scalar_hashtable(d,bb,NULL,eq_monomsymfunc,hash_monompartition);
151 } while(next_apply(c));
152
153 FREEALL(c);
154 FREEALL(sp);
155 COPY(bb,S_V_I(htop_sp, S_I_I(a)));
156
157 MULT_APPLY(faktor,bb);
158
159 if (S_O_K(b) == POWSYM)
160 INSERT_LIST(bb,b,add_koeff,comp_monompowsym);
161 else
162 INSERT_HASHTABLE(bb,b,add_koeff,eq_monomsymfunc,hash_monompartition);
163
164 ende:
165 CTTO(HASHTABLE,POWSYM,"thp_integer__faktor(e2)",b);
166 ENDR("thp_integer__faktor");
167 }
168
169 INT mpp_hashtable_hashtable_();
170 INT t_productexponent();
171
thp_partition__faktor(a,b,f)172 INT thp_partition__faktor(a,b,f) OP a,b; OP f;
173 /* AK 300102 */
174 {
175 INT erg = OK;
176 CTO(PARTITION,"thp_partition__faktor(1)",a);
177 CTTO(HASHTABLE,POWSYM,"thp_partition__faktor(2)",b);
178 erg += t_productexponent(a,b,f,thp_integer__faktor,find_thp_integer);
179 ENDR("thp_partition__faktor");
180 }
181
thp_partition__faktor_pre300102(a,b,faktor)182 INT thp_partition__faktor_pre300102(a,b,faktor) OP a,b; OP faktor;
183 {
184 INT erg = OK;
185 CTO(PARTITION,"thp_partition__faktor(1)",a);
186 CTTO(HASHTABLE,POWSYM,"thp_partition__faktor(2)",b);
187
188 if (S_PA_LI(a) == 0)
189 {
190 erg += thp_integer__faktor(cons_null,b,faktor);
191 goto endr_ende;
192 }
193 else if (S_PA_LI(a) == 1)
194 {
195 erg += thp_integer__faktor(S_PA_I(a,0),b,faktor);
196 goto endr_ende;
197 }
198 else if (S_PA_LI(a) == 2)
199 {
200 OP p1,p2;
201 p1 = find_thp_integer(S_PA_I(a,0));
202 p2 = find_thp_integer(S_PA_I(a,1));
203 erg += mpp___(p1,p2,b,faktor);
204 }
205 else if (S_PA_LI(a) == 3)
206 {
207 OP p1,p2;
208 p1 = find_thp_integer(S_PA_I(a,2));
209 M_I_I(2,S_PA_L(a));
210 p2 = CALLOCOBJECT();init_hashtable(p2);
211 thp_partition__faktor(a,p2,cons_eins);
212 erg += mpp___(p1,p2,b,faktor);
213 M_I_I(3,S_PA_L(a));
214 FREEALL(p2);
215 }
216 else {
217 erg += t_splitpart(a,b,faktor,thp_partition__faktor,mpp_hashtable_hashtable_);
218 goto endr_ende;
219 }
220
221 ENDR("thp_partition__faktor");
222 }
223
thp_homsym__faktor(a,b,f)224 INT thp_homsym__faktor(a,b,f) OP a,b,f;
225 {
226 INT erg = OK;
227 static int level=0;
228 level += 2;
229 CTO(HOMSYM,"thp_homsym__faktor(1)",a);
230 CTTO(POWSYM,HASHTABLE,"thp_homsym__faktor(2)",b);
231
232 if (S_L_S(a) == NULL) goto eee;
233 if (S_S_N(a) == NULL) {
234 OP ff;
235 ff = CALLOCOBJECT();
236 MULT(S_S_K(a),f,ff);
237 erg += thp_partition__faktor(S_S_S(a),b,ff);
238 FREEALL(ff);
239 goto eee;}
240 if (S_S_SLI(a) == 0) {
241 if (EINSP(f))
242 erg += thp_partition__faktor(S_S_S(a),b,S_S_K(a));
243 else {
244 OP ff = CALLOCOBJECT();
245 MULT(f,S_S_K(a),ff);
246 erg += thp_partition__faktor(S_S_S(a),b,ff);
247 FREEALL(ff);
248 }
249 erg += thp_homsym__faktor(S_S_N(a),b,f);
250 goto eee;
251 }
252 else {
253 OP z,zv,hi,ff;
254 INT i,j;
255 i = S_S_SII(a,0);
256 z = a;zv = NULL;
257 again:
258 if (S_S_SII(z,0) == i)
259 {
260 for (j=0;j<S_S_SLI(z)-1;j++)
261 M_I_I(S_S_SII(z,j+1),S_S_SI(z,j));
262 M_I_I(S_S_SLI(z)-1,S_S_SL(z));
263 zv = z; z = S_S_N(z);
264 if (z != NULL) goto again;
265 }
266 /* jetzt ist z der erste teil mit dem kleinsten teil partition >i */
267 /* zv ist der letzte teil mit kleinsten teil = i */
268 /* berechne : h_i * h_a + h_z */
269 C_S_N(zv,NULL);
270
271 ff = CALLOCOBJECT();
272 init_hashtable(ff);
273 hi = CALLOCOBJECT();
274 M_I_I(i,hi);
275 erg += thp_homsym__faktor(a,ff,cons_eins);
276 erg += mhp_integer_hashtable_(hi,ff,b,f);
277
278 if (z != NULL)
279 erg += thp_homsym__faktor(z,b,f);
280 FREEALL(hi);
281 FREEALL(ff);
282 /* a wieder richtig zusammen bauen */
283
284 zv = a;
285 aa:
286 for (j=S_S_SLI(zv);j>0;j--)
287 M_I_I(S_S_SII(zv,j-1),S_S_SI(zv,j));
288 M_I_I(i,S_S_SI(zv,0));
289 M_I_I(S_S_SLI(zv)+1,S_S_SL(zv));
290 if (S_S_N(zv) != NULL) { zv = S_S_N(zv); goto aa; }
291
292 C_S_N(zv,z);
293 }
294
295
296 eee:
297 level -= 2;
298 ENDR("thp_homsym__faktor");
299 }
300
thp___faktor(a,b,f)301 INT thp___faktor(a,b,f) OP a,b; OP f;
302 /* AK 190901 */
303 {
304 INT erg = OK;
305 CTTTTO(INTEGER,PARTITION,HASHTABLE,HOMSYM,"thp___faktor(1)",a);
306 CTTO(POWSYM,HASHTABLE,"thp___faktor(2)",b);
307
308 if (S_O_K(a) == INTEGER)
309 erg += thp_integer__faktor(a,b,f);
310 else if (S_O_K(a) == PARTITION)
311 erg += thp_partition__faktor(a,b,f);
312 else if (S_O_K(a) == HOMSYM)
313 erg += thp_homsym__faktor(a,b,f);
314 else /* HASHTABLE */
315 {
316 T_FORALL_MONOMIALS_IN_A(a,b,f,thp_partition__faktor);
317 }
318
319 ENDR("thp___faktor");
320 }
321
322