1 #include "def.h"
2 #include "macro.h"
3 
4 INT tsp_schur__faktor();
5 INT thp_integer__faktor();
6 INT tep_integer__faktor();
7 INT mhp_integer__();
8 INT mhp_integer_hashtable_();
9 INT mhs_integer__();
tsp_integer__faktor(a,b,f)10 INT tsp_integer__faktor(a,b,f) OP a,b,f;
11 {
12     INT erg = OK;
13     CTO(INTEGER,"tsp_integer__faktor(1)",a);
14     CTTO(HASHTABLE,POWSYM,"tsp_integer__faktor(2)",b);
15     SYMCHECK((S_I_I(a) < 0), "tsp_integer__faktor:parameter <0");
16     erg += thp_integer__faktor(a,b,f);
17     ENDR("tsp_integer__faktor");
18 }
19 
tsp_partition__faktor(a,b,f)20 INT tsp_partition__faktor(a,b,f) OP a,b,f;
21 {
22     INT erg = OK;
23     CTO(PARTITION,"tsp_partition__faktor(1)",a);
24     CTTO(HASHTABLE,POWSYM,"tsp_partition__faktor(2)",b);
25     CTO(ANYTYPE,"tsp_partition__faktor(3)",f);
26     if (S_PA_LI(a) == 0)
27         {
28         erg += thp_integer__faktor(cons_null,b,f);
29         goto ende;
30         }
31     else if (S_PA_LI(a) == 1)
32         {
33         erg += thp_integer__faktor(S_PA_I(a,0),b,f);
34         goto ende;
35         }
36     else {
37         OP m;
38         m = CALLOCOBJECT();
39         erg += m_pa_s(a,m);
40         erg += tsp_schur__faktor(m,b,f);
41         FREEALL(m);
42         goto ende;
43         }
44 ende:
45     CTTO(HASHTABLE,POWSYM,"tsp_partition__faktor(e2)",b);
46     ENDR("tsp_partition__faktor");
47 }
48 
tsp___faktor(a,b,f)49 INT tsp___faktor(a,b,f) OP a,b,f;
50 {
51     INT erg = OK;
52     CTTTTO(HASHTABLE,SCHUR,PARTITION,INTEGER,"tsp___faktor(1)",a);
53     CTTO(HASHTABLE,POWSYM,"tsp___faktor(2)",b);
54     CTO(ANYTYPE,"tsp___faktor(3)",f);
55 
56 
57     if (S_O_K(a) == INTEGER)
58        {
59        erg += tsp_integer__faktor(a,b,f);
60        goto ende;
61        }
62     else if (S_O_K(a) == PARTITION)
63        {
64        erg += tsp_partition__faktor(a,b,f);
65        goto ende;
66        }
67     else
68        {
69        erg += tsp_schur__faktor(a,b,f);
70        goto ende;
71        }
72 ende:
73     CTTO(HASHTABLE,POWSYM,"tsp___faktor(e2)",b);
74     ENDR("tsp___faktor");
75 }
76 
tsp_schur__faktor(a,b,f)77 INT tsp_schur__faktor(a,b,f) OP a,b,f;
78 {
79     INT erg = OK;
80     OP z,ha,ohne_i,h_ohne_i,p_i;
81     INT i;
82     OP h_i;
83 
84     CTTO(HASHTABLE,SCHUR,"tsp_schur__faktor(1)",a);
85     CTTO(HASHTABLE,POWSYM,"tsp_schur__faktor(2)",b);
86     CTO(ANYTYPE,"tsp_schur__faktor(3)",f);
87 
88     if (NULLP(a)) { goto ende; }
89 
90     if (S_O_K(a) == SCHUR)
91         {
92         if (S_L_N(a) == NULL) {
93             if (S_PA_LI(S_S_S(a)) == 0) {
94                 OP w;
95                 w = CALLOCOBJECT();
96                 MULT(f,S_S_K(a),w);
97                 erg += thp_integer__faktor(cons_null,b,w);
98                 FREEALL(w);
99                 goto ende;
100                 }
101             if (S_PA_LI(S_S_S(a)) == 1) {
102                 OP w;
103                 w = CALLOCOBJECT();
104                 MULT(f,S_S_K(a),w);
105                 erg += thp_integer__faktor(S_S_SI(a,0),b,w);
106                 FREEALL(w);
107                 goto ende;
108                 }
109             if (S_PA_II(S_S_S(a), S_PA_LI(S_S_S(a))-1) == 1) /* elmsym */
110                 {
111                 OP w;
112                 w = CALLOCOBJECT();
113                 MULT(f,S_S_K(a),w);
114                 erg += tep_integer__faktor(S_PA_L(S_S_S(a)),b,w);
115                 FREEALL(w);
116                 goto ende;
117                 }
118             }
119         }
120     else /* HASHTABLE */
121         {
122         if (S_V_II(a,S_V_LI(a)) == 1) {
123             OP z=NULL;
124             FORALL(z,a, { goto eee; } );
125             eee:
126             if (S_PA_LI(S_MO_S(z)) == 0) {
127                 OP w;
128                 w = CALLOCOBJECT();
129                 MULT(f,S_MO_K(z),w);
130                 erg += thp_integer__faktor(cons_null,b,w);
131                 FREEALL(w);
132                 goto ende;
133                 }
134             if (S_PA_LI(S_MO_S(z)) == 1) {
135                 OP w;
136                 w = CALLOCOBJECT();
137                 MULT(f,S_MO_K(z),w);
138                 erg += thp_integer__faktor(S_PA_I(S_MO_S(z),0),b,w);
139                 FREEALL(w);
140                 goto ende;
141                 }
142             if (S_PA_II(S_MO_S(z), S_PA_LI(S_MO_S(z))-1) == 1) /* elmsym */
143                 {
144                 OP w;
145                 w = CALLOCOBJECT();
146                 MULT(f,S_MO_K(z),w);
147                 erg += tep_integer__faktor(S_PA_L(S_MO_S(z)),b,w);
148                 FREEALL(w);
149                 goto ende;
150                 }
151             }
152         }
153 
154 /* such die partition mit dem kuerzesten maximalen teil */
155     z = findmin_schur(a,maxpart_comp_part);
156     if (S_PA_LI(S_MO_S(z)) == 0)
157         i = 0;
158     else
159         i = S_PA_II(S_MO_S(z),S_PA_LI(S_MO_S(z))-1);
160 
161     ha = CALLOCOBJECT();
162     if (S_O_K(a) == HASHTABLE)
163         COPY(a,ha);
164     else
165         t_SCHUR_HASHTABLE(a,ha);
166 
167     CTO(HASHTABLE,"tsp_schur__faktor(i1)",ha);
168     if (i==0) /* s[0] in ha */
169         {
170         OP m;
171         FORALL(z,ha, { if (S_PA_LI(S_MO_S(z)) == 0) goto jjj; } );
172         jjj:
173         m = CALLOCOBJECT();
174         b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(), m);
175         MULT(f,S_MO_K(z),S_MO_K(m));
176         COPY(S_MO_S(z),S_MO_S(m));
177         FREESELF(z);
178         DEC_INTEGER(S_V_I(ha,S_V_LI(ha))); /* counter-- */
179         i = 1;
180         INSERT_POWSYMMONOM_(m,b);
181         }
182 
183     NEW_HASHTABLE(ohne_i);
184     NEW_HASHTABLE(h_ohne_i);
185     NEW_HASHTABLE(p_i);
186     h_i = CALLOCOBJECT();
187 
188 
189     while (i>0) {
190         OP v,p,m;
191         INT k;
192         if (NULLP(ha)) break;
193 
194         FORALL(z,ha, {
195              if (S_PA_II(S_MO_S(z),S_PA_LI(S_MO_S(z))-1) == i) /* kommt nach ohne_i */
196                  {
197                  v = CALLOCOBJECT();
198                  erg +=m_il_v(S_PA_LI(S_MO_S(z))-1,v);
199                  for (k=0;k<S_V_LI(v);k++)
200                      M_I_I(S_PA_II(S_MO_S(z),k),S_V_I(v,k));
201                  p = CALLOCOBJECT();
202                  erg +=b_ks_pa(VECTOR,v,p);
203                  m = CALLOCOBJECT();
204                  erg +=b_sk_mo(p,CALLOCOBJECT(),m);
205                  COPY(S_MO_K(z),S_MO_K(m));
206                  INSERT_HASHTABLE(m,ohne_i,add_koeff,eq_monomsymfunc,hash_monompartition);
207                  }
208              });
209         /* falls ohne_i leer zum naechsten i */
210 
211         if (NULLP(ohne_i)) { i++; continue; }
212 
213         erg += tsp_schur__faktor(ohne_i,h_ohne_i,f);
214 
215         M_I_I(i,h_i);
216         erg += mhp_integer_hashtable_(h_i,h_ohne_i,b,cons_eins);
217         /* b = b + p_i * h_ohne_i */
218 
219         CLEAR_HASHTABLE(p_i);
220         CLEAR_HASHTABLE(h_ohne_i);
221         mhs_integer__(h_i,ohne_i,ha,cons_negeins);
222         CLEAR_HASHTABLE(ohne_i);
223         i++;
224         }
225     FREEALL(ha);
226     FREEALL(ohne_i);
227     FREEALL(h_ohne_i);
228     FREEALL(p_i);
229     FREEALL(h_i);
230 ende:
231     CTTO(HASHTABLE,POWSYM,"tsp_schur__faktor(e2)",b);
232     ENDR("tsp_schur__faktor");
233 }
234 
t_SCHUR_POWSYM(a,b)235 INT t_SCHUR_POWSYM(a,b) OP a,b;
236 /* AK 191001 */
237 /* rekursion s_i1,i2,..,in = s_in \times s_i1,...,in-1 - ...... */
238 {
239     INT erg = OK;
240     INT t=0;
241     CTTTTO(HASHTABLE,SCHUR,PARTITION,INTEGER,"t_SCHUR_POWSYM(1)",a);
242     TCE2(a,b,t_SCHUR_POWSYM,POWSYM);
243 
244     if (S_O_K(b) == EMPTY) {
245         t=1;
246         init_hashtable(b);
247         }
248 
249     CTTO(HASHTABLE,POWSYM,"t_SCHUR_POWSYM(2)",b);
250     tsp___faktor(a,b,cons_eins);
251     if (t==1) t_HASHTABLE_POWSYM(b,b);
252     CTTO(HASHTABLE,POWSYM,"t_SCHUR_POWSYM(2)",b);
253     ENDR("t_SCHUR_POWSYM");
254 }
255