Loading...
Searching...
No Matches
singular.cc
Go to the documentation of this file.
#include "kernel/mod2.h" // general settings/macros
#include "Singular/mod_lib.h"
//#include "kernel/febase.h" // for Print, WerrorS
#include "Singular/ipid.h" // for SModulFunctions, leftv
#include "Singular/number2.h" // for SModulFunctions, leftv
#include "coeffs/numbers.h" // nRegister, coeffs.h
#include "coeffs/coeffs.h"
#include "Singular/blackbox.h" // blackbox type
#include "nforder.h"
#include "nforder_elt.h"
#include "nforder_ideal.h"
#include "coeffs/bigintmat.h"
#ifdef SINGULAR_4_2
STATIC_VAR int nforder_type_id=0;
VAR n_coeffType nforder_type =n_unknown;
// coeffs stuff: -----------------------------------------------------------
STATIC_VAR coeffs nforder_AE=NULL;
static void nforder_Register()
{
puts("nforder_Register called");
nforder_type=nRegister(n_unknown,n_nfOrderInit);
nforder_AE=nInitChar(nforder_type,NULL);
}
// black box stuff: ---------------------------------------------------------
static void * nforder_ideal_Init(blackbox */*b*/)
{
nforder_AE->ref++;
return nforder_AE;
}
static char * nforder_ideal_String(blackbox *b, void *d)
{
StringSetS("");
if (d) ((nforder_ideal *)d)->Write();
else StringAppendS("o not defined o");
return StringEndS();
}
static void * nforder_ideal_Copy(blackbox* /*b*/, void *d)
{ return new nforder_ideal((nforder_ideal*)d, 1);}
static BOOLEAN nforder_ideal_Assign(leftv l, leftv r)
{
if (l->Typ()==r->Typ())
{
if (l->rtyp==IDHDL)
{
IDDATA((idhdl)l->data)=(char *)nforder_ideal_Copy((blackbox*)NULL, r->data);
}
else
{
l->data=(char *)nforder_ideal_Copy((blackbox*)NULL, r->data);
}
return FALSE;
}
return TRUE;
}
static void nforder_ideal_destroy(blackbox * /*b*/, void *d)
{
if (d!=NULL)
{
delete (nforder_ideal*)d;
}
}
BOOLEAN checkArgumentIsOrder(leftv arg, nforder * cmp, nforder ** result)
{
if (arg->Typ() != CRING_CMD) return FALSE;
coeffs R = (coeffs) arg->Data();
if (getCoeffType(R) != nforder_type) return FALSE;
nforder * O = (nforder*) R->data;
if (cmp && cmp != O) return FALSE;
*result = O;
return TRUE;
}
BOOLEAN checkArgumentIsBigintmat(leftv arg, coeffs r, bigintmat ** result)
{
if (arg->Typ() != BIGINTMAT_CMD) return FALSE;
bigintmat * b = (bigintmat*) arg->Data();
if (r && b->basecoeffs() != r) return FALSE;
*result = b;
return TRUE;
}
BOOLEAN checkArgumentIsNumber2(leftv arg, coeffs r, number2 * result)
{
if (arg->Typ() != CNUMBER_CMD) return FALSE;
number2 b = (number2) arg->Data();
if (r && b->cf != r) return FALSE;
*result = b;
return TRUE;
}
BOOLEAN checkArgumentIsNFOrderIdeal(leftv arg, coeffs r, nforder_ideal ** result)
{
if (arg->Typ() != nforder_type_id) return FALSE;
*result = (nforder_ideal *) arg->Data();
if (r && (*result)->order() != r) return FALSE;
return TRUE;
}
BOOLEAN checkArgumentIsInt(leftv arg, int* result)
{
if (arg->Typ() != INT_CMD) return FALSE;
*result = (long) arg->Data();
return TRUE;
}
BOOLEAN checkArgumentIsBigint(leftv arg, number* result)
{
switch (arg->Typ()) {
case BIGINT_CMD:
*result = (number)arg->Data();
return TRUE;
break;
case NUMBER_CMD:
if (currRing->cf == coeffs_BIGINT &&
getCoeffType(coeffs_BIGINT) == n_Z) {
*result = (number)arg->Data();
return TRUE;
} else
return FALSE;
break;
case CNUMBER_CMD:
{
number2 n = (number2)arg->Data();
if (getCoeffType(n->cf) == n_Z) {
*result = n->n;
return TRUE;
}
return FALSE;
break;
}
default:
return FALSE;
}
}
static BOOLEAN nforder_ideal_Op2(int op,leftv l, leftv r1, leftv r2)
{
Print("Types are %d %d\n", r1->Typ(), r2->Typ());
number2 e;
int f;
nforder_ideal *I, *J, *H;
switch (op) {
case '+':
{
if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I))
return TRUE;
if (!checkArgumentIsNFOrderIdeal(r2, I->order(), &J))
return TRUE;
H = nf_idAdd(I, J);
break;
}
case '*':
{
if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I)) {
leftv r = r1;
r1 = r2;
r2 = r; //at least ONE argument has to be an ideal
}
if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I))
return TRUE;
if (checkArgumentIsNFOrderIdeal(r2, I->order(), &J)) {
H = nf_idMult(I, J);
} else if (checkArgumentIsNumber2(r2, I->order(), &e)) {
H = nf_idMult(I, e->n);
} else if (checkArgumentIsInt(r2, &f)) {
H = nf_idMult(I, f);
} else
return TRUE;
break;
}
case '^':
{
if (!checkArgumentIsNFOrderIdeal(r1, NULL, &I))
return TRUE;
if (!checkArgumentIsInt(r2, &f))
return TRUE;
H = nf_idPower(I, f);
break;
}
default:
return TRUE;
}
l->rtyp = nforder_type_id;
l->data = (void*)H;
return FALSE;
}
static BOOLEAN nforder_ideal_bb_setup()
{
blackbox *b=(blackbox*)omAlloc0(sizeof(blackbox));
// all undefined entries will be set to default in setBlackboxStuff
// the default Print is quite useful,
// all other are simply error messages
b->blackbox_destroy=nforder_ideal_destroy;
b->blackbox_String=nforder_ideal_String;
//b->blackbox_Print=blackbox_default_Print;
b->blackbox_Init=nforder_ideal_Init;
b->blackbox_Copy=nforder_ideal_Copy;
b->blackbox_Assign=nforder_ideal_Assign;
//b->blackbox_Op1=blackbox_default_Op1;
b->blackbox_Op2=nforder_ideal_Op2;
//b->blackbox_Op3=blackbox_default_Op3;
//b->blackbox_OpM=blackbox_default_OpM;
nforder_type_id = setBlackboxStuff(b,"NFOrderIdeal");
Print("setup: created a blackbox type [%d] '%s'",nforder_type_id, getBlackboxName(nforder_type_id));
PrintLn();
return FALSE; // ok, TRUE = error!
}
// module stuff: ------------------------------------------------------------
BOOLEAN checkBigintmatDim(bigintmat * b, int r, int c)
{
if (b->rows() != r) return FALSE;
if (b->cols() != c) return FALSE;
return TRUE;
}
#define returnNumber(_res, _n, _R) \
do { \
number2 _r = (number2)omAlloc(sizeof(struct snumber2)); \
_r->n = _n; \
_r->cf = _R; \
_res->rtyp = CNUMBER_CMD; \
_res->data = _r; \
} while (0)
static BOOLEAN build_ring(leftv result, leftv arg)
{
nforder *o;
if (arg->Typ() == LIST_CMD) {
lists L = (lists)arg->Data();
int n = lSize(L)+1;
bigintmat **multtable = (bigintmat**)omAlloc(n*sizeof(bigintmat*));
for(int i=0; i<n; i++) {
multtable[i] = (bigintmat*)(L->m[i].Data());
}
o = new nforder(n, multtable, nInitChar(n_Z, 0));
omFree(multtable);
} else {
assume(arg->Typ() == INT_CMD);
int dimension = (int)(long)arg->Data();
bigintmat **multtable = (bigintmat**)omAlloc(dimension*sizeof(bigintmat*));
arg = arg->next;
for (int i=0; i<dimension; i++) {
multtable[i] = new bigintmat((bigintmat*)arg->Data());
arg = arg->next;
}
o = new nforder(dimension, multtable, nInitChar(n_Z, 0));
for (int i=0; i<dimension; i++) {
delete multtable[i];
}
omFree(multtable);
}
result->rtyp=CRING_CMD; // set the result type
result->data=(char*)nInitChar(nforder_type, o);// set the result data
return FALSE;
}
static BOOLEAN ideal_from_mat(leftv result, leftv arg)
{
nforder * O;
if (!checkArgumentIsOrder(arg, NULL, &O)) {
WerrorS("usage: IdealFromMat(order, basis matrix)");
return TRUE;
}
arg = arg->next;
bigintmat *b;
if (!checkArgumentIsBigintmat(arg, O->basecoeffs(), &b)) {
WerrorS("3:usage: IdealFromMat(order, basis matrix)");
return TRUE;
}
result->rtyp = nforder_type_id;
result->data = new nforder_ideal(b, nInitChar(nforder_type, O));
return FALSE;
}
static BOOLEAN elt_from_mat(leftv result, leftv arg)
{
nforder * O;
if (!checkArgumentIsOrder(arg, NULL, &O)) {
WerrorS("usage: EltFromMat(order, matrix)");
return TRUE;
}
arg = arg->next;
bigintmat *b;
if (!checkArgumentIsBigintmat(arg, O->basecoeffs(), &b)) {
WerrorS("2:usage: EltFromMat(order, matrix)");
return TRUE;
}
returnNumber(result, (number)EltCreateMat(O, b), nInitChar(nforder_type, O));
return FALSE;
}
static BOOLEAN discriminant(leftv result, leftv arg)
{
nforder * O;
if (!checkArgumentIsOrder(arg, NULL, &O)) {
WerrorS("usage: Discriminant(order)");
return TRUE;
}
O->calcdisc();
returnNumber(result, O->getDisc(), O->basecoeffs());
return FALSE;
}
static BOOLEAN pMaximalOrder(leftv result, leftv arg)
{
nforder * o;
if (!checkArgumentIsOrder(arg, NULL, &o)) {
WerrorS("usage: pMaximalOrder(order, int)");
return TRUE;
}
arg = arg->next;
long p = (int)(long)arg->Data();
number P = n_Init(p, o->basecoeffs());
nforder *op = pmaximal(o, P);
result->rtyp=CRING_CMD; // set the result type
result->data=(char*)nInitChar(nforder_type, op);// set the result data
assume(result->data);
return FALSE;
}
static BOOLEAN oneStep(leftv result, leftv arg)
{
assume (arg->Typ()==CRING_CMD);
coeffs c = (coeffs)arg->Data();
assume (c->type == nforder_type);
nforder * o = (nforder*)c->data;
arg = arg->next;
long p = (int)(long)arg->Data();
number P = n_Init(p, o->basecoeffs());
nforder *op = onestep(o, P, o->basecoeffs());
result->rtyp=CRING_CMD; // set the result type
result->data=(char*)nInitChar(nforder_type, op);// set the result data
return FALSE;
}
static BOOLEAN nforder_simplify(leftv result, leftv arg)
{
nforder * o;
if (!checkArgumentIsOrder(arg, NULL, &o)) {
WerrorS("usage: NFOrderSimplify(order)");
return TRUE;
}
nforder *op = o->simplify();
result->rtyp=CRING_CMD; // set the result type
result->data=(char*)nInitChar(nforder_type, op);// set the result data
return FALSE;
}
static BOOLEAN eltTrace(leftv result, leftv arg)
{
number2 a;
if (!checkArgumentIsNumber2(arg, NULL, &a)) {
WerrorS("EltTrace(elt)");
return TRUE;
}
coeffs c = a->cf;
if (getCoeffType(c) != nforder_type) {
WerrorS("EltTrace(elt in order)");
return TRUE;
}
bigintmat * aa = (bigintmat*)a->n;
nforder * o = (nforder*)c->data;
number t = o->elTrace(aa);
returnNumber(result, t, o->basecoeffs());
return FALSE;
}
static BOOLEAN eltNorm(leftv result, leftv arg)
{
number2 a;
if (!checkArgumentIsNumber2(arg, NULL, &a)) {
WerrorS("EltNorm(elt)");
return TRUE;
}
coeffs c = a->cf;
if (getCoeffType(c) != nforder_type) {
WerrorS("EltNorm(elt in order)");
return TRUE;
}
bigintmat * aa = (bigintmat*)a->n;
nforder * o = (nforder*)c->data;
number t = o->elNorm(aa);
returnNumber(result, t, o->basecoeffs());
return FALSE;
}
static BOOLEAN eltRepMat(leftv result, leftv arg)
{
assume (arg->Typ()==CNUMBER_CMD);
number2 a = (number2) arg->Data();
coeffs c = a->cf;
bigintmat * aa = (bigintmat*)a->n;
assume (c->type == nforder_type);
nforder * o = (nforder*)c->data;
bigintmat* t = o->elRepMat(aa);
result->rtyp = BIGINTMAT_CMD;
result->data = t;
return FALSE;
}
static BOOLEAN smithtest(leftv result, leftv arg)
{
assume (arg->Typ()==BIGINTMAT_CMD);
bigintmat *a = (bigintmat *) arg->Data();
arg = arg->next;
long p = (int)(long)arg->Data();
number P = n_Init(p, a->basecoeffs());
bigintmat * A, *B;
diagonalForm(a, &A, &B);
result->rtyp = NONE;
return FALSE;
}
extern "C" int SI_MOD_INIT(Order)(SModulFunctions* psModulFunctions)
{
nforder_Register();
nforder_ideal_bb_setup();
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),// the library name,
"nfOrder",// the name for the singular interpreter
FALSE, // should not be static
build_ring); // the C/C++ routine
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),// the library name,
"pMaximalOrder",// the name for the singular interpreter
FALSE, // should not be static
pMaximalOrder); // the C/C++ routine
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),// the library name,
"oneStep",// the name for the singular interpreter
FALSE, // should not be static
oneStep); // the C/C++ routine
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"Discriminant",
FALSE,
discriminant);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"EltFromMat",
FALSE,
elt_from_mat);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"NFOrderSimplify",
FALSE,
nforder_simplify);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"EltNorm",
FALSE,
eltNorm);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"EltTrace",
FALSE,
eltTrace);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"EltRepMat",
FALSE,
eltRepMat);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"SmithTest",
FALSE,
smithtest);
psModulFunctions->iiAddCproc(
(currPack->libname? currPack->libname: ""),
"IdealFromMat",
FALSE,
ideal_from_mat);
module_help_main(
(currPack->libname? currPack->libname: "NFOrder"),// the library name,
"nforder: orders in number fields"); // the help string for the module
return MAX_TOK;
}
#endif
BOOLEAN
int BOOLEAN
Definition auxiliary.h:88
TRUE
#define TRUE
Definition auxiliary.h:101
FALSE
#define FALSE
Definition auxiliary.h:97
dimension
BOOLEAN dimension(leftv res, leftv args)
Definition bbcone.cc:757
diagonalForm
void diagonalForm(bigintmat *A, bigintmat **S, bigintmat **T)
Definition bigintmat.cc:2461
bigintmat.h
setBlackboxStuff
int setBlackboxStuff(blackbox *bb, const char *n)
define a new type
Definition blackbox.cc:143
getBlackboxName
const char * getBlackboxName(const int t)
return the name to the type given by t (r/o)
Definition blackbox.cc:213
blackbox.h
l
int l
Definition cfEzgcd.cc:100
i
int i
Definition cfEzgcd.cc:132
p
int p
Definition cfModGcd.cc:4086
b
CanonicalForm b
Definition cfModGcd.cc:4111
f
FILE * f
Definition checklibs.c:9
bigintmat
Matrices of numbers.
Definition bigintmat.h:51
bigintmat::basecoeffs
coeffs basecoeffs() const
Definition bigintmat.h:146
nforder_ideal
Definition nforder_ideal.h:12
nforder_ideal::order
coeffs order() const
Definition nforder_ideal.h:45
nforder
Definition nforder.h:24
nforder::getDisc
number getDisc()
Definition nforder.cpp:227
nforder::elTrace
number elTrace(bigintmat *a)
Definition nforder.cpp:379
nforder::basecoeffs
coeffs basecoeffs() const
Definition nforder.h:76
nforder::simplify
nforder * simplify()
Definition nforder.cpp:275
nforder::calcdisc
void calcdisc()
Definition nforder.cpp:162
nforder::elRepMat
bigintmat * elRepMat(bigintmat *a)
Definition nforder.cpp:395
nforder::elNorm
number elNorm(bigintmat *a)
Definition nforder.cpp:387
sleftv::Typ
int Typ()
Definition subexpr.cc:1048
sleftv::Data
void * Data()
Definition subexpr.cc:1192
sleftv::next
leftv next
Definition subexpr.h:86
sleftv::data
void * data
Definition subexpr.h:88
slists::m
sleftv * m
Definition lists.h:46
coeffs.h
Coefficient rings, fields and other domains suitable for Singular polynomials.
n_coeffType
n_coeffType
Definition coeffs.h:27
n_unknown
@ n_unknown
Definition coeffs.h:28
n_Z
@ n_Z
only used if HAVE_RINGS is defined
Definition coeffs.h:43
nInitChar
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition numbers.cc:412
getCoeffType
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition coeffs.h:431
n_Init
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:541
Print
#define Print
Definition emacs.cc:80
result
return result
Definition facAbsBiFact.cc:76
H
CanonicalForm H
Definition facAbsFact.cc:60
B
b *CanonicalForm B
Definition facBivar.cc:52
WerrorS
void WerrorS(const char *s)
Definition feFopen.cc:24
STATIC_VAR
#define STATIC_VAR
Definition globaldefs.h:7
VAR
#define VAR
Definition globaldefs.h:5
BIGINTMAT_CMD
@ BIGINTMAT_CMD
Definition grammar.cc:278
NUMBER_CMD
@ NUMBER_CMD
Definition grammar.cc:289
currPack
VAR package currPack
Definition ipid.cc:55
ipid.h
IDDATA
#define IDDATA(a)
Definition ipid.h:126
module_help_main
void module_help_main(const char *newlib, const char *help)
Definition iplib.cc:1357
SModulFunctions
Definition ipid.h:69
lSize
int lSize(lists L)
Definition lists.cc:25
mod2.h
assume
#define assume(x)
Definition mod2.h:389
mod_lib.h
lists
slists * lists
Definition mpr_numeric.h:146
coeffs
The main handler for Singular numbers which are suitable for Singular polynomials.
onestep
nforder * onestep(nforder *o, number p, coeffs c)
Definition nforder.cpp:608
pmaximal
nforder * pmaximal(nforder *o, number p)
Definition nforder.cpp:632
nforder.h
nforder_elt.h
EltCreateMat
number EltCreateMat(nforder *a, bigintmat *b)
n_nfOrderInit
BOOLEAN n_nfOrderInit(coeffs r, void *parameter)
nforder_type
EXTERN_VAR n_coeffType nforder_type
Definition nforder_elt.h:4
nf_idMult
nforder_ideal * nf_idMult(nforder_ideal *A, nforder_ideal *B)
Definition nforder_ideal.cc:170
nf_idPower
nforder_ideal * nf_idPower(nforder_ideal *A, int i)
Definition nforder_ideal.cc:305
nf_idAdd
nforder_ideal * nf_idAdd(nforder_ideal *A, nforder_ideal *B)
Definition nforder_ideal.cc:101
nforder_ideal.h
number2.h
nRegister
n_coeffType nRegister(n_coeffType n, cfInitCharProc p)
Definition numbers.cc:590
numbers.h
omAlloc
#define omAlloc(size)
Definition omAllocDecl.h:210
omFree
#define omFree(addr)
Definition omAllocDecl.h:261
omAlloc0
#define omAlloc0(size)
Definition omAllocDecl.h:211
NULL
#define NULL
Definition omList.c:12
coeffs_BIGINT
VAR coeffs coeffs_BIGINT
Definition polys.cc:14
currRing
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition polys.cc:13
StringSetS
void StringSetS(const char *st)
Definition reporter.cc:128
StringAppendS
void StringAppendS(const char *st)
Definition reporter.cc:107
StringEndS
char * StringEndS()
Definition reporter.cc:151
PrintLn
void PrintLn()
Definition reporter.cc:314
idhdl
idrec * idhdl
Definition ring.h:22
R
#define R
Definition sirandom.c:27
A
#define A
Definition sirandom.c:24
leftv
sleftv * leftv
Definition structs.h:53
IDHDL
#define IDHDL
Definition tok.h:31
BIGINT_CMD
@ BIGINT_CMD
Definition tok.h:38
CRING_CMD
@ CRING_CMD
Definition tok.h:56
LIST_CMD
@ LIST_CMD
Definition tok.h:118
CNUMBER_CMD
@ CNUMBER_CMD
Definition tok.h:47
INT_CMD
@ INT_CMD
Definition tok.h:96
MAX_TOK
@ MAX_TOK
Definition tok.h:220
NONE
#define NONE
Definition tok.h:223