1 #include "def.h"
2 #include "macro.h"
3
4 INT mee_integer_partition_();
5 INT mee_integer_hashtable_();
6 INT m_merge_partition_partition();
7
mee_integer__(a,b,c,f)8 INT mee_integer__(a,b,c,f) OP a,b,c; OP f;
9 /* AK 311001 */
10 {
11 INT erg = OK;
12
13 CTO(INTEGER,"mee_integer__(1)",a);
14 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mee_integer__(2)",b);
15 CTTO(HASHTABLE,ELMSYM,"mee_integer__(3)",c);
16 SYMCHECK( S_I_I(a) < 0 , "mee_integer__:integer<0");
17
18 if (S_O_K(b) == PARTITION) {
19 erg += mee_integer_partition_(a,b,c,f);
20 goto ende;
21 }
22 else
23 {
24 erg += mee_integer_hashtable_(a,b,c,f);
25 goto ende;
26 }
27 ende:
28 ENDR("mee_integer__");
29 }
30
mee_partition_partition_(a,b,c,f)31 INT mee_partition_partition_(a,b,c,f) OP a,b,c; OP f;
32 {
33 INT erg = OK;
34 CTO(PARTITION,"mee_partition_partition_(1)",a);
35 CTO(PARTITION,"mee_partition_partition_(2)",b);
36 CTTO(HASHTABLE,ELMSYM,"mee_partition_partition_(3)",c);
37 erg += m_merge_partition_partition(a,b,c,f,comp_monomelmsym,eq_monomsymfunc);
38 ENDR("mee_partition_partition_");
39 }
40
mee_partition__(a,b,c,f)41 INT mee_partition__(a,b,c,f) OP a,b,c; OP f;
42 /* AK 311001 */
43 {
44 INT erg = OK;
45 CTO(PARTITION,"mee_partition__(1)",a);
46 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mee_partition__(2)",b);
47 CTTO(HASHTABLE,ELMSYM,"mee_partition__(3)",c);
48
49 if (S_O_K(b) == PARTITION)
50 {
51 erg += mee_partition_partition_(a,b,c,f);
52 goto ende;
53 }
54 else {
55 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mee_partition_partition_);
56 goto ende;
57 }
58
59 ende:
60 ENDR("mee_partition__");
61 }
62
mee_elmsym__(a,b,c,f)63 INT mee_elmsym__(a,b,c,f) OP a,b,c,f;
64 /* AK 061101 */
65 /* c += e_a \times e_b \times f */
66 {
67 INT erg = OK;
68 CTO(ELMSYM,"mee_elmsym__(1)",a);
69 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mee_elmsym__(2)",b);
70 CTTO(HASHTABLE,ELMSYM,"mee_elmsym__(3)",c);
71 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mee_partition__);
72 ENDR("mee_elmsym__");
73 }
74
mee_hashtable__(a,b,c,f)75 INT mee_hashtable__(a,b,c,f) OP a,b,c,f;
76 /* AK 061101 */
77 /* c += e_a \times e_b \times f */
78 {
79 INT erg = OK;
80 CTO(HASHTABLE,"mee_hashtable__(1)",a);
81 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mee_hashtable__(2)",b);
82 CTTO(HASHTABLE,ELMSYM,"mee_hashtable__(3)",c);
83 M_FORALL_MONOMIALS_IN_A(a,b,c,f,mee_partition__);
84 ENDR("mee_hashtable__");
85 }
86
mee_hashtable_hashtable_(a,b,c,f)87 INT mee_hashtable_hashtable_(a,b,c,f) OP a,b,c,f;
88 /* AK 061101 */
89 /* c += e_a \times e_b \times f */
90 {
91 INT erg = OK;
92 CTO(HASHTABLE,"mee_hashtable_hashtable_(1)",a);
93 CTO(HASHTABLE,"mee_hashtable_hashtable_(2)",b);
94 CTTO(HASHTABLE,ELMSYM,"mee_hashtable_hashtable_(3)",c);
95 M_FORALL_MONOMIALS_IN_AB(a,b,c,f,mee_partition_partition_);
96 ENDR("mee_hashtable_hashtable_");
97 }
98
mee_integer_partition_(a,b,c,f)99 INT mee_integer_partition_(a,b,c,f) OP a,b,c,f;
100 /* AK 061101 */
101 {
102 INT erg = OK;
103 OP m;
104 INT i,k;
105
106 CTO(INTEGER,"mee_integer_partition_(1)",a);
107 CTO(PARTITION,"mee_integer_partition_(2)",b);
108 CTTO(ELMSYM,HASHTABLE,"mee_integer_partition_(3)",c);
109 SYMCHECK( S_I_I(a) < 0 , "mee_integer_partition_:integer<0");
110
111
112 m = CALLOCOBJECT();
113 erg += b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),m);
114 if (S_I_I(a) == 0) {
115 COPY(b,S_MO_S(m));
116 }
117 else {
118 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),S_MO_S(m));
119 erg += m_il_integervector(S_PA_LI(b)+1,S_PA_S(S_MO_S(m)));
120
121 for (i=0,k=0; k<S_PA_LI(S_MO_S(m)); k++,i++)
122 if (k == S_PA_LI(b))
123 M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
124 else if (S_PA_II(b,i) < S_I_I(a))
125 M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
126 else
127 {
128 M_I_I(S_I_I(a), S_PA_I(S_MO_S(m),k) );
129 break;
130 }
131
132 for (k++;k<S_PA_LI(S_MO_S(m)); k++,i++)
133 M_I_I(S_PA_II(b,i), S_PA_I(S_MO_S(m),k) );
134 }
135
136 COPY(f, S_MO_K(m));
137 INSERT_ELMSYMMONOM_(m,c);
138
139 ENDR("mee_integer_partition_");
140 }
141
mee_integer_hashtable_(a,b,c,f)142 INT mee_integer_hashtable_(a,b,c,f) OP a,b,c,f;
143 /* AK 061101 */
144 {
145 INT erg = OK;
146 CTO(INTEGER,"mee_integer_hashtable_(1)",a);
147 CTTO(HASHTABLE,ELMSYM,"mee_integer_hashtable_(2)",b);
148 CTTO(ELMSYM,HASHTABLE,"mee_integer_hashtable_(3)",c);
149 CTO(ANYTYPE,"mee_integer_hashtable_(4)",f);
150 M_FORALL_MONOMIALS_IN_B(a,b,c,f,mee_integer_partition_);
151 CTTO(ELMSYM,HASHTABLE,"mee_integer_hashtable_(e3)",c);
152 ENDR("mee_integer_hashtable_");
153 }
154
155
156
mult_elmsym_elmsym(a,b,c)157 INT mult_elmsym_elmsym(a,b,c) OP a,b,c;
158 /* AK 111001
159 */
160 {
161 INT erg = OK;
162 INT t=0; /* is 1 if transfer HASHTABLE->ELMSYM necessary */
163 CTTTTO(HASHTABLE,INTEGER,PARTITION,ELMSYM,"mult_elmsym_elmsym(1)",a);
164 CTTTO(HASHTABLE,PARTITION,ELMSYM,"mult_elmsym_elmsym(2)",b);
165 CTTTO(EMPTY,HASHTABLE,ELMSYM,"mult_elmsym_elmsym(3)",c);
166
167 if (S_O_K(a) == INTEGER)
168 {
169 if (S_O_K(c) == EMPTY) {
170 if (S_O_K(b) == PARTITION) init_elmsym(c);
171 else { t=1; init_hashtable(c); }
172 }
173 erg += mee_integer__(a,b,c,cons_eins);
174 }
175 else if (S_O_K(a) == PARTITION)
176 {
177 if (S_O_K(c) == EMPTY)
178 { t=1; init_hashtable(c); }
179 erg += mee_partition__(a,b,c,cons_eins);
180 }
181 else if (S_O_K(a) == ELMSYM)
182 {
183 if (S_O_K(c) == EMPTY)
184 { t=1; init_hashtable(c); }
185 erg += mee_elmsym__(a,b,c,cons_eins);
186 }
187 else /* if (S_O_K(a) == HASHTABLE) */
188 {
189 if (S_O_K(c) == EMPTY)
190 { t=1; init_hashtable(c); }
191 erg += mee_hashtable__(a,b,c,cons_eins);
192 }
193
194 if (t==1) t_HASHTABLE_ELMSYM(c,c);
195 ENDR("mult_elmsym_elmsym");
196 }
197
198