1 #include "def.h"
2 #include "macro.h"
3 INT tem_integer__faktor();
4 INT mes_integer_partition_();
5 INT binom_small();
6
7 static OP mip_cc=NULL;
mem_ende()8 INT mem_ende()
9 {
10 INT erg = OK;
11 if (mip_cc != NULL)
12 {
13 FREEALL(mip_cc);
14 mip_cc = NULL;
15 }
16 ENDR("mem_ende");
17 }
18
mem_integer_partition_(a,b,c,f)19 INT mem_integer_partition_(a,b,c,f) OP a,b,c; OP f;
20 /*
21 a is integer
22 b is partition
23 */
24 {
25 INT erg = OK,i,j,m,il,jl;
26 OP l,p,bn,oben,unten;
27 OP mo,zi,zj,zm,ilz;
28
29 CTO(INTEGER,"mem_integer_partition_(1)",a);
30 CTO(PARTITION,"mem_integer_partition_(2)",b);
31 CTTO(HASHTABLE,MONOMIAL,"mem_integer_partition_(3)",c);
32
33 if (mip_cc == NULL) {
34 mip_cc = CALLOCOBJECT();
35 erg += init_hashtable(mip_cc);
36 }
37
38 erg += mes_integer_partition_(a,b,mip_cc,cons_eins); /* pieri rule */
39 CTO(HASHTABLE,"mem_integer_partition_(mip-cc)",mip_cc);
40
41 bn = CALLOCOBJECT();
42 oben = CALLOCOBJECT();
43 unten = CALLOCOBJECT();
44
45
46 for (il=0,ilz=S_V_S(mip_cc);il<S_V_LI(mip_cc);il++,ilz++)
47 if (not EMPTYP(ilz))
48 {
49 for(jl=0,l=S_V_S(ilz);jl<S_V_LI(ilz);jl++,l++)
50 if (not EMPTYP(l))
51
52 /*FORALL(l,mip_cc, */{
53
54 p = S_MO_S(l);
55
56 for (zi = S_PA_I(p, S_PA_LI(p) -1),i=1,
57 zj = S_PA_I(p, S_PA_LI(p) -1),j=1; i<=S_PA_LI(p); i++,zi--)
58 {
59 if ( S_I_I(zi) == S_I_I(zj) ) continue;
60 else { /* A */
61 /* abstieg in der partition gefunden , es sind i-j gleiche teile */
62 for (m=j,zm=S_PA_I(b,S_PA_LI(b)-j); m <= S_PA_LI(b); m++,zm--)
63 if (S_I_I(zm) < S_I_I(zj)) break;
64 /* es gibt m-j teile dieser groese schon in b */
65 /* es ist zu berechnen binom(i-j, m-j) */
66 M_I_I(i-j,oben);
67 M_I_I(m-j,unten);
68 if ((i-j)<=12) {
69 erg += binom_small(oben,unten,bn);
70 MULT_APPLY_INTEGER(bn,S_MO_K(l));
71 C_O_K(bn,EMPTY);
72 }
73 else {
74 erg += binom(oben,unten,bn);
75 MULT_APPLY(bn,S_MO_K(l));
76 FREESELF(bn);
77 }
78 j = i;
79 zj = zi;
80 } /* A */
81 }
82 /* der letzte teil, fuer die einsen */
83 {
84 /* abstieg in der partition gefunden , es sind i-j gleiche teile */
85 for (m=j,zm=S_PA_I(b,S_PA_LI(b)-j); m <= S_PA_LI(b); m++,zm--)
86 if (S_I_I(zm) < S_I_I(zj)) break;
87 /* es gibt m-j teile dieser groese schon in b */
88 /* es ist zu berechnen binom(i-j, m-j) */
89 M_I_I(i-j,oben);
90 M_I_I(m-j,unten);
91 if ((i-j)<=12) {
92 erg += binom_small(oben,unten,bn);
93 MULT_APPLY_INTEGER(bn,S_MO_K(l));
94 C_O_K(bn,EMPTY);
95 }
96 else {
97 erg += binom(oben,unten,bn);
98 MULT_APPLY(bn,S_MO_K(l));
99 FREESELF(bn);
100 }
101 }
102
103 mo = CALLOCOBJECT();
104 SWAP(mo,l);
105 if (not EINSP(f))
106 MULT_APPLY(f,S_MO_K(mo));
107
108 if (S_O_K(c) == MONOMIAL)
109 INSERT_LIST(mo,c,add_koeff,comp_monommonomial);
110 else
111 {
112 C_PA_HASH(S_MO_S(mo),-1);
113 INSERT_HASHTABLE(mo,c,add_koeff,eq_monomsymfunc,hash_monompartition);
114 }
115
116 } /*); */
117 FREESELF_INTEGERVECTOR(ilz);
118 C_I_I(ilz,-1);
119 }
120 else if (S_I_I(ilz) == -1) break;
121 else { il = S_I_I(ilz)-1; ilz=S_V_I(mip_cc,il); }
122
123 M_I_I(0,S_V_I(mip_cc,S_V_LI(mip_cc)));
124 FREEALL(bn);
125 FREEALL(oben);
126 FREEALL(unten);
127 /* CLEAR_HASHTABLE(mip_cc); */
128 /*
129 for (i=0,zi = S_V_S(mip_cc);i<S_V_LI(mip_cc);i++,zi++)
130 {
131 if (not EMPTYP(zi) )
132 FREESELF_INTEGERVECTOR(zi);
133 C_I_I(zi,-1);
134 }
135 C_I_I(S_V_L(mip_cc),1009);
136 M_I_I(0,S_V_I(mip_cc,1009));
137 */
138 ENDR("mem_integer_partition");
139 }
140
mem_integer_hashtable_(a,b,c,f)141 INT mem_integer_hashtable_(a,b,c,f) OP a,b,c,f;
142 {
143 INT erg = OK;
144 CTO(INTEGER,"mem_integer_hashtable_(1)",a);
145 CTTO(HASHTABLE,MONOMIAL,"mem_integer_hashtable_(2)",b);
146 CTTO(HASHTABLE,MONOMIAL,"mem_integer_hashtable_(3)",c);
147 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mem_integer_partition_);
148 CTTO(HASHTABLE,MONOMIAL,"mem_integer_hashtable_(e3)",c);
149 ENDR("mem_integer_hashtable_");
150 }
151
mem_integer__(a,b,c,f)152 INT mem_integer__(a,b,c,f) OP a,b,c,f;
153 {
154 INT erg = OK;
155 CTO(INTEGER,"mem_integer__(1)",a);
156 CTTTO(PARTITION,HASHTABLE,MONOMIAL,"mem_integer__(2)",b);
157 CTTO(HASHTABLE,MONOMIAL,"mem_integer__(3)",c);
158
159 if (S_O_K(b) == PARTITION)
160 {
161 erg += mem_integer_partition_(a,b,c,f);
162 goto ende;
163 }
164 else
165 {
166 erg += mem_integer_hashtable_(a,b,c,f);
167 goto ende;
168 }
169 ende:
170 CTTO(HASHTABLE,MONOMIAL,"mem_integer__(e3)",c);
171 ENDR("mem_integer__");
172 }
173
mem_partition__(a,b,c,f)174 INT mem_partition__(a,b,c,f) OP a,b,c,f;
175 {
176 INT erg = OK;
177 CTO(PARTITION,"mem_partition__(1)",a);
178 CTTTO(PARTITION,HASHTABLE,MONOMIAL,"mem_partition__(2)",b);
179 CTTO(HASHTABLE,MONOMIAL,"mem_partition__(3)",c);
180
181 if (S_PA_LI(a) == 0)
182 {
183 if (S_O_K(b) == PARTITION) {
184 _NULL_PARTITION_(b,c,f);
185 }
186 else {
187 OP m;
188 m = CALLOCOBJECT();
189 COPY(b,m);
190 if (not EINSP(f))
191 {
192 MULT_APPLY(f,m);
193 }
194 if (S_O_K(c) == MONOMIAL)
195 INSERT_LIST(m,c,add_koeff,comp_monommonomial);
196 else
197 INSERT_HASHTABLE(m,c,add_koeff,eq_monomsymfunc,hash_monompartition);
198 }
199 goto ende;
200 }
201
202 else if (S_PA_LI(a) == 1)
203 {
204 erg += mem_integer__(S_PA_I(a,0),b,c,f);
205 goto ende;
206 }
207 else {
208 INT i; OP d,e;
209
210 d=CALLOCOBJECT();
211 e=CALLOCOBJECT();
212
213 erg += init_hashtable(e);
214 erg += tem_integer__faktor(S_PA_I(a,0),e,f);
215 for (i=1;i<S_PA_LI(a);i++)
216 {
217 FREESELF(d);
218 erg += init_hashtable(d);
219 SWAP(d,e);
220 erg += mem_integer__(S_PA_I(a,i),d,e,cons_eins);
221 }
222 FREEALL(d);
223
224 mult_monomial_monomial(e,b,c);
225 FREEALL(e);
226
227 }
228 ende:
229 ENDR("mem_partition__");
230 }
231
mem_elmsym__(a,b,c,f)232 INT mem_elmsym__(a,b,c,f) OP a,b,c,f;
233 {
234 INT erg = OK;
235 CTTO(ELMSYM,HASHTABLE,"mem_elmsym__(1)",a);
236 CTTTO(PARTITION,HASHTABLE,MONOMIAL,"mem_elmsym__(2)",b);
237 CTTO(HASHTABLE,MONOMIAL,"mem_elmsym__(3)",c);
238 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mem_partition__);
239 ENDR("mem_elmsym__");
240 }
241
242
243
244
mult_elmsym_monomial(a,b,c)245 INT mult_elmsym_monomial(a,b,c) OP a,b,c;
246 /* a is elementary,partition,integer
247 b is monomial,partition
248 */
249 /* AK 270901 */
250 {
251 INT erg = OK;
252 INT t=0;
253 CTTTTO(HASHTABLE,INTEGER,PARTITION,ELMSYM,"mult_elmsym_monomial",a);
254 CTTTO(HASHTABLE,PARTITION,MONOMIAL,"mult_elmsym_monomial",b);
255
256 if ((S_O_K(c) != HASHTABLE) && (S_O_K(c) != MONOMIAL) )
257 {
258 CE3(a,b,c,mult_elmsym_monomial);
259 }
260
261 if (S_O_K(c) == EMPTY)
262 {
263 erg += init_hashtable(c);
264 t=1;
265 }
266 CTTO(MONOMIAL,HASHTABLE,"mult_elmsym_monomial(3)",c);
267
268 if (S_O_K(a) == INTEGER)
269 erg += mem_integer__(a,b,c,cons_eins);
270 else if (S_O_K(a) == PARTITION)
271 erg += mem_partition__(a,b,c,cons_eins);
272 else
273 erg += mem_elmsym__(a,b,c,cons_eins);
274
275 if (t==1)
276 erg += t_HASHTABLE_MONOMIAL(c,c);
277 ENDR("mult_elmsym_monomial");
278 }
279
280