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