1
2 #include "def.h"
3 #include "macro.h"
4
5
plet_homsym_monomial(a,b,c)6 INT plet_homsym_monomial(a,b,c) OP a,b,c;
7 /* AK 051201 */
8 {
9 INT erg = OK;
10 #ifdef PLETTRUE
11 INT t=0; /* is 1 if transfer HASHTABLE->MONOMIAL necessary */
12 CTTTTO(HASHTABLE,INTEGER,PARTITION,HOMSYM,"plet_homsym_monomial(1)",a);
13 CTTTTO(HASHTABLE,PARTITION,MONOMIAL,INTEGER,"plet_homsym_monomial(2)",b);
14 CTTTO(EMPTY,HASHTABLE,MONOMIAL,"plet_homsym_monomial(3)",c);
15
16 if (S_O_K(c) == EMPTY)
17 if (S_O_K(a) == INTEGER) init_monomial(c);
18 else { t=1; init_hashtable(c); }
19
20 phm___(a,b,c,cons_eins);
21 if (t==1) t_HASHTABLE_MONOMIAL(c,c);
22 #endif
23 ENDR("plet_homsym_monomial");
24 }
phm_ende()25 INT phm_ende()
26 {
27 INT erg = OK;
28 return erg;
29 }
30
31 #ifdef PLETTRUE
32 INT phm_integer_partition_();
33 INT phm_integer_hashtable_();
34 INT phm_integer_integer_();
35 INT phm___();
phm_null__(b,c,f)36 INT phm_null__(b,c,f) OP b,c,f;
37 {
38 INT mxx_null__();
39 return mxx_null__(b,c,f);
40 }
41
phm_integer__(a,b,c,f)42 INT phm_integer__(a,b,c,f) OP a,b,c; OP f;
43 /* AK 051201 */
44 {
45 INT erg = OK;
46
47 CTO(INTEGER,"phm_integer__(1)",a);
48 CTTTTO(INTEGER,HASHTABLE,PARTITION,MONOMIAL,"phm_integer__(2)",b);
49 CTTO(HASHTABLE,MONOMIAL,"phm_integer__(3)",c);
50 SYMCHECK((S_I_I(a) < 0),"phm_integer__:integer < 0");
51 if (S_I_I(a) == 0)
52 erg += phm_null__(b,c,f);
53
54
55 if (S_O_K(b) == PARTITION)
56 erg += phm_integer_partition_(a,b,c,f);
57 else if (S_O_K(b) == INTEGER)
58 erg += phm_integer_integer_(a,b,c,f);
59 else
60 M_FORALL_MONOMIALS_IN_B(a,b,c,f,phm_integer_partition_);
61
62
63 ENDR("phm_integer__");
64 }
65
66 INT phm_null_partition_();
67
phm_partition__(a,b,c,f)68 INT phm_partition__(a,b,c,f) OP a,b,c; OP f;
69 {
70 INT erg = OK;
71 CTO(PARTITION,"phm_partition__(1)",a);
72 CTTTO(HASHTABLE,MONOMIAL,PARTITION,"phm_partition__(2)",b);
73 CTTO(HASHTABLE,MONOMIAL,"phm_partition__(3)",c);
74
75 if (S_PA_LI(a) == 0) {
76 erg += phm_null__(b,c,f);
77 }
78 else if (S_PA_LI(a) == 1) {
79 erg += phm_integer__(S_PA_I(a,0),b,c,f);
80 }
81 else{
82 INT mmm_hashtable_hashtable_();
83 INT p_splitpart();
84 erg += p_splitpart(a,b,c,f,phm_partition__,
85 mmm_hashtable_hashtable_);
86 }
87
88 ENDR("phm_partition__");
89 }
90
91
92
phm_homsym__(a,b,c,f)93 INT phm_homsym__(a,b,c,f) OP a,b,c,f;
94 /* AK 051201 */
95 /* c += p_a [p_b] \times f */
96 {
97 INT erg = OK;
98 CTO(HOMSYM,"phm_homsym__(1)",a);
99 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"phm_homsym__(2)",b);
100 CTTO(HASHTABLE,MONOMIAL,"phm_homsym__(3)",c);
101 M_FORALL_MONOMIALS_IN_A(a,b,c,f,phm_partition__);
102 ENDR("phm_homsym__");
103 }
104
phm_hashtable__(a,b,c,f)105 INT phm_hashtable__(a,b,c,f) OP a,b,c,f;
106 /* AK 051201 */
107 /* c += p_a [p_b] \times f */
108 {
109 INT erg = OK;
110 CTO(HASHTABLE,"phm_hashtable__(1)",a);
111 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"phm_hashtable__(2)",b);
112 CTTO(HASHTABLE,MONOMIAL,"phm_hashtable__(3)",c);
113 M_FORALL_MONOMIALS_IN_A(a,b,c,f,phm_partition__);
114 ENDR("phm_hashtable__");
115 }
116
phm_hashtable_hashtable_(a,b,c,f)117 INT phm_hashtable_hashtable_(a,b,c,f) OP a,b,c,f;
118 /* AK 051201 */
119 /* c += p_a [p_b] \times f */
120 {
121 INT erg = OK;
122 CTO(HASHTABLE,"phm_hashtable_hashtable_(1)",a);
123 CTO(HASHTABLE,"phm_hashtable_hashtable_(2)",b);
124 CTTO(HASHTABLE,MONOMIAL,"phm_hashtable_hashtable_(3)",c);
125 NYI("phm_hashtable_hashtable_");
126 ENDR("phm_hashtable_hashtable_");
127 }
128
phm_null_partition_(b,c,f)129 INT phm_null_partition_(b,c,f) OP b,c,f;
130 /* AK 061201 */
131 {
132 INT erg = OK;
133 CTO(PARTITION,"phm_null_partition(1)",b);
134 CTTO(MONOMIAL,HASHTABLE,"phm_null_partition(2)",c);
135 _NULL_PARTITION_(b,c,f);
136 ENDR("phm_null_partition");
137 }
138
phm_integer_integer_(a,b,c,f)139 INT phm_integer_integer_(a,b,c,f) OP a,b,c,f;
140 /* AK 051201 */
141 {
142 INT erg = OK;
143
144 CTO(INTEGER,"phm_integer_integer_(1)",a);
145 CTO(INTEGER,"phm_integer_integer_(2)",b);
146 CTTO(MONOMIAL,HASHTABLE,"phm_integer_integer_(3)",c);
147 SYMCHECK ((S_I_I(a) < 0),"phm_integer_integer_:integer(1)<0");
148 SYMCHECK ((S_I_I(b) < 0),"phm_integer_integer_:integer(2)<0");
149
150 if (S_I_I(a) == 0) {
151 erg += phm_null__(b,c,f);
152 goto ende;
153 }
154 else {
155 OP z,m = CALLOCOBJECT();
156 INT i;
157 INT thm_integer__faktor();
158
159 init_hashtable(m);
160 thm_integer__faktor(a,m,f);
161 FORALL(z,m,{
162 OP mm;
163 for (i=0;i<S_PA_LI(S_MO_S(z));i++)
164 M_I_I((S_I_I(b) * S_PA_II(S_MO_S(z),i)), S_PA_I(S_MO_S(z),i));
165 mm=CALLOCOBJECT();
166 SWAP(z,mm);
167 if (S_O_K(c) == HASHTABLE)
168 {
169 C_PA_HASH(S_MO_S(mm),-1);
170 insert_hashtable(mm,c,add_koeff,eq_monomsymfunc,hash_monompartition);
171 }
172 else
173 insert_list(mm,c,add_koeff,comp_monommonomial);
174 });
175
176 FREEALL(m);
177 goto ende;
178 }
179
180
181 ende:
182 CTTO(MONOMIAL,HASHTABLE,"phm_integer_integer_(3-ende)",c);
183 ENDR("phm_integer_integer_");
184 }
185
phm_integer_partition_(a,b,c,f)186 INT phm_integer_partition_(a,b,c,f) OP a,b,c,f;
187 /* AK 051201 */
188 {
189 INT erg = OK;
190
191 CTO(INTEGER,"phm_integer_partition_(1)",a);
192 CTO(PARTITION,"phm_integer_partition_(2)",b);
193 CTTO(MONOMIAL,HASHTABLE,"phm_integer_partition_(3)",c);
194 SYMCHECK ((S_I_I(a) < 0),"phm_integer_partition_:integer<0");
195
196 if (S_I_I(a) == 0) {
197 erg += phm_null__(b,c,f);
198 goto ende;
199 }
200 else if (S_PA_LI(b) == 0) {
201 erg += phm_null__(b,c,f);
202 goto ende;
203 }
204 else if (S_PA_LI(b) == 1) {
205 erg += phm_integer_integer_(a,S_PA_I(b,0),c,f);
206 goto ende;
207 }
208 else {
209 INT ak_plet_phm_integer_partition_();
210 ak_plet_phm_integer_partition_(a,b,c,f);
211 goto ende;
212 }
213
214
215
216 ende:
217 CTTO(MONOMIAL,HASHTABLE,"phm_integer_partition_(3-ende)",c);
218 ENDR("phm_integer_partition_");
219 }
220
phm_integer_hashtable_(a,b,c,f)221 INT phm_integer_hashtable_(a,b,c,f) OP a,b,c,f;
222 /* AK 061101 */
223 {
224 INT erg = OK;
225 CTO(INTEGER,"phm_integer_hashtable_(1)",a);
226 CTTO(HASHTABLE,MONOMIAL,"phm_integer_hashtable_(2)",b);
227 CTTO(MONOMIAL,HASHTABLE,"integer_hashtable_(3)",c);
228
229 M_FORALL_MONOMIALS_IN_B(a,b,c,f,phm_integer_partition_);
230
231 ENDR("phm_integer_hashtable_");
232 }
233
234
235
236
phm___(a,b,c,f)237 INT phm___(a,b,c,f) OP a,b,c,f;
238 {
239 INT erg = OK;
240 CTTTTO(HASHTABLE,INTEGER,PARTITION,HOMSYM,"phm___(1)",a);
241 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"phm___(2)",b);
242 CTTO(HASHTABLE,MONOMIAL,"phm___(3)",c);
243 if (S_O_K(a) == INTEGER)
244 {
245 erg += phm_integer__(a,b,c,f);
246 }
247 else if (S_O_K(a) == PARTITION)
248 {
249 erg += phm_partition__(a,b,c,f);
250 }
251 else if (S_O_K(a) == HOMSYM)
252 {
253 erg += phm_homsym__(a,b,c,f);
254 }
255 else /* if (S_O_K(a) == HASHTABLE) */
256 {
257 erg += phm_hashtable__(a,b,c,f);
258 }
259
260 ENDR("phm___");
261 }
262
263
264 INT thp___faktor();
265 INT ppm___();
266
plet_homsym_monomial_via_ppm(a,b,c)267 INT plet_homsym_monomial_via_ppm(a,b,c) OP a,b,c;
268 /* AK 111201
269 */
270 {
271 INT t=0,erg = OK;
272 CTTTTO(HASHTABLE,INTEGER,PARTITION,HOMSYM,"plet_homsym_monomial(1)",a);
273 CTTTTO(INTEGER,HASHTABLE,PARTITION,MONOMIAL,"plet_homsym_monomial(2)",b);
274 CTTTO(EMPTY,HASHTABLE,MONOMIAL,"plet_homsym_monomial(3)",c);
275
276 if (S_O_K(c) == EMPTY)
277 { t=1; init_hashtable(c); }
278
279 {
280 /* via phm with change of basis */
281 OP f = CALLOCOBJECT();
282 erg += init_hashtable(f);
283 erg += thp___faktor(a,f,cons_eins);
284 erg += ppm___(f,b,c,cons_eins);
285 FREEALL(f);
286 }
287
288 if (t==1) t_HASHTABLE_MONOMIAL(c,c);
289 ENDR("plet_homsym_monomial");
290 }
291
292 #endif /* PLETTRUE */
293