My Project
Loading...
Searching...
No Matches
singular.cc
Go to the documentation of this file.
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
15STATIC_VAR int nforder_type_id=0;
17
18// coeffs stuff: -----------------------------------------------------------
19STATIC_VAR coeffs nforder_AE=NULL;
20static void nforder_Register()
21{
22 puts("nforder_Register called");
24 nforder_AE=nInitChar(nforder_type,NULL);
25}
26// black box stuff: ---------------------------------------------------------
27static void * nforder_ideal_Init(blackbox */*b*/)
28{
29 nforder_AE->ref++;
30 return nforder_AE;
31}
32static 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}
39static void * nforder_ideal_Copy(blackbox* /*b*/, void *d)
40{ return new nforder_ideal((nforder_ideal*)d, 1);}
41
42static 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}
58static void nforder_ideal_destroy(blackbox * /*b*/, void *d)
59{
60 if (d!=NULL)
61 {
62 delete (nforder_ideal*)d;
63 }
64}
65
66BOOLEAN 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
77BOOLEAN 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
86BOOLEAN 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
96BOOLEAN 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
104BOOLEAN checkArgumentIsInt(leftv arg, int* result)
105{
106 if (arg->Typ() != INT_CMD) return FALSE;
107 *result = (long) arg->Data();
108 return TRUE;
109}
110
111BOOLEAN 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 &&
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
141static 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}
192static 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
216BOOLEAN 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
233static 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
267static 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
286static 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
303static 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
316static 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
336static 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
354static 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
369static 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
388static 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
407static 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
421static 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
439extern "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
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
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
#define FALSE
Definition: auxiliary.h:96
BOOLEAN dimension(leftv res, leftv args)
Definition: bbcone.cc:757
void diagonalForm(bigintmat *A, bigintmat **S, bigintmat **T)
Definition: bigintmat.cc:2475
int setBlackboxStuff(blackbox *bb, const char *n)
define a new type
Definition: blackbox.cc:142
const char * getBlackboxName(const int t)
return the name to the type given by t (r/o)
Definition: blackbox.cc:212
int l
Definition: cfEzgcd.cc:100
int i
Definition: cfEzgcd.cc:132
int p
Definition: cfModGcd.cc:4078
CanonicalForm b
Definition: cfModGcd.cc:4103
FILE * f
Definition: checklibs.c:9
Matrices of numbers.
Definition: bigintmat.h:51
coeffs basecoeffs() const
Definition: bigintmat.h:146
Definition: idrec.h:35
coeffs order() const
Definition: nforder_ideal.h:45
number getDisc()
Definition: nforder.cpp:227
number elTrace(bigintmat *a)
Definition: nforder.cpp:379
coeffs basecoeffs() const
Definition: nforder.h:76
nforder * simplify()
Definition: nforder.cpp:275
void calcdisc()
Definition: nforder.cpp:162
bigintmat * elRepMat(bigintmat *a)
Definition: nforder.cpp:395
number elNorm(bigintmat *a)
Definition: nforder.cpp:387
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int Typ()
Definition: subexpr.cc:1019
void * Data()
Definition: subexpr.cc:1162
leftv next
Definition: subexpr.h:86
void * data
Definition: subexpr.h:88
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
Coefficient rings, fields and other domains suitable for Singular polynomials.
n_coeffType
Definition: coeffs.h:27
@ n_unknown
Definition: coeffs.h:28
@ n_Z
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:413
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition: coeffs.h:422
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:535
#define Print
Definition: emacs.cc:80
return result
Definition: facAbsBiFact.cc:75
CanonicalForm H
Definition: facAbsFact.cc:60
b *CanonicalForm B
Definition: facBivar.cc:52
void WerrorS(const char *s)
Definition: feFopen.cc:24
if(!FE_OPT_NO_SHELL_FLAG)(void) system(sys)
#define STATIC_VAR
Definition: globaldefs.h:7
#define VAR
Definition: globaldefs.h:5
@ BIGINTMAT_CMD
Definition: grammar.cc:278
@ NUMBER_CMD
Definition: grammar.cc:288
VAR package currPack
Definition: ipid.cc:57
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define IDDATA(a)
Definition: ipid.h:126
void module_help_main(const char *newlib, const char *help)
Definition: iplib.cc:1347
int lSize(lists L)
Definition: lists.cc:25
#define assume(x)
Definition: mod2.h:389
slists * lists
Definition: mpr_numeric.h:146
The main handler for Singular numbers which are suitable for Singular polynomials.
nforder * onestep(nforder *o, number p, coeffs c)
Definition: nforder.cpp:608
nforder * pmaximal(nforder *o, number p)
Definition: nforder.cpp:632
number EltCreateMat(nforder *a, bigintmat *b)
BOOLEAN n_nfOrderInit(coeffs r, void *parameter)
EXTERN_VAR n_coeffType nforder_type
Definition: nforder_elt.h:4
nforder_ideal * nf_idMult(nforder_ideal *A, nforder_ideal *B)
nforder_ideal * nf_idPower(nforder_ideal *A, int i)
nforder_ideal * nf_idAdd(nforder_ideal *A, nforder_ideal *B)
n_coeffType nRegister(n_coeffType n, cfInitCharProc p)
Definition: numbers.cc:595
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define NULL
Definition: omList.c:12
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void StringSetS(const char *st)
Definition: reporter.cc:128
void StringAppendS(const char *st)
Definition: reporter.cc:107
char * StringEndS()
Definition: reporter.cc:151
void PrintLn()
Definition: reporter.cc:310
#define R
Definition: sirandom.c:27
#define A
Definition: sirandom.c:24
#define IDHDL
Definition: tok.h:31
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ LIST_CMD
Definition: tok.h:118
@ CNUMBER_CMD
Definition: tok.h:47
@ INT_CMD
Definition: tok.h:96
@ MAX_TOK
Definition: tok.h:218
#define NONE
Definition: tok.h:221