1 #include "def.h"
2 #include "macro.h"
3
4 INT thm_integer__faktor();
5 INT mem_integer_hashtable_();
6 INT mes_integer_hashtable_();
7
t_SCHUR_MONOMIAL_pre211101(a,b)8 INT t_SCHUR_MONOMIAL_pre211101(a,b) OP a,b;
9 /* AK 190901 */
10 /* fastest up to now */
11 /* with kostka number */
12 {
13 INT erg = OK;
14 CTTO(SCHUR,PARTITION,"t_SCHUR_MONOMIAL(1)",a);
15 CE2(a,b,t_SCHUR_MONOMIAL_pre211101);
16 if (S_O_K(a) == PARTITION)
17 {
18 /* definition mittels kostkanumber */
19 OP c;
20 if (S_PA_LI(a) == 0) {
21 erg += b_skn_mon(callocobject(),callocobject(),NULL,b);
22 M_I_I(1,S_S_K(b));
23 erg += first_partition(cons_null,S_S_S(b));
24 goto endr_ende;
25 }
26 else if (S_PA_LI(a) == 1) {
27 erg += t_HOMSYM_MONOMIAL(S_PA_I(a,0),b);
28 goto endr_ende;
29 }
30 c = callocobject();
31 erg += copy_partition(a,c);
32 erg += init(MONOMIAL,b);
33 do {
34 OP m;
35 m = callocobject();
36 erg += m_pa_mon(c,m);
37 erg += kostka_number(c,a,S_S_K(m));
38 if (not NULLP(S_S_K(m)))
39 INSERT_LIST(m,b,NULL,comp_monommonomial);
40 else
41 erg += freeall(m);
42 } while (next_apply(c));
43 erg += freeall(c);
44 goto endr_ende;
45 }
46 else if (S_O_K(a) == SCHUR)
47 {
48 OP z,res;
49 erg += init(MONOMIAL,b);
50 FORALL(z,a, {
51 res=callocobject();
52 erg += t_SCHUR_MONOMIAL_pre211101(S_MO_S(z),res);
53 MULT_APPLY(S_MO_K(z),res);
54 INSERT_LIST(res,b,add_koeff,comp_monommonomial);
55 } );
56 }
57 ENDR("t_SCHUR_MONOMIAL_pre211101");
58 }
59
60
61 INT tsm_schur__faktor();
tsm_integer__faktor(a,b,f)62 INT tsm_integer__faktor(a,b,f) OP a,b,f;
63 {
64 INT erg = OK;
65 CTO(INTEGER,"tsm_integer__faktor(1)",a);
66 CTTO(HASHTABLE,MONOMIAL,"tsm_integer__faktor(2)",b);
67 SYMCHECK((S_I_I(a) < 0), "tsm_integer__faktor:parameter <0");
68 erg += thm_integer__faktor(a,b,f);
69 ENDR("tsm_integer__faktor");
70 }
71
tsm_partition__faktor(a,b,f)72 INT tsm_partition__faktor(a,b,f) OP a,b,f;
73 {
74 INT erg = OK;
75 CTO(PARTITION,"tsm_partition__faktor(1)",a);
76 CTTO(HASHTABLE,MONOMIAL,"tsm_partition__faktor(2)",b);
77 if (S_PA_LI(a) == 0)
78 {
79 erg += thm_integer__faktor(cons_null,b,f);
80 goto ende;
81 }
82 else if (S_PA_LI(a) == 1)
83 {
84 erg += thm_integer__faktor(S_PA_I(a,0),b,f);
85 goto ende;
86 }
87 #ifdef UNDEF
88 /* ist langsamer */
89 else if (S_PA_LI(a) == 2)
90 { /* determinanten formel */
91 OP h1,h2;
92 OP m;
93 OP find_thm_integer();
94
95 h1 = find_thm_integer(S_PA_I(a,0));
96 h2 = find_thm_integer(S_PA_I(a,1));
97
98 mmm___(h1,h2,b,f);
99
100 DEC_INTEGER(S_PA_I(a,0));
101 INC_INTEGER(S_PA_I(a,1));
102 h1 = find_thm_integer(S_PA_I(a,0));
103 h2 = find_thm_integer(S_PA_I(a,1));
104 m = CALLOCOBJECT();
105 ADDINVERS(f,m);
106 mmm___(h1,h2,b,m);
107 FREEALL(m);
108 INC_INTEGER(S_PA_I(a,0));
109 DEC_INTEGER(S_PA_I(a,1));
110
111 /* erg += thm_integer__faktor(S_PA_I(a,0),b,f); */
112 goto ende;
113 }
114 #endif
115 else {
116 OP m;
117 m = CALLOCOBJECT();
118 erg += m_pa_s(a,m);
119 erg += tsm_schur__faktor(m,b,f);
120 FREEALL(m);
121 goto ende;
122 }
123 ende:
124 ENDR("tsm_partition__faktor");
125 }
126
tsm___faktor(a,b,f)127 INT tsm___faktor(a,b,f) OP a,b,f;
128 {
129 INT erg = OK;
130 CTTTTO(HASHTABLE,SCHUR,PARTITION,INTEGER,"tsm___faktor(1)",a);
131 CTTO(HASHTABLE,MONOMIAL,"tsm___faktor(2)",b);
132
133
134 if (S_O_K(a) == INTEGER)
135 {
136 erg += tsm_integer__faktor(a,b,f);
137 goto ende;
138 }
139 else if (S_O_K(a) == PARTITION)
140 {
141 erg += tsm_partition__faktor(a,b,f);
142 goto ende;
143 }
144 else
145 {
146 erg += tsm_schur__faktor(a,b,f);
147 goto ende;
148 }
149 ende:
150 CTTO(HASHTABLE,MONOMIAL,"tsm___faktor(e2)",b);
151 ENDR("tsm___faktor");
152 }
153
tsm_schur__faktor(a,b,f)154 INT tsm_schur__faktor(a,b,f) OP a,b,f;
155 /* AK 260503: changed error in computation of factor in the trival cases at the beginning */
156 {
157 INT erg = OK;
158 OP z,ha,ohne_i,h_ohne_i;
159 INT i;
160 OP h_i;
161
162 CTTO(HASHTABLE,SCHUR,"tsm_schur__faktor(1)",a);
163 CTTO(HASHTABLE,MONOMIAL,"tsm_schur__faktor(2)",b);
164 CTO(ANYTYPE,"tsm_schur__faktor(3)",f);
165
166 if (NULLP(a)) { goto endr_ende; }
167
168 if (S_O_K(a) == SCHUR)
169 {
170 if (S_L_N(a) == NULL) {
171 if (S_PA_LI(S_S_S(a)) == 0) {
172 z=CALLOCOBJECT();
173 MULT(f,S_S_K(a),z);
174 erg += thm_integer__faktor(cons_null,b,S_S_K(a));
175 FREEALL(z);
176 goto ende;
177 }
178 if (S_PA_LI(S_S_S(a)) == 1) {
179 z=CALLOCOBJECT();
180 MULT(f,S_S_K(a),z);
181 erg += thm_integer__faktor(S_S_SI(a,0),b,z);
182 FREEALL(z);
183 goto ende;
184 }
185 }
186 }
187 else /* HASHTABLE */
188 {
189 if (S_V_II(a,S_V_LI(a)) == 1) {
190 OP z=NULL;
191 FORALL(z,a, { goto eee; } );
192 eee:
193 if (S_PA_LI(S_MO_S(z)) == 0) {
194 ha = CALLOCOBJECT();
195 MULT(f,S_MO_K(z),ha);
196 erg += thm_integer__faktor(cons_null,b,ha);
197 FREEALL(ha);
198 goto ende;
199 }
200 if (S_PA_LI(S_MO_S(z)) == 1) {
201 ha = CALLOCOBJECT();
202 MULT(f,S_MO_K(z),ha);
203 erg += thm_integer__faktor(S_PA_I(S_MO_S(z),0),b,ha);
204 FREEALL(ha);
205 goto ende;
206 }
207 }
208 }
209
210 /* such die partition mit den wenigsten teilen */
211 z = findmin_schur(a,length_comp_part);
212 i = S_PA_LI(S_MO_S(z));
213 ha = CALLOCOBJECT();
214
215 COPY(a,ha);
216
217 NEW_HASHTABLE(ohne_i);
218 NEW_HASHTABLE(h_ohne_i);
219 h_i = CALLOCOBJECT();
220
221
222 while (i>=0) {
223 OP v,p,m;
224 INT k,j;
225 if (NULLP(ha)) break;
226
227 FORALL(z,ha, {
228 if (S_PA_LI(S_MO_S(z)) == i) /* kommt nach ohne_i */
229 {
230 v = CALLOCOBJECT();
231 for (j=0;j<S_PA_LI(S_MO_S(z));j++)
232 if (S_PA_II(S_MO_S(z),j) > 1) break;
233 erg +=m_il_v(S_PA_LI(S_MO_S(z))-j,v);
234 for (k=0;k<S_V_LI(v);k++)
235 M_I_I(S_PA_II(S_MO_S(z),k+j)-1,S_V_I(v,k));
236 p = CALLOCOBJECT();
237 erg +=b_ks_pa(VECTOR,v,p);
238 m = CALLOCOBJECT();
239 erg +=b_sk_mo(p,CALLOCOBJECT(),m);
240 COPY(S_MO_K(z),S_MO_K(m));
241 INSERT_HASHTABLE(m,ohne_i,add_koeff,eq_monomsymfunc,hash_monompartition);
242 }
243 });
244 /* falls ohne_i leer zum naechsten i */
245
246 if (NULLP(ohne_i)) { i++; continue; }
247
248 erg += tsm_schur__faktor(ohne_i,h_ohne_i,f);
249
250 M_I_I(i,h_i);
251
252
253 erg += mem_integer_hashtable_(h_i,h_ohne_i,b,cons_eins);
254 /* b = b + e_i * h_ohne_i */
255
256
257 CLEAR_HASHTABLE(h_ohne_i);
258
259 erg += mes_integer_hashtable_(h_i,ohne_i,ha,cons_negeins);
260
261 CLEAR_HASHTABLE(ohne_i);
262 i++;
263 }
264 FREEALL(ha);
265 FREEALL(ohne_i);
266 FREEALL(h_ohne_i);
267 FREEALL(h_i);
268 ende:
269 ENDR("tsm_faktor");
270 }
271
t_SCHUR_MONOMIAL(a,b)272 INT t_SCHUR_MONOMIAL(a,b) OP a,b;
273 /* AK 191001 */
274 /* rekursion s_i1,i2,..,in = s_in \times s_i1,...,in-1 - ...... */
275 {
276 INT erg = OK;
277 INT t=0;
278 CTTTTO(HASHTABLE,SCHUR,PARTITION,INTEGER,"t_SCHUR_MONOMIAL(1)",a);
279 TCE2(a,b,t_SCHUR_MONOMIAL,MONOMIAL);
280
281 if (S_O_K(b) == EMPTY) {
282 t=1;
283 init_hashtable(b);
284 }
285
286 CTTO(HASHTABLE,MONOMIAL,"t_SCHUR_MONOMIAL(2)",b);
287 tsm___faktor(a,b,cons_eins);
288 if (t==1) t_HASHTABLE_MONOMIAL(b,b);
289 CTTO(HASHTABLE,MONOMIAL,"t_SCHUR_MONOMIAL(e2)",b);
290 ENDR("t_SCHUR_MONOMIAL");
291 }
292