1 #include "def.h"
2 #include "macro.h"
3 
4 
5 
6 INT mxx_null__();
7 INT mps_integer_partition_();
8 INT cc_muir_mms_partition_partition_();
9 
mms_null__(b,c,f)10 INT mms_null__(b,c,f) OP b,c,f;
11 /* c = c +  s_b * f */
12 {
13     INT erg = OK;
14     CTTTTO(INTEGER,HASHTABLE,PARTITION,SCHUR,"mms_null__(1)",b);
15     CTTO(SCHUR,HASHTABLE,"mms_null__(2)",c);
16     erg += mxx_null__(b,c,f);
17     ENDR("mms_null");
18 }
19 
mms_integer_partition_(a,b,c,f)20 INT mms_integer_partition_(a,b,c,f) OP a,b,c,f;
21 /* AK 071201 */
22 {
23     INT erg = OK;
24     CTO(INTEGER,"mms_integer_partition_(1)",a);
25     CTO(PARTITION,"mms_integer_partition_(2)",b);
26     CTTO(SCHUR,HASHTABLE,"mms_integer_partition_(3)",c);
27     erg += mps_integer_partition_(a,b,c,f);
28     ENDR("mms_integer_partition_");
29 }
30 
mms_integer__(a,b,c,f)31 INT mms_integer__(a,b,c,f) OP a,b,c,f;
32 {
33     INT erg = OK;
34     CTO(INTEGER,"mms_integer__(1)",a);
35     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms_integer__(2)",b);
36     CTTO(SCHUR,HASHTABLE,"mms_integer__(3)",c);
37 
38     if (S_I_I(a) == 0)
39         erg += mms_null__(b,c,f);
40     else if (S_O_K(b) == INTEGER) {
41         OP ff;
42         ff = CALLOCOBJECT();
43         erg += first_partition(b,ff);
44         erg += mms_integer_partition_(ff,b,c,f);
45         FREEALL(ff);
46         }
47     else if (S_O_K(b) == PARTITION) {
48         erg += mms_integer_partition_(a,b,c,f);
49         }
50     else /* SCHUR   HASHTABLE */ {
51         M_FORALL_MONOMIALS_IN_B(a,b,c,f,mms_integer_partition_);
52         }
53 
54     ENDR("mms_integer__");
55 }
56 
mms_partition_partition_(a,b,c,f)57 INT mms_partition_partition_(a,b,c,f) OP a,b,c,f;
58 {
59     INT erg = OK;
60     CTO(PARTITION,"mms_partition_partition_(1)",a);
61     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms_partition_partition_(2)",b);
62     CTTO(SCHUR,HASHTABLE,"mms_partition_partition_(3)",c);
63     if (S_PA_LI(a) == 0) {
64         erg += mms_null__(b,c,f);
65         }
66     else if  (S_PA_LI(a) == 1) {
67         erg += mms_integer_partition_(S_PA_I(a,0),b,c,f);
68         }
69     else {
70         if (S_O_K(c) == HASHTABLE)
71             {
72             erg += cc_muir_mms_partition_partition_(a,b,c,f);
73             }
74         else {
75             OP d;
76             d = CALLOCOBJECT();
77             init_hashtable(d);
78             erg += cc_muir_mms_partition_partition_(a,b,d,f);
79             t_HASHTABLE_SCHUR(d,d);
80             insert_list(d,c,add_koeff,comp_monomschur);
81             }
82 #ifdef UNDEF
83         INT w,i,j;
84         INT l;
85         OP subset,v,perm,iperm;
86 
87         for (i=0,w=0;i<S_PA_LI(a);i++) w+= S_PA_II(a,i);
88         l = w + S_PA_LI(b);
89         /* this is the length of the composition */
90         v = callocobject();
91         erg += m_il_nv(l,v);C_O_K(v,INTEGERVECTOR);
92         subset = callocobject();
93         perm = callocobject();
94         iperm = callocobject();
95         m_l_v(S_PA_L(a),iperm);
96     	/* innerhalb des subsets nun alle vers permutationen */
97         erg += first_permutation(S_PA_L(a),perm);
98         do {
99     	    erg += first_subset(S_V_L(v),S_PA_L(a),subset);
100     	    for (i=0;i<S_V_LI(iperm);i++) M_I_I(0,S_V_I(iperm,i));
101     	    do {
102     	        OP d,s;
103                 M_I_I(l,S_V_L(v)); /* wird in reorder_vector_apply geaendert */
104     	        for (i=S_V_LI(v)-1,j=S_PA_LI(b)-1;i>=0;i--,j--)
105     		    if (j>=0) M_I_I(S_PA_II(b,j),S_V_I(v,i));
106     		    else M_I_I(0,S_V_I(v,i));
107     	        /* vector v is filled with partition b */
108 
109     	        for(i=0,j=0;i<S_P_LI(perm);i++)
110     		    {
111     		    /* um verschiedene permutationen zu bekommen, testen */
112 
113     		    if (S_P_II(perm,i) > 1)
114     		       if (S_PA_II(a,S_P_II(perm,i)-1) == S_PA_II(a,S_P_II(perm,i)-2) )
115     		          if (S_V_II(iperm,S_P_II(perm,i)-2) == 0) goto next_perm;
116 
117     		    while (S_V_II(subset,j) == 0) j++;
118     		    /* an der stelle j ist ein eintrag */
119     		    M_I_I(S_V_II(v,j)+S_PA_II(a,S_P_II(perm,i)-1),S_V_I(v,j));
120     		    M_I_I(i+1,S_V_I(iperm,S_P_II(perm,i)-1));
121     		    j++;
122     		    }
123 
124     	        i = reorder_vector_apply(v);
125 
126     	        if (i==0) { goto next_subset; }
127     	        /* summand gefunden */
128 
129     	        d = CALLOCOBJECT();
130     	        s = callocobject();
131                 COPY(v,d);
132 
133                 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),s);
134                 if (i==1) COPY(f,S_MO_K(s));
135                 else ADDINVERS(f,S_MO_K(s));
136     	        erg += b_ks_pa(VECTOR,d,S_MO_S(s));
137 
138                 if (S_O_K(c) == HASHTABLE)
139     	            insert_scalar_hashtable(s,c,add_koeff,eq_monomsymfunc,hash_monompartition);
140                 else /* SCHUR */
141     	            insert_list(s,c,add_koeff,comp_monomschur);
142 
143             next_subset: ;
144     	    } while(next_apply(subset));
145         next_perm:	;
146     	     /* print(iperm);print(v);println(perm); */
147         } while (next_apply(perm));
148 
149         erg += freeall(perm);
150         erg += freeall(iperm);
151         erg += freeall(v);
152         erg += freeall(subset);
153 #endif
154         }
155     ENDR("mms_partition_partition_");
156 }
157 
158 
mms_partition__(a,b,c,f)159 INT mms_partition__(a,b,c,f) OP a,b,c,f;
160 {
161     INT erg = OK;
162     CTO(PARTITION,"mms_partition__(1)",a);
163     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms_partition__(2)",b);
164     CTTO(SCHUR,HASHTABLE,"mms_partition__(3)",c);
165     if (S_O_K(b) == PARTITION)
166         erg += mms_partition_partition_(a,b,c,f);
167     else {
168         M_FORALL_MONOMIALS_IN_B(a,b,c,f,mms_partition_partition_);
169         }
170     ENDR("mms_partition__");
171 }
172 
mms_hashtable__(a,b,c,f)173 INT mms_hashtable__(a,b,c,f) OP a,b,c,f;
174 {
175     INT erg = OK;
176     CTO(HASHTABLE,"mms_hashtable__(1)",a);
177     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms_hashtable__(2)",b);
178     CTTO(SCHUR,HASHTABLE,"mms_hashtable__(3)",c);
179     M_FORALL_MONOMIALS_IN_A(a,b,c,f,mms_partition__);
180     ENDR("mms_hashtable__");
181 }
182 
mms_hashtable_partition_(a,b,c,f)183 INT mms_hashtable_partition_(a,b,c,f) OP a,b,c,f;
184 {
185     INT erg = OK;
186     CTO(HASHTABLE,"mms_hashtable_partition_(1)",a);
187     CTO(PARTITION,"mms_hashtable_partition_(2)",b);
188     CTTO(SCHUR,HASHTABLE,"mms_hashtable_partition_(3)",c);
189     M_FORALL_MONOMIALS_IN_A(a,b,c,f,mms_partition_partition_);
190     ENDR("mms_hashtable_partition_");
191 }
192 
193 
mms_monomial__(a,b,c,f)194 INT mms_monomial__(a,b,c,f) OP a,b,c,f;
195 {
196     INT erg = OK;
197     CTO(MONOMIAL,"mms_monomial__(1)",a);
198     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms_monomial__(2)",b);
199     CTTO(SCHUR,HASHTABLE,"mms_monomial__(3)",c);
200     M_FORALL_MONOMIALS_IN_A(a,b,c,f,mms_partition__);
201     ENDR("mms_monomial__");
202 }
203 
204 
mms___(a,b,c,f)205 INT mms___(a,b,c,f) OP a,b,c,f;
206 {
207     INT erg = OK;
208     CTTTTO(INTEGER,PARTITION,MONOMIAL,HASHTABLE,"mms___(1)",a);
209     CTTTO(PARTITION,SCHUR,HASHTABLE,"mms___(2)",b);
210     CTTO(SCHUR,HASHTABLE,"mms___(3)",c);
211     if (S_O_K(a) == INTEGER)
212         {
213         erg += mms_integer__(a,b,c,f);
214         goto ende;
215         }
216     else if (S_O_K(a) == PARTITION)
217         {
218         erg += mms_partition__(a,b,c,f);
219         goto ende;
220         }
221     else if (S_O_K(a) == HASHTABLE)
222         {
223         erg += mms_hashtable__(a,b,c,f);
224         goto ende;
225         }
226     else if (S_O_K(a) == MONOMIAL)
227         {
228         erg += mms_monomial__(a,b,c,f);
229         goto ende;
230         }
231 ende:
232     ENDR("mms___");
233 }
234 
235 
mult_monomial_schur(a,b,c)236 INT mult_monomial_schur(a,b,c) OP a,b,c;
237 {
238     INT erg = OK;
239     INT t=0;
240     CTTTTO(INTEGER,MONOMIAL,PARTITION,HASHTABLE,"mult_monomial_schur(1)",a);
241     CTTTTO(INTEGER,SCHUR,PARTITION,HASHTABLE,"mult_monomial_schur(2)",b);
242     CTTTO(EMPTY,SCHUR,HASHTABLE,"mult_monomial_schur(3)",c);
243 
244     if (S_O_K(c) == EMPTY) {
245         t=1;
246         init_hashtable(c);
247         }
248     erg += mms___(a,b,c,cons_eins);
249 
250     if (t==1) erg += t_HASHTABLE_SCHUR(c,c);
251 
252     CTTO(SCHUR,HASHTABLE,"mult_monomial_schur(3-ende)",c);
253     ENDR("mult_monomial_schur");
254 }
255