1 | #include "kernel/mod2.h" // general settings/macros |
---|
2 | #include "Singular/mod_lib.h" |
---|
3 | //#include "kernel/febase.h" // for Print, WerrorS |
---|
4 | #include "Singular/ipid.h" // for SModulFunctions, leftv |
---|
5 | #include "Singular/number2.h" // for SModulFunctions, leftv |
---|
6 | #include "coeffs/numbers.h" // nRegister, coeffs.h |
---|
7 | #include "coeffs/coeffs.h" |
---|
8 | #include "Singular/blackbox.h" // blackbox type |
---|
9 | #include "nforder.h" |
---|
10 | #include "nforder_elt.h" |
---|
11 | #include "nforder_ideal.h" |
---|
12 | #include "coeffs/bigintmat.h" |
---|
13 | |
---|
14 | #ifdef SINGULAR_4_2 |
---|
15 | STATIC_VAR int nforder_type_id=0; |
---|
16 | VAR n_coeffType nforder_type =n_unknown; |
---|
17 | |
---|
18 | // coeffs stuff: ----------------------------------------------------------- |
---|
19 | STATIC_VAR coeffs nforder_AE=NULL; |
---|
20 | static void nforder_Register() |
---|
21 | { |
---|
22 | puts("nforder_Register called"); |
---|
23 | nforder_type=nRegister(n_unknown,n_nfOrderInit); |
---|
24 | nforder_AE=nInitChar(nforder_type,NULL); |
---|
25 | } |
---|
26 | // black box stuff: --------------------------------------------------------- |
---|
27 | static void * nforder_ideal_Init(blackbox */*b*/) |
---|
28 | { |
---|
29 | nforder_AE->ref++; |
---|
30 | return nforder_AE; |
---|
31 | } |
---|
32 | static char * nforder_ideal_String(blackbox *b, void *d) |
---|
33 | { |
---|
34 | StringSetS(""); |
---|
35 | if (d) ((nforder_ideal *)d)->Write(); |
---|
36 | else StringAppendS("o not defined o"); |
---|
37 | return StringEndS(); |
---|
38 | } |
---|
39 | static void * nforder_ideal_Copy(blackbox* /*b*/, void *d) |
---|
40 | { return new nforder_ideal((nforder_ideal*)d, 1);} |
---|
41 | |
---|
42 | static BOOLEAN nforder_ideal_Assign(leftv l, leftv r) |
---|
43 | { |
---|
44 | if (l->Typ()==r->Typ()) |
---|
45 | { |
---|
46 | if (l->rtyp==IDHDL) |
---|
47 | { |
---|
48 | IDDATA((idhdl)l->data)=(char *)nforder_ideal_Copy((blackbox*)NULL, r->data); |
---|
49 | } |
---|
50 | else |
---|
51 | { |
---|
52 | l->data=(char *)nforder_ideal_Copy((blackbox*)NULL, r->data); |
---|
53 | } |
---|
54 | return FALSE; |
---|
55 | } |
---|
56 | return TRUE; |
---|
57 | } |
---|
58 | static void nforder_ideal_destroy(blackbox * /*b*/, void *d) |
---|
59 | { |
---|
60 | if (d!=NULL) |
---|
61 | { |
---|
62 | delete (nforder_ideal*)d; |
---|
63 | } |
---|
64 | } |
---|
65 | |
---|
66 | BOOLEAN checkArgumentIsOrder(leftv arg, nforder * cmp, nforder ** result) |
---|
67 | { |
---|
68 | if (arg->Typ() != CRING_CMD) return FALSE; |
---|
69 | coeffs R = (coeffs) arg->Data(); |
---|
70 | if (getCoeffType(R) != nforder_type) return FALSE; |
---|
71 | nforder * O = (nforder*) R->data; |
---|
72 | if (cmp && cmp != O) return FALSE; |
---|
73 | *result = O; |
---|
74 | return TRUE; |
---|
75 | } |
---|
76 | |
---|
77 | BOOLEAN checkArgumentIsBigintmat(leftv arg, coeffs r, bigintmat ** result) |
---|
78 | { |
---|
79 | if (arg->Typ() != BIGINTMAT_CMD) return FALSE; |
---|
80 | bigintmat * b = (bigintmat*) arg->Data(); |
---|
81 | if (r && b->basecoeffs() != r) return FALSE; |
---|
82 | *result = b; |
---|
83 | return TRUE; |
---|
84 | } |
---|
85 | |
---|
86 | BOOLEAN checkArgumentIsNumber2(leftv arg, coeffs r, number2 * result) |
---|
87 | { |
---|
88 | if (arg->Typ() != CNUMBER_CMD) return FALSE; |
---|
89 | number2 b = (number2) arg->Data(); |
---|
90 | if (r && b->cf != r) return FALSE; |
---|
91 | *result = b; |
---|
92 | return TRUE; |
---|
93 | } |
---|
94 | |
---|
95 | |
---|
96 | BOOLEAN checkArgumentIsNFOrderIdeal(leftv arg, coeffs r, nforder_ideal ** result) |
---|
97 | { |
---|
98 | if (arg->Typ() != nforder_type_id) return FALSE; |
---|
99 | *result = (nforder_ideal *) arg->Data(); |
---|
100 | if (r && (*result)->order() != r) return FALSE; |
---|
101 | return TRUE; |
---|
102 | } |
---|
103 | |
---|
104 | BOOLEAN checkArgumentIsInt(leftv arg, int* result) |
---|
105 | { |
---|
106 | if (arg->Typ() != INT_CMD) return FALSE; |
---|
107 | *result = (long) arg->Data(); |
---|
108 | return TRUE; |
---|
109 | } |
---|
110 | |
---|
111 | BOOLEAN checkArgumentIsBigint(leftv arg, number* result) |
---|
112 | { |
---|
113 | switch (arg->Typ()) { |
---|
114 | case BIGINT_CMD: |
---|
115 | *result = (number)arg->Data(); |
---|
116 | return TRUE; |
---|
117 | break; |
---|
118 | case NUMBER_CMD: |
---|
119 | if (currRing->cf == coeffs_BIGINT && |
---|
120 | getCoeffType(coeffs_BIGINT) == n_Z) { |
---|
121 | *result = (number)arg->Data(); |
---|
122 | return TRUE; |
---|
123 | } else |
---|
124 | return FALSE; |
---|
125 | break; |
---|
126 | case CNUMBER_CMD: |
---|
127 | { |
---|
128 | number2 n = (number2)arg->Data(); |
---|
129 | if (getCoeffType(n->cf) == n_Z) { |
---|
130 | *result = n->n; |
---|
131 | return TRUE; |
---|
132 | } |
---|
133 | return FALSE; |
---|
134 | break; |
---|
135 | } |
---|
136 | default: |
---|
137 | return FALSE; |
---|
138 | } |
---|
139 | } |
---|
140 | |
---|
141 | static BOOLEAN nforder_ideal_Op2(int op,leftv l, leftv r1, leftv r2) |
---|
142 | { |
---|
143 | Print("Types are %d %d\n", r1->Typ(), r2->Typ()); |
---|
144 | number2 e; |
---|
145 | int f; |
---|
146 | nforder_ideal *I, *J, *H; |
---|
147 | switch (op) { |
---|
148 | case '+': |
---|
149 | { |
---|
150 | if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I)) |
---|
151 | return TRUE; |
---|
152 | if (!checkArgumentIsNFOrderIdeal(r2, I->order(), &J)) |
---|
153 | return TRUE; |
---|
154 | H = nf_idAdd(I, J); |
---|
155 | break; |
---|
156 | } |
---|
157 | case '*': |
---|
158 | { |
---|
159 | if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I)) { |
---|
160 | leftv r = r1; |
---|
161 | r1 = r2; |
---|
162 | r2 = r; //at least ONE argument has to be an ideal |
---|
163 | } |
---|
164 | if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I)) |
---|
165 | return TRUE; |
---|
166 | if (checkArgumentIsNFOrderIdeal(r2, I->order(), &J)) { |
---|
167 | H = nf_idMult(I, J); |
---|
168 | } else if (checkArgumentIsNumber2(r2, I->order(), &e)) { |
---|
169 | H = nf_idMult(I, e->n); |
---|
170 | } else if (checkArgumentIsInt(r2, &f)) { |
---|
171 | H = nf_idMult(I, f); |
---|
172 | } else |
---|
173 | return TRUE; |
---|
174 | break; |
---|
175 | } |
---|
176 | case '^': |
---|
177 | { |
---|
178 | if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I)) |
---|
179 | return TRUE; |
---|
180 | if (!checkArgumentIsInt(r2, &f)) |
---|
181 | return TRUE; |
---|
182 | H = nf_idPower(I, f); |
---|
183 | break; |
---|
184 | } |
---|
185 | default: |
---|
186 | return TRUE; |
---|
187 | } |
---|
188 | l->rtyp = nforder_type_id; |
---|
189 | l->data = (void*)H; |
---|
190 | return FALSE; |
---|
191 | } |
---|
192 | static BOOLEAN nforder_ideal_bb_setup() |
---|
193 | { |
---|
194 | blackbox *b=(blackbox*)omAlloc0(sizeof(blackbox)); |
---|
195 | // all undefined entries will be set to default in setBlackboxStuff |
---|
196 | // the default Print is quite useful, |
---|
197 | // all other are simply error messages |
---|
198 | b->blackbox_destroy=nforder_ideal_destroy; |
---|
199 | b->blackbox_String=nforder_ideal_String; |
---|
200 | //b->blackbox_Print=blackbox_default_Print; |
---|
201 | b->blackbox_Init=nforder_ideal_Init; |
---|
202 | b->blackbox_Copy=nforder_ideal_Copy; |
---|
203 | b->blackbox_Assign=nforder_ideal_Assign; |
---|
204 | //b->blackbox_Op1=blackbox_default_Op1; |
---|
205 | b->blackbox_Op2=nforder_ideal_Op2; |
---|
206 | //b->blackbox_Op3=blackbox_default_Op3; |
---|
207 | //b->blackbox_OpM=blackbox_default_OpM; |
---|
208 | nforder_type_id = setBlackboxStuff(b,"NFOrderIdeal"); |
---|
209 | Print("setup: created a blackbox type [%d] '%s'",nforder_type_id, getBlackboxName(nforder_type_id)); |
---|
210 | PrintLn(); |
---|
211 | return FALSE; // ok, TRUE = error! |
---|
212 | } |
---|
213 | |
---|
214 | // module stuff: ------------------------------------------------------------ |
---|
215 | |
---|
216 | BOOLEAN checkBigintmatDim(bigintmat * b, int r, int c) |
---|
217 | { |
---|
218 | if (b->rows() != r) return FALSE; |
---|
219 | if (b->cols() != c) return FALSE; |
---|
220 | return TRUE; |
---|
221 | } |
---|
222 | |
---|
223 | #define returnNumber(_res, _n, _R) \ |
---|
224 | do { \ |
---|
225 | number2 _r = (number2)omAlloc(sizeof(struct snumber2)); \ |
---|
226 | _r->n = _n; \ |
---|
227 | _r->cf = _R; \ |
---|
228 | _res->rtyp = CNUMBER_CMD; \ |
---|
229 | _res->data = _r; \ |
---|
230 | } while (0) |
---|
231 | |
---|
232 | |
---|
233 | static BOOLEAN build_ring(leftv result, leftv arg) |
---|
234 | { |
---|
235 | nforder *o; |
---|
236 | if (arg->Typ() == LIST_CMD) { |
---|
237 | lists L = (lists)arg->Data(); |
---|
238 | int n = lSize(L)+1; |
---|
239 | bigintmat **multtable = (bigintmat**)omAlloc(n*sizeof(bigintmat*)); |
---|
240 | for(int i=0; i<n; i++) { |
---|
241 | multtable[i] = (bigintmat*)(L->m[i].Data()); |
---|
242 | } |
---|
243 | o = new nforder(n, multtable, nInitChar(n_Z, 0)); |
---|
244 | omFree(multtable); |
---|
245 | } else { |
---|
246 | assume(arg->Typ() == INT_CMD); |
---|
247 | int dimension = (int)(long)arg->Data(); |
---|
248 | |
---|
249 | bigintmat **multtable = (bigintmat**)omAlloc(dimension*sizeof(bigintmat*)); |
---|
250 | arg = arg->next; |
---|
251 | for (int i=0; i<dimension; i++) { |
---|
252 | multtable[i] = new bigintmat((bigintmat*)arg->Data()); |
---|
253 | arg = arg->next; |
---|
254 | } |
---|
255 | o = new nforder(dimension, multtable, nInitChar(n_Z, 0)); |
---|
256 | for (int i=0; i<dimension; i++) { |
---|
257 | delete multtable[i]; |
---|
258 | } |
---|
259 | omFree(multtable); |
---|
260 | } |
---|
261 | result->rtyp=CRING_CMD; // set the result type |
---|
262 | result->data=(char*)nInitChar(nforder_type, o);// set the result data |
---|
263 | |
---|
264 | return FALSE; |
---|
265 | } |
---|
266 | |
---|
267 | static BOOLEAN ideal_from_mat(leftv result, leftv arg) |
---|
268 | { |
---|
269 | nforder * O; |
---|
270 | if (!checkArgumentIsOrder(arg, NULL, &O)) { |
---|
271 | WerrorS("usage: IdealFromMat(order, basis matrix)"); |
---|
272 | return TRUE; |
---|
273 | } |
---|
274 | arg = arg->next; |
---|
275 | bigintmat *b; |
---|
276 | if (!checkArgumentIsBigintmat(arg, O->basecoeffs(), &b)) { |
---|
277 | WerrorS("3:usage: IdealFromMat(order, basis matrix)"); |
---|
278 | return TRUE; |
---|
279 | } |
---|
280 | result->rtyp = nforder_type_id; |
---|
281 | result->data = new nforder_ideal(b, nInitChar(nforder_type, O)); |
---|
282 | return FALSE; |
---|
283 | } |
---|
284 | |
---|
285 | |
---|
286 | static BOOLEAN elt_from_mat(leftv result, leftv arg) |
---|
287 | { |
---|
288 | nforder * O; |
---|
289 | if (!checkArgumentIsOrder(arg, NULL, &O)) { |
---|
290 | WerrorS("usage: EltFromMat(order, matrix)"); |
---|
291 | return TRUE; |
---|
292 | } |
---|
293 | arg = arg->next; |
---|
294 | bigintmat *b; |
---|
295 | if (!checkArgumentIsBigintmat(arg, O->basecoeffs(), &b)) { |
---|
296 | WerrorS("2:usage: EltFromMat(order, matrix)"); |
---|
297 | return TRUE; |
---|
298 | } |
---|
299 | returnNumber(result, (number)EltCreateMat(O, b), nInitChar(nforder_type, O)); |
---|
300 | return FALSE; |
---|
301 | } |
---|
302 | |
---|
303 | static BOOLEAN discriminant(leftv result, leftv arg) |
---|
304 | { |
---|
305 | nforder * O; |
---|
306 | if (!checkArgumentIsOrder(arg, NULL, &O)) { |
---|
307 | WerrorS("usage: Discriminant(order)"); |
---|
308 | return TRUE; |
---|
309 | } |
---|
310 | O->calcdisc(); |
---|
311 | |
---|
312 | returnNumber(result, O->getDisc(), O->basecoeffs()); |
---|
313 | return FALSE; |
---|
314 | } |
---|
315 | |
---|
316 | static BOOLEAN pMaximalOrder(leftv result, leftv arg) |
---|
317 | { |
---|
318 | nforder * o; |
---|
319 | if (!checkArgumentIsOrder(arg, NULL, &o)) { |
---|
320 | WerrorS("usage: pMaximalOrder(order, int)"); |
---|
321 | return TRUE; |
---|
322 | } |
---|
323 | arg = arg->next; |
---|
324 | long p = (int)(long)arg->Data(); |
---|
325 | number P = n_Init(p, o->basecoeffs()); |
---|
326 | |
---|
327 | nforder *op = pmaximal(o, P); |
---|
328 | |
---|
329 | result->rtyp=CRING_CMD; // set the result type |
---|
330 | result->data=(char*)nInitChar(nforder_type, op);// set the result data |
---|
331 | assume(result->data); |
---|
332 | |
---|
333 | return FALSE; |
---|
334 | } |
---|
335 | |
---|
336 | static BOOLEAN oneStep(leftv result, leftv arg) |
---|
337 | { |
---|
338 | assume (arg->Typ()==CRING_CMD); |
---|
339 | coeffs c = (coeffs)arg->Data(); |
---|
340 | assume (c->type == nforder_type); |
---|
341 | nforder * o = (nforder*)c->data; |
---|
342 | arg = arg->next; |
---|
343 | long p = (int)(long)arg->Data(); |
---|
344 | number P = n_Init(p, o->basecoeffs()); |
---|
345 | |
---|
346 | nforder *op = onestep(o, P, o->basecoeffs()); |
---|
347 | |
---|
348 | result->rtyp=CRING_CMD; // set the result type |
---|
349 | result->data=(char*)nInitChar(nforder_type, op);// set the result data |
---|
350 | |
---|
351 | return FALSE; |
---|
352 | } |
---|
353 | |
---|
354 | static BOOLEAN nforder_simplify(leftv result, leftv arg) |
---|
355 | { |
---|
356 | nforder * o; |
---|
357 | if (!checkArgumentIsOrder(arg, NULL, &o)) { |
---|
358 | WerrorS("usage: NFOrderSimplify(order)"); |
---|
359 | return TRUE; |
---|
360 | } |
---|
361 | nforder *op = o->simplify(); |
---|
362 | |
---|
363 | result->rtyp=CRING_CMD; // set the result type |
---|
364 | result->data=(char*)nInitChar(nforder_type, op);// set the result data |
---|
365 | |
---|
366 | return FALSE; |
---|
367 | } |
---|
368 | |
---|
369 | static BOOLEAN eltTrace(leftv result, leftv arg) |
---|
370 | { |
---|
371 | number2 a; |
---|
372 | if (!checkArgumentIsNumber2(arg, NULL, &a)) { |
---|
373 | WerrorS("EltTrace(elt)"); |
---|
374 | return TRUE; |
---|
375 | } |
---|
376 | coeffs c = a->cf; |
---|
377 | if (getCoeffType(c) != nforder_type) { |
---|
378 | WerrorS("EltTrace(elt in order)"); |
---|
379 | return TRUE; |
---|
380 | } |
---|
381 | bigintmat * aa = (bigintmat*)a->n; |
---|
382 | nforder * o = (nforder*)c->data; |
---|
383 | number t = o->elTrace(aa); |
---|
384 | returnNumber(result, t, o->basecoeffs()); |
---|
385 | return FALSE; |
---|
386 | } |
---|
387 | |
---|
388 | static BOOLEAN eltNorm(leftv result, leftv arg) |
---|
389 | { |
---|
390 | number2 a; |
---|
391 | if (!checkArgumentIsNumber2(arg, NULL, &a)) { |
---|
392 | WerrorS("EltNorm(elt)"); |
---|
393 | return TRUE; |
---|
394 | } |
---|
395 | coeffs c = a->cf; |
---|
396 | if (getCoeffType(c) != nforder_type) { |
---|
397 | WerrorS("EltNorm(elt in order)"); |
---|
398 | return TRUE; |
---|
399 | } |
---|
400 | bigintmat * aa = (bigintmat*)a->n; |
---|
401 | nforder * o = (nforder*)c->data; |
---|
402 | number t = o->elNorm(aa); |
---|
403 | returnNumber(result, t, o->basecoeffs()); |
---|
404 | return FALSE; |
---|
405 | } |
---|
406 | |
---|
407 | static BOOLEAN eltRepMat(leftv result, leftv arg) |
---|
408 | { |
---|
409 | assume (arg->Typ()==CNUMBER_CMD); |
---|
410 | number2 a = (number2) arg->Data(); |
---|
411 | coeffs c = a->cf; |
---|
412 | bigintmat * aa = (bigintmat*)a->n; |
---|
413 | assume (c->type == nforder_type); |
---|
414 | nforder * o = (nforder*)c->data; |
---|
415 | bigintmat* t = o->elRepMat(aa); |
---|
416 | result->rtyp = BIGINTMAT_CMD; |
---|
417 | result->data = t; |
---|
418 | return FALSE; |
---|
419 | } |
---|
420 | |
---|
421 | static BOOLEAN smithtest(leftv result, leftv arg) |
---|
422 | { |
---|
423 | assume (arg->Typ()==BIGINTMAT_CMD); |
---|
424 | bigintmat *a = (bigintmat *) arg->Data(); |
---|
425 | arg = arg->next; |
---|
426 | |
---|
427 | long p = (int)(long)arg->Data(); |
---|
428 | number P = n_Init(p, a->basecoeffs()); |
---|
429 | |
---|
430 | bigintmat * A, *B; |
---|
431 | diagonalForm(a, &A, &B); |
---|
432 | |
---|
433 | |
---|
434 | result->rtyp = NONE; |
---|
435 | return FALSE; |
---|
436 | } |
---|
437 | |
---|
438 | |
---|
439 | extern "C" int SI_MOD_INIT(Order)(SModulFunctions* psModulFunctions) |
---|
440 | { |
---|
441 | nforder_Register(); |
---|
442 | nforder_ideal_bb_setup(); |
---|
443 | psModulFunctions->iiAddCproc( |
---|
444 | (currPack->libname? currPack->libname: ""),// the library name, |
---|
445 | "nfOrder",// the name for the singular interpreter |
---|
446 | FALSE, // should not be static |
---|
447 | build_ring); // the C/C++ routine |
---|
448 | |
---|
449 | psModulFunctions->iiAddCproc( |
---|
450 | (currPack->libname? currPack->libname: ""),// the library name, |
---|
451 | "pMaximalOrder",// the name for the singular interpreter |
---|
452 | FALSE, // should not be static |
---|
453 | pMaximalOrder); // the C/C++ routine |
---|
454 | |
---|
455 | psModulFunctions->iiAddCproc( |
---|
456 | (currPack->libname? currPack->libname: ""),// the library name, |
---|
457 | "oneStep",// the name for the singular interpreter |
---|
458 | FALSE, // should not be static |
---|
459 | oneStep); // the C/C++ routine |
---|
460 | |
---|
461 | psModulFunctions->iiAddCproc( |
---|
462 | (currPack->libname? currPack->libname: ""), |
---|
463 | "Discriminant", |
---|
464 | FALSE, |
---|
465 | discriminant); |
---|
466 | |
---|
467 | psModulFunctions->iiAddCproc( |
---|
468 | (currPack->libname? currPack->libname: ""), |
---|
469 | "EltFromMat", |
---|
470 | FALSE, |
---|
471 | elt_from_mat); |
---|
472 | |
---|
473 | psModulFunctions->iiAddCproc( |
---|
474 | (currPack->libname? currPack->libname: ""), |
---|
475 | "NFOrderSimplify", |
---|
476 | FALSE, |
---|
477 | nforder_simplify); |
---|
478 | |
---|
479 | psModulFunctions->iiAddCproc( |
---|
480 | (currPack->libname? currPack->libname: ""), |
---|
481 | "EltNorm", |
---|
482 | FALSE, |
---|
483 | eltNorm); |
---|
484 | |
---|
485 | psModulFunctions->iiAddCproc( |
---|
486 | (currPack->libname? currPack->libname: ""), |
---|
487 | "EltTrace", |
---|
488 | FALSE, |
---|
489 | eltTrace); |
---|
490 | |
---|
491 | psModulFunctions->iiAddCproc( |
---|
492 | (currPack->libname? currPack->libname: ""), |
---|
493 | "EltRepMat", |
---|
494 | FALSE, |
---|
495 | eltRepMat); |
---|
496 | |
---|
497 | psModulFunctions->iiAddCproc( |
---|
498 | (currPack->libname? currPack->libname: ""), |
---|
499 | "SmithTest", |
---|
500 | FALSE, |
---|
501 | smithtest); |
---|
502 | |
---|
503 | psModulFunctions->iiAddCproc( |
---|
504 | (currPack->libname? currPack->libname: ""), |
---|
505 | "IdealFromMat", |
---|
506 | FALSE, |
---|
507 | ideal_from_mat); |
---|
508 | |
---|
509 | module_help_main( |
---|
510 | (currPack->libname? currPack->libname: "NFOrder"),// the library name, |
---|
511 | "nforder: orders in number fields"); // the help string for the module |
---|
512 | return MAX_TOK; |
---|
513 | } |
---|
514 | #endif |
---|