Loading...
Searching...
No Matches
ipshell.cc File Reference
`#include "kernel/mod2.h"`
`#include "factory/factory.h"`
`#include "misc/options.h"`
`#include "misc/mylimits.h"`
`#include "misc/intvec.h"`
`#include "misc/prime.h"`
`#include "coeffs/numbers.h"`
`#include "coeffs/coeffs.h"`
`#include "coeffs/rmodulon.h"`
`#include "coeffs/longrat.h"`
`#include "polys/monomials/p_polys.h"`
`#include "polys/monomials/ring.h"`
`#include "polys/monomials/maps.h"`
`#include "polys/prCopy.h"`
`#include "polys/matpol.h"`
`#include "polys/shiftop.h"`
`#include "polys/weight.h"`
`#include "polys/clapsing.h"`
`#include "polys/ext_fields/algext.h"`
`#include "polys/ext_fields/transext.h"`
`#include "kernel/polys.h"`
`#include "kernel/ideals.h"`
`#include "kernel/numeric/mpr_base.h"`
`#include "kernel/numeric/mpr_numeric.h"`
`#include "kernel/GBEngine/syz.h"`
`#include "kernel/GBEngine/kstd1.h"`
`#include "kernel/GBEngine/kutil.h"`
`#include "kernel/combinatorics/stairc.h"`
`#include "kernel/combinatorics/hutil.h"`
`#include "kernel/spectrum/semic.h"`
`#include "kernel/spectrum/splist.h"`
`#include "kernel/spectrum/spectrum.h"`
`#include "kernel/oswrapper/feread.h"`
`#include "Singular/lists.h"`
`#include "Singular/attrib.h"`
`#include "Singular/ipconv.h"`
`#include "Singular/links/silink.h"`
`#include "Singular/ipshell.h"`
`#include "Singular/maps_ip.h"`
`#include "Singular/tok.h"`
`#include "Singular/ipid.h"`
`#include "Singular/subexpr.h"`
`#include "Singular/fevoices.h"`
`#include "Singular/sdb.h"`
`#include "Singular/feOpt.h"`
`#include <cmath>`
`#include <ctype.h>`
`#include "kernel/maps/gen_maps.h"`
`#include "libparse.h"`

Go to the source code of this file.

## Macros

#define | BREAK_LINE_LENGTH 80

## Enumerations

enum

semicState {
semicOK , semicMulNegative , semicListTooShort , semicListTooLong ,
semicListFirstElementWrongType , semicListSecondElementWrongType , semicListThirdElementWrongType , semicListFourthElementWrongType ,
semicListFifthElementWrongType , semicListSixthElementWrongType , semicListNNegative , semicListWrongNumberOfNumerators ,
semicListWrongNumberOfDenominators , semicListWrongNumberOfMultiplicities , semicListMuNegative , semicListPgNegative ,
semicListNumNegative , semicListDenNegative , semicListMulNegative , semicListNotSymmetric ,
semicListNotMonotonous , semicListMilnorWrong , semicListPGWrong
}

enum | spectrumState { spectrumOK , spectrumZero , spectrumBadPoly , spectrumNoSingularity , spectrumNotIsolated , spectrumDegenerate , spectrumWrongRing , spectrumNoHC , spectrumUnspecErr }

## Functions

const char * | iiTwoOps (int t)
int | iiOpsTwoChar (const char *s)
static void | list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
void | type_cmd (leftv v)
static void | killlocals0 (int v, idhdl *localhdl, const ring r)
void | killlocals_rec (idhdl *root, int v, ring r)
BOOLEAN | killlocals_list (int v, lists L)
void | killlocals (int v)
void | list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
void | test_cmd (int i)
int | exprlist_length (leftv v)
BOOLEAN | iiWRITE (leftv res, leftv v)
leftv | iiMap (map theMap, const char *what)
void | iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
static resolvente | iiCopyRes (resolvente r, int l)
BOOLEAN | jjMINRES (leftv res, leftv v)
BOOLEAN | jjBETTI (leftv res, leftv u)
BOOLEAN | jjBETTI2_ID (leftv res, leftv u, leftv v)
BOOLEAN | jjBETTI2 (leftv res, leftv u, leftv v)
int | iiRegularity (lists L)
void | iiDebug ()
lists | scIndIndset (ideal S, BOOLEAN all, ideal Q)
int | iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
BOOLEAN | iiDefaultParameter (leftv p)
BOOLEAN | iiBranchTo (leftv, leftv args)
BOOLEAN | iiParameter (leftv p)
static BOOLEAN | iiInternalExport (leftv v, int toLev)
BOOLEAN | iiInternalExport (leftv v, int toLev, package rootpack)
BOOLEAN | iiExport (leftv v, int toLev)
BOOLEAN | iiExport (leftv v, int toLev, package pack)
BOOLEAN | iiCheckRing (int i)
poly | iiHighCorner (ideal I, int ak)
| the largest monomial in R/I
void | iiCheckPack (package &p)
idhdl | rDefault (const char *s)
static idhdl | rSimpleFindHdl (const ring r, const idhdl root, const idhdl n)
idhdl | rFindHdl (ring r, idhdl n)
void | rDecomposeCF (leftv h, const ring r, const ring R)
static void | rDecomposeC_41 (leftv h, const coeffs C)
static void | rDecomposeC (leftv h, const ring R)
static void | rDecomposeRing_41 (leftv h, const coeffs C)
void | rDecomposeRing (leftv h, const ring R)
BOOLEAN | rDecompose_CF (leftv res, const coeffs C)
static void | rDecompose_23456 (const ring r, lists L)
lists | rDecompose_list_cf (const ring r)
lists | rDecompose (const ring r)
void | rComposeC (lists L, ring R)
void | rComposeRing (lists L, ring R)
static void | rRenameVars (ring R)
static BOOLEAN | rComposeVar (const lists L, ring R)
static BOOLEAN | rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
ring | rCompose (const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
BOOLEAN | mpJacobi (leftv res, leftv a)
BOOLEAN | mpKoszul (leftv res, leftv c, leftv b, leftv id)
BOOLEAN | syBetti2 (leftv res, leftv u, leftv w)
BOOLEAN | syBetti1 (leftv res, leftv u)
lists | syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
syStrategy | syConvList (lists li)
BOOLEAN | kWeight (leftv res, leftv id)
BOOLEAN | kQHWeight (leftv res, leftv v)
BOOLEAN | jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
BOOLEAN | jjCHARSERIES (leftv res, leftv u)
void | copy_deep (spectrum &spec, lists l)
spectrum | spectrumFromList (lists l)
lists | getList (spectrum &spec)
void | list_error (semicState state)
spectrumState | spectrumStateFromList (spectrumPolyList &speclist, lists *L, int fast)
spectrumState | spectrumCompute (poly h, lists *L, int fast)
void | spectrumPrintError (spectrumState state)
BOOLEAN | spectrumProc (leftv result, leftv first)
BOOLEAN | spectrumfProc (leftv result, leftv first)
semicState | list_is_spectrum (lists l)
BOOLEAN | spaddProc (leftv result, leftv first, leftv second)
BOOLEAN | spmulProc (leftv result, leftv first, leftv second)
BOOLEAN | semicProc3 (leftv res, leftv u, leftv v, leftv w)
BOOLEAN | semicProc (leftv res, leftv u, leftv v)
BOOLEAN | loNewtonP (leftv res, leftv arg1)
| compute Newton Polytopes of input polynomials
BOOLEAN | loSimplex (leftv res, leftv args)
| Implementation of the Simplex Algorithm.
BOOLEAN | nuMPResMat (leftv res, leftv arg1, leftv arg2)
| returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)
BOOLEAN | nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
| find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.
BOOLEAN | nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
| COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.
BOOLEAN | nuUResSolve (leftv res, leftv args)
| solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).
lists | listOfRoots (rootArranger *self, const unsigned int oprec)
void | rSetHdl (idhdl h)
static leftv | rOptimizeOrdAsSleftv (leftv ord)
BOOLEAN | rSleftvOrdering2Ordering (sleftv *ord, ring R)
static BOOLEAN | rSleftvList2StringArray (leftv sl, char **p)
ring | rInit (leftv pn, leftv rv, leftv ord)
ring | rSubring (ring org_ring, sleftv *rv)
void | rKill (ring r)
void | rKill (idhdl h)
BOOLEAN | jjPROC (leftv res, leftv u, leftv v)
static void | jjINT_S_TO_ID (int n, int *e, leftv res)
BOOLEAN | jjVARIABLES_P (leftv res, leftv u)
BOOLEAN | jjVARIABLES_ID (leftv res, leftv u)
void | paPrint (const char *n, package p)
BOOLEAN | iiApplyINTVEC (leftv res, leftv a, int op, leftv proc)
BOOLEAN | iiApplyBIGINTMAT (leftv, leftv, int, leftv)
BOOLEAN | iiApplyIDEAL (leftv, leftv, int, leftv)
BOOLEAN | iiApplyLIST (leftv res, leftv a, int op, leftv proc)
BOOLEAN | iiApply (leftv res, leftv a, int op, leftv proc)
BOOLEAN | iiTestAssume (leftv a, leftv b)
BOOLEAN | iiARROW (leftv r, char *a, char *s)
BOOLEAN | iiAssignCR (leftv r, leftv arg)
static void | iiReportTypes (int nr, int t, const short *T)
BOOLEAN | iiCheckTypes (leftv args, const short *type_list, int report)
| check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise
void | iiSetReturn (const leftv source)
int | siSetCpus (int cpu)

## Variables

VAR leftv | iiCurrArgs =NULL
VAR idhdl | iiCurrProc =NULL
const char * | lastreserved =NULL
STATIC_VAR BOOLEAN | iiNoKeepRing =TRUE
VAR BOOLEAN | iiDebugMarker =TRUE
const short | MAX_SHORT = 32767

## Macro Definition Documentation

## BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH 80

Definition at line 1072 of file ipshell.cc.

## Enumeration Type Documentation

## semicState

enum semicState

Enumerator
semicOK |
semicMulNegative |
semicListTooShort |
semicListTooLong |
semicListFirstElementWrongType |
semicListSecondElementWrongType |
semicListThirdElementWrongType |
semicListFourthElementWrongType |
semicListFifthElementWrongType |
semicListSixthElementWrongType |
semicListNNegative |
semicListWrongNumberOfNumerators |
semicListWrongNumberOfDenominators |
semicListWrongNumberOfMultiplicities |
semicListMuNegative |
semicListPgNegative |
semicListNumNegative |
semicListDenNegative |
semicListMulNegative |
semicListNotSymmetric |
semicListNotMonotonous |
semicListMilnorWrong |
semicListPGWrong |

Definition at line 3436 of file ipshell.cc.

{
semicOK,
semicMulNegative,
semicListTooShort,
semicListTooLong,
semicListFirstElementWrongType,
semicListSecondElementWrongType,
semicListThirdElementWrongType,
semicListFourthElementWrongType,
semicListFifthElementWrongType,
semicListSixthElementWrongType,
semicListNNegative,
semicListWrongNumberOfNumerators,
semicListWrongNumberOfDenominators,
semicListWrongNumberOfMultiplicities,
semicListMuNegative,
semicListPgNegative,
semicListNumNegative,
semicListDenNegative,
semicListMulNegative,
semicListNotSymmetric,
semicListNotMonotonous,
semicListMilnorWrong,
semicListPGWrong
} semicState;
semicState
semicState
Definition ipshell.cc:3437
semicListWrongNumberOfNumerators
@ semicListWrongNumberOfNumerators
Definition ipshell.cc:3452
semicListPGWrong
@ semicListPGWrong
Definition ipshell.cc:3466
semicListFirstElementWrongType
@ semicListFirstElementWrongType
Definition ipshell.cc:3444
semicListPgNegative
@ semicListPgNegative
Definition ipshell.cc:3457
semicListSecondElementWrongType
@ semicListSecondElementWrongType
Definition ipshell.cc:3445
semicListMilnorWrong
@ semicListMilnorWrong
Definition ipshell.cc:3465
semicListMulNegative
@ semicListMulNegative
Definition ipshell.cc:3460
semicListFourthElementWrongType
@ semicListFourthElementWrongType
Definition ipshell.cc:3447
semicListWrongNumberOfDenominators
@ semicListWrongNumberOfDenominators
Definition ipshell.cc:3453
semicListNotMonotonous
@ semicListNotMonotonous
Definition ipshell.cc:3463
semicListNotSymmetric
@ semicListNotSymmetric
Definition ipshell.cc:3462
semicListNNegative
@ semicListNNegative
Definition ipshell.cc:3451
semicListDenNegative
@ semicListDenNegative
Definition ipshell.cc:3459
semicListTooShort
@ semicListTooShort
Definition ipshell.cc:3441
semicListTooLong
@ semicListTooLong
Definition ipshell.cc:3442
semicListThirdElementWrongType
@ semicListThirdElementWrongType
Definition ipshell.cc:3446
semicListMuNegative
@ semicListMuNegative
Definition ipshell.cc:3456
semicListNumNegative
@ semicListNumNegative
Definition ipshell.cc:3458
semicMulNegative
@ semicMulNegative
Definition ipshell.cc:3439
semicListWrongNumberOfMultiplicities
@ semicListWrongNumberOfMultiplicities
Definition ipshell.cc:3454
semicOK
@ semicOK
Definition ipshell.cc:3438
semicListFifthElementWrongType
@ semicListFifthElementWrongType
Definition ipshell.cc:3448
semicListSixthElementWrongType
@ semicListSixthElementWrongType
Definition ipshell.cc:3449

## spectrumState

enum spectrumState

Enumerator
spectrumOK |
spectrumZero |
spectrumBadPoly |
spectrumNoSingularity |
spectrumNotIsolated |
spectrumDegenerate |
spectrumWrongRing |
spectrumNoHC |
spectrumUnspecErr |

Definition at line 3552 of file ipshell.cc.

{
spectrumOK,
spectrumZero,
spectrumBadPoly,
spectrumNoSingularity,
spectrumNotIsolated,
spectrumDegenerate,
spectrumWrongRing,
spectrumNoHC,
spectrumUnspecErr
};
spectrumWrongRing
@ spectrumWrongRing
Definition ipshell.cc:3560
spectrumOK
@ spectrumOK
Definition ipshell.cc:3554
spectrumDegenerate
@ spectrumDegenerate
Definition ipshell.cc:3559
spectrumUnspecErr
@ spectrumUnspecErr
Definition ipshell.cc:3562
spectrumNotIsolated
@ spectrumNotIsolated
Definition ipshell.cc:3558
spectrumBadPoly
@ spectrumBadPoly
Definition ipshell.cc:3556
spectrumNoSingularity
@ spectrumNoSingularity
Definition ipshell.cc:3557
spectrumZero
@ spectrumZero
Definition ipshell.cc:3555
spectrumNoHC
@ spectrumNoHC
Definition ipshell.cc:3561

## Function Documentation

## copy_deep()

void copy_deep | ( | spectrum & | spec,
|  | lists | l )

Definition at line 3362 of file ipshell.cc.

{
spec.mu = (int)(long)(l->m[0].Data( ));
spec.pg = (int)(long)(l->m[1].Data( ));
spec.n = (int)(long)(l->m[2].Data( ));
spec.copy_new( spec.n );
intvec *num = (intvec*)l->m[3].Data( );
intvec *den = (intvec*)l->m[4].Data( );
intvec *mul = (intvec*)l->m[5].Data( );
for( int i=0; i<spec.n; i++ )
{
spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
spec.w[i] = (*mul)[i];
}
}
num
CanonicalForm num(const CanonicalForm &f)
Definition canonicalform.h:337
den
CanonicalForm den(const CanonicalForm &f)
Definition canonicalform.h:340
l
int l
Definition cfEzgcd.cc:100
i
int i
Definition cfEzgcd.cc:132
Rational
Definition GMPrat.h:15
intvec
Definition intvec.h:24
spectrum::mu
int mu
Definition semic.h:67
spectrum::copy_new
void copy_new(int)
Definition semic.cc:54
spectrum::s
Rational * s
Definition semic.h:70
spectrum::n
int n
Definition semic.h:69
spectrum::pg
int pg
Definition semic.h:68
spectrum::w
int * w
Definition semic.h:71

## exprlist_length()

int exprlist_length | ( | leftv | v | ) |

Definition at line 551 of file ipshell.cc.

{
int rc = 0;
while (v!=NULL)
{
switch (v->Typ())
{
case INT_CMD:
case POLY_CMD:
case VECTOR_CMD:
case NUMBER_CMD:
rc++;
break;
case INTVEC_CMD:
case INTMAT_CMD:
rc += ((intvec *)(v->Data()))->length();
break;
case MATRIX_CMD:
case IDEAL_CMD:
case MODUL_CMD:
{
matrix mm = (matrix)(v->Data());
rc += mm->rows() * mm->cols();
}
break;
case LIST_CMD:
rc+=((lists)v->Data())->nr+1;
break;
default:
rc++;
}
v = v->next;
}
return rc;
}
ip_smatrix::cols
int & cols()
Definition matpol.h:24
ip_smatrix::rows
int & rows()
Definition matpol.h:23
v
const Variable & v
< [in] a sqrfree bivariate poly
Definition facBivar.h:39
IDEAL_CMD
@ IDEAL_CMD
Definition grammar.cc:285
MATRIX_CMD
@ MATRIX_CMD
Definition grammar.cc:287
INTMAT_CMD
@ INTMAT_CMD
Definition grammar.cc:280
MODUL_CMD
@ MODUL_CMD
Definition grammar.cc:288
VECTOR_CMD
@ VECTOR_CMD
Definition grammar.cc:293
NUMBER_CMD
@ NUMBER_CMD
Definition grammar.cc:289
POLY_CMD
@ POLY_CMD
Definition grammar.cc:290
matrix
ip_smatrix * matrix
Definition matpol.h:43
lists
slists * lists
Definition mpr_numeric.h:146
NULL
#define NULL
Definition omList.c:12
LIST_CMD
@ LIST_CMD
Definition tok.h:118
INTVEC_CMD
@ INTVEC_CMD
Definition tok.h:101
INT_CMD
@ INT_CMD
Definition tok.h:96

## getList()

lists getList | ( | spectrum & | spec | ) |

Definition at line 3398 of file ipshell.cc.

{
lists L = (lists)omAllocBin( slists_bin);
L->Init( 6 );
intvec *num = new intvec( spec.n );
intvec *den = new intvec( spec.n );
intvec *mult = new intvec( spec.n );
for( int i=0; i<spec.n; i++ )
{
(*num) [i] = spec.s[i].get_num_si( );
(*den) [i] = spec.s[i].get_den_si( );
(*mult)[i] = spec.w[i];
}
L->m[0].rtyp = INT_CMD; // milnor number
L->m[1].rtyp = INT_CMD; // geometrical genus
L->m[2].rtyp = INT_CMD; // # of spectrum numbers
L->m[3].rtyp = INTVEC_CMD; // numerators
L->m[4].rtyp = INTVEC_CMD; // denomiantors
L->m[5].rtyp = INTVEC_CMD; // multiplicities
L->m[0].data = (void*)(long)spec.mu;
L->m[1].data = (void*)(long)spec.pg;
L->m[2].data = (void*)(long)spec.n;
L->m[3].data = (void*)num;
L->m[4].data = (void*)den;
L->m[5].data = (void*)mult;
return L;
}
Rational::get_num_si
int get_num_si()
Definition GMPrat.cc:138
Rational::get_den_si
int get_den_si()
Definition GMPrat.cc:152
sleftv::rtyp
int rtyp
Definition subexpr.h:91
sleftv::data
void * data
Definition subexpr.h:88
slists::m
sleftv * m
Definition lists.h:46
slists::Init
INLINE_THIS void Init(int l=0)
slists_bin
VAR omBin slists_bin
Definition lists.cc:23
mult
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition minpoly.cc:647
omAllocBin
#define omAllocBin(bin)
Definition omAllocDecl.h:205

## iiApply()

BOOLEAN iiApply | ( | leftv | res,
|  | leftv | a,
|  | int | op,
|  | leftv | proc )

Definition at line 6431 of file ipshell.cc.

{
res->Init();
res->rtyp=a->Typ();
switch (res->rtyp /*a->Typ()*/)
{
case INTVEC_CMD:
case INTMAT_CMD:
return iiApplyINTVEC(res,a,op,proc);
case BIGINTMAT_CMD:
return iiApplyBIGINTMAT(res,a,op,proc);
case IDEAL_CMD:
case MODUL_CMD:
case MATRIX_CMD:
return iiApplyIDEAL(res,a,op,proc);
case LIST_CMD:
return iiApplyLIST(res,a,op,proc);
}
WerrorS("first argument to `apply` must allow an index");
return TRUE;
}
TRUE
#define TRUE
Definition auxiliary.h:101
proc
unsigned char * proc[NUM_PROC]
Definition checklibs.c:16
sleftv::Typ
int Typ()
Definition subexpr.cc:1048
res
CanonicalForm res
Definition facAbsFact.cc:60
WerrorS
void WerrorS(const char *s)
Definition feFopen.cc:24
BIGINTMAT_CMD
@ BIGINTMAT_CMD
Definition grammar.cc:278
iiApplyINTVEC
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6350
iiApplyLIST
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6392
iiApplyIDEAL
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6387
iiApplyBIGINTMAT
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6382

## iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT | ( | leftv | ,
|  | leftv | ,
|  | int | ,
|  | leftv | )

Definition at line 6382 of file ipshell.cc.

{
WerrorS("not implemented");
return TRUE;
}

## iiApplyIDEAL()

BOOLEAN iiApplyIDEAL | ( | leftv | ,
|  | leftv | ,
|  | int | ,
|  | leftv | )

Definition at line 6387 of file ipshell.cc.

{
WerrorS("not implemented");
return TRUE;
}

## iiApplyINTVEC()

BOOLEAN iiApplyINTVEC | ( | leftv | res,
|  | leftv | a,
|  | int | op,
|  | leftv | proc )

Definition at line 6350 of file ipshell.cc.

{
intvec *aa=(intvec*)a->Data();
sleftv tmp_out;
sleftv tmp_in;
leftv curr=res;
BOOLEAN bo=FALSE;
for(int i=0;i<aa->length(); i++)
{
tmp_in.Init();
tmp_in.rtyp=INT_CMD;
tmp_in.data=(void*)(long)(*aa)[i];
if (proc==NULL)
bo=iiExprArith1(&tmp_out,&tmp_in,op);
else
bo=jjPROC(&tmp_out,proc,&tmp_in);
if (bo)
{
res->CleanUp(currRing);
Werror("apply fails at index %d",i+1);
return TRUE;
}
if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
else
{
curr->next=(leftv)omAllocBin(sleftv_bin);
curr=curr->next;
memcpy(curr,&tmp_out,sizeof(tmp_out));
}
}
return FALSE;
}
BOOLEAN
int BOOLEAN
Definition auxiliary.h:88
FALSE
#define FALSE
Definition auxiliary.h:97
intvec::length
int length() const
Definition intvec.h:95
sleftv
Class used for (list of) interpreter objects.
Definition subexpr.h:83
sleftv::Data
void * Data()
Definition subexpr.cc:1192
sleftv::Init
void Init()
Definition subexpr.h:107
sleftv::next
leftv next
Definition subexpr.h:86
iiExprArith1
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition iparith.cc:9365
sleftv_bin
EXTERN_VAR omBin sleftv_bin
Definition ipid.h:145
jjPROC
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition iparith.cc:1617
currRing
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition polys.cc:13
Werror
void Werror(const char *fmt,...)
Definition reporter.cc:189
leftv
sleftv * leftv
Definition structs.h:53

## iiApplyLIST()

BOOLEAN iiApplyLIST | ( | leftv | res,
|  | leftv | a,
|  | int | op,
|  | leftv | proc )

Definition at line 6392 of file ipshell.cc.

{
lists aa=(lists)a->Data();
if (aa->nr==-1) /* empty list*/
{
lists l=(lists)omAllocBin(slists_bin);
l->Init();
res->data=(void *)l;
return FALSE;
}
sleftv tmp_out;
sleftv tmp_in;
leftv curr=res;
BOOLEAN bo=FALSE;
for(int i=0;i<=aa->nr; i++)
{
tmp_in.Init();
tmp_in.Copy(&(aa->m[i]));
if (proc==NULL)
bo=iiExprArith1(&tmp_out,&tmp_in,op);
else
bo=jjPROC(&tmp_out,proc,&tmp_in);
tmp_in.CleanUp();
if (bo)
{
res->CleanUp(currRing);
Werror("apply fails at index %d",i+1);
return TRUE;
}
if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
else
{
curr->next=(leftv)omAllocBin(sleftv_bin);
curr=curr->next;
memcpy(curr,&tmp_out,sizeof(tmp_out));
}
}
return FALSE;
}
sleftv::Copy
void Copy(leftv e)
Definition subexpr.cc:689
sleftv::CleanUp
void CleanUp(ring r=currRing)
Definition subexpr.cc:351
slists::nr
int nr
Definition lists.h:44

## iiARROW()

BOOLEAN iiARROW | ( | leftv | r,
|  | char * | a,
|  | char * | s )

Definition at line 6480 of file ipshell.cc.

{
size_t len=strlen(a)+strlen(s)+30; /* max. 27 currently */
char *ss=(char*)omAlloc(len);
// find end of s:
int end_s=strlen(s);
while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
s[end_s+1]='\0';
char *name=(char *)omAlloc(len);
snprintf(name,len,"%s->%s",a,s);
// find start of last expression
int start_s=end_s-1;
while ((start_s>=0) && (s[start_s]!=';')) start_s--;
if (start_s<0) // ';' not found
{
snprintf(ss,len,"parameter def %s;return(%s);\n",a,s);
}
else // s[start_s] is ';'
{
s[start_s]='\0';
snprintf(ss,len,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
}
r->Init();
// now produce procinfo for PROC_CMD:
r->data = (void *)omAlloc0Bin(procinfo_bin);
((procinfo *)(r->data))->language=LANG_NONE;
iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
((procinfo *)r->data)->data.s.body=ss;
omFree(name);
r->rtyp=PROC_CMD;
//r->rtyp=STRING_CMD;
//r->data=ss;
return FALSE;
}
s
const CanonicalForm int s
Definition facAbsFact.cc:51
name
char name(const Variable &v)
Definition factory.h:189
PROC_CMD
@ PROC_CMD
Definition grammar.cc:281
iiInitSingularProcinfo
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition iplib.cc:1059
omAlloc
#define omAlloc(size)
Definition omAllocDecl.h:210
omAlloc0Bin
#define omAlloc0Bin(bin)
Definition omAllocDecl.h:206
omFree
#define omFree(addr)
Definition omAllocDecl.h:261
procinfo_bin
VAR omBin procinfo_bin
Definition subexpr.cc:42
LANG_NONE
@ LANG_NONE
Definition subexpr.h:22
procinfo
Definition subexpr.h:54

## iiAssignCR()

BOOLEAN iiAssignCR | ( | leftv | r,
|  | leftv | arg )

Definition at line 6515 of file ipshell.cc.

{
char* ring_name=omStrDup((char*)r->Name());
int t=arg->Typ();
if (t==RING_CMD)
{
sleftv tmp;
tmp.Init();
tmp.rtyp=IDHDL;
idhdl h=enterid(ring_name, myynest, RING_CMD, &IDROOT);
IDRING(h)=NULL;
tmp.data=(char*)h;
if (h!=NULL)
{
tmp.name=h->id;
BOOLEAN b=iiAssign(&tmp,arg);
if (b) return TRUE;
rSetHdl(ggetid(ring_name));
omFree(ring_name);
return FALSE;
}
else
return TRUE;
}
else if (t==CRING_CMD)
{
sleftv tmp;
sleftv n;
n.Init();
n.name=ring_name;
if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
if (iiAssign(&tmp,arg)) return TRUE;
//Print("create %s\n",r->Name());
//Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
return FALSE;
}
//Print("create %s\n",r->Name());
//Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
return TRUE;// not handled -> error for now
}
b
CanonicalForm b
Definition cfModGcd.cc:4111
sleftv::name
const char * name
Definition subexpr.h:87
sleftv::Name
const char * Name()
Definition subexpr.h:120
myynest
VAR int myynest
Definition febase.cc:41
RING_CMD
@ RING_CMD
Definition grammar.cc:282
iiAssign
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition ipassign.cc:2099
ggetid
idhdl ggetid(const char *n)
Definition ipid.cc:581
enterid
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:279
IDROOT
#define IDROOT
Definition ipid.h:19
IDRING
#define IDRING(a)
Definition ipid.h:127
iiDeclCommand
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition ipshell.cc:1206
rSetHdl
void rSetHdl(idhdl h)
Definition ipshell.cc:5129
h
STATIC_VAR Poly * h
Definition janet.cc:971
omStrDup
#define omStrDup(s)
Definition omAllocDecl.h:263
idhdl
idrec * idhdl
Definition ring.h:22
IDHDL
#define IDHDL
Definition tok.h:31
CRING_CMD
@ CRING_CMD
Definition tok.h:56

## iiBranchTo()

BOOLEAN iiBranchTo | ( | leftv | r,
|  | leftv | args )

Definition at line 1281 of file ipshell.cc.

{
// must be inside a proc, as we simultae an proc_end at the end
if (myynest==0)
{
WerrorS("branchTo can only occur in a proc");
return TRUE;
}
// <string1...stringN>,<proc>
// known: args!=NULL, l>=1
int l=args->listLength();
int ll=0;
if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
if (ll!=(l-1)) return FALSE;
leftv h=args;
// set up the table for type test:
short *t=(short*)omAlloc(l*sizeof(short));
t[0]=l-1;
int b;
int i;
for(i=1;i<l;i++,h=h->next)
{
if (h->Typ()!=STRING_CMD)
{
omFreeBinAddr(t);
Werror("arg %d is not a string",i);
return TRUE;
}
int tt;
b=IsCmd((char *)h->Data(),tt);
if(b) t[i]=tt;
else
{
omFreeBinAddr(t);
Werror("arg %d is not a type name",i);
return TRUE;
}
}
if (h->Typ()!=PROC_CMD)
{
omFreeBinAddr(t);
Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
return TRUE;
}
b=iiCheckTypes(iiCurrArgs,t,0);
omFreeBinAddr(t);
if (b && (h->rtyp==IDHDL) && (h->e==NULL))
{
// get the proc:
iiCurrProc=(idhdl)h->data;
idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
procinfo * pi=IDPROC(currProc);
// already loaded ?
if( pi->data.s.body==NULL )
{
iiGetLibProcBuffer(pi);
if (pi->data.s.body==NULL) return TRUE;
}
// set currPackHdl/currPack
if ((pi->pack!=NULL)&&(currPack!=pi->pack))
{
currPack=pi->pack;
iiCheckPack(currPack);
currPackHdl=packFindHdl(currPack);
//Print("set pack=%s\n",IDID(currPackHdl));
}
// see iiAllStart:
BITSET save1=si_opt_1;
BITSET save2=si_opt_2;
newBuffer( omStrDup(pi->data.s.body), BT_proc,
pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
BOOLEAN err=yyparse();
iiCurrProc=NULL;
si_opt_1=save1;
si_opt_2=save2;
// now save the return-expr.
sLastPrinted.CleanUp(currRing);
memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
iiRETURNEXPR.Init();
// warning about args.:
if (iiCurrArgs!=NULL)
{
if (err==0) Warn("too many arguments for %s",IDID(currProc));
iiCurrArgs->CleanUp();
omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
iiCurrArgs=NULL;
}
// similate proc_end:
// - leave input
void myychangebuffer();
myychangebuffer();
// - set the current buffer to its end (this is a pointer in a buffer,
// not a file ptr) "branchTo" is only valid in proc)
currentVoice->fptr=strlen(currentVoice->buffer);
// - kill local vars
killlocals(myynest);
// - return
newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
return (err!=0);
}
return FALSE;
}
BITSET
#define BITSET
Definition auxiliary.h:85
ADDRESS
void * ADDRESS
Definition auxiliary.h:120
sleftv::listLength
int listLength()
Definition subexpr.cc:51
Warn
#define Warn
Definition emacs.cc:77
newBuffer
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition fevoices.cc:166
currentVoice
VAR Voice * currentVoice
Definition fevoices.cc:49
BT_execute
@ BT_execute
Definition fevoices.h:23
BT_proc
@ BT_proc
Definition fevoices.h:20
Tok2Cmdname
const char * Tok2Cmdname(int tok)
Definition gentable.cc:137
yyparse
int yyparse(void)
Definition grammar.cc:2149
IsCmd
int IsCmd(const char *n, int &tok)
Definition iparith.cc:9773
currPack
VAR package currPack
Definition ipid.cc:55
currPackHdl
VAR idhdl currPackHdl
Definition ipid.cc:53
packFindHdl
idhdl packFindHdl(package r)
Definition ipid.cc:828
IDPROC
#define IDPROC(a)
Definition ipid.h:140
IDID
#define IDID(a)
Definition ipid.h:122
iiRETURNEXPR
INST_VAR sleftv iiRETURNEXPR
Definition iplib.cc:483
iiGetLibProcBuffer
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition iplib.cc:197
iiCurrProc
VAR idhdl iiCurrProc
Definition ipshell.cc:82
iiCheckPack
void iiCheckPack(package &p)
Definition ipshell.cc:1631
iiCheckTypes
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition ipshell.cc:6576
killlocals
void killlocals(int v)
Definition ipshell.cc:387
iiCurrArgs
VAR leftv iiCurrArgs
Definition ipshell.cc:81
pi
#define pi
Definition libparse.cc:1145
omFreeBin
#define omFreeBin(addr, bin)
Definition omAllocDecl.h:259
omFreeBinAddr
#define omFreeBinAddr(addr)
Definition omAllocDecl.h:258
si_opt_2
VAR unsigned si_opt_2
Definition options.c:6
si_opt_1
VAR unsigned si_opt_1
Definition options.c:5
myychangebuffer
void myychangebuffer()
Definition scanner.cc:2311
sLastPrinted
INST_VAR sleftv sLastPrinted
Definition subexpr.cc:46
STRING_CMD
@ STRING_CMD
Definition tok.h:187

## iiCheckPack()

void iiCheckPack | ( | package & | p | ) |

Definition at line 1631 of file ipshell.cc.

{
if (p!=basePack)
{
idhdl t=basePack->idroot;
while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
if (t==NULL)
{
WarnS("package not found\n");
p=basePack;
}
}
}
p
int p
Definition cfModGcd.cc:4086
idrec::next
idhdl next
Definition idrec.h:38
WarnS
#define WarnS
Definition emacs.cc:78
basePack
VAR package basePack
Definition ipid.cc:56
IDPACKAGE
#define IDPACKAGE(a)
Definition ipid.h:139
IDTYP
#define IDTYP(a)
Definition ipid.h:119
PACKAGE_CMD
@ PACKAGE_CMD
Definition tok.h:150

## iiCheckRing()

BOOLEAN iiCheckRing | ( | int | i | ) |

Definition at line 1585 of file ipshell.cc.

{
if (currRing==NULL)
{
#ifdef SIQ
if (siq<=0)
{
#endif
if (RingDependend(i))
{
WerrorS("no ring active (9)");
return TRUE;
}
#ifdef SIQ
}
#endif
}
return FALSE;
}
RingDependend
static int RingDependend(int t)
Definition gentable.cc:23
siq
VAR BOOLEAN siq
Definition subexpr.cc:48

## iiCheckTypes()

BOOLEAN iiCheckTypes | ( | leftv | args,
|  | const short * | type_list,
|  | int | report )

check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise

Parameters

  type_list | < [in] argument list (may be NULL) [in] field of types len, t1,t2,...
  report | ;in] report error?

Definition at line 6576 of file ipshell.cc.

{
int l=0;
if (args==NULL)
{
if (type_list[0]==0) return TRUE;
}
else l=args->listLength();
if (l!=(int)type_list[0])
{
if (report) iiReportTypes(0,l,type_list);
return FALSE;
}
for(int i=1;i<=l;i++,args=args->next)
{
short t=type_list[i];
if (t!=ANY_TYPE)
{
if (((t==IDHDL)&&(args->rtyp!=IDHDL))
|| (t!=args->Typ()))
{
if (report) iiReportTypes(i,args->Typ(),type_list);
return FALSE;
}
}
}
return TRUE;
}
iiReportTypes
static void iiReportTypes(int nr, int t, const short *T)
Definition ipshell.cc:6556
ANY_TYPE
#define ANY_TYPE
Definition tok.h:30

## iiCopyRes()

resolvente iiCopyRes | ( | resolvente | r,
|  | int | l )

static

Definition at line 944 of file ipshell.cc.

{
int i;
resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
for (i=0; i<l; i++)
if (r[i]!=NULL) res[i]=idCopy(r[i]);
return res;
}
idCopy
ideal idCopy(ideal A)
Definition ideals.h:60
resolvente
ideal * resolvente
Definition ideals.h:18
omAlloc0
#define omAlloc0(size)
Definition omAllocDecl.h:211

## iiDebug()

void iiDebug | ( |  | ) |

Definition at line 1073 of file ipshell.cc.

{
#ifdef HAVE_SDB
sdb_flags=1;
#endif
Print("\n-- break point in %s --\n",VoiceName());
if (iiDebugMarker) VoiceBackTrack();
char * s;
iiDebugMarker=FALSE;
s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
loop
{
memset(s,0,BREAK_LINE_LENGTH+4);
fe_fgets_stdin("",s,BREAK_LINE_LENGTH);
if (s[BREAK_LINE_LENGTH-1]!='\0')
{
Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
}
else
break;
}
if (*s=='\n')
{
iiDebugMarker=TRUE;
}
#if MDEBUG
else if(strncmp(s,"cont;",5)==0)
{
iiDebugMarker=TRUE;
}
#endif /* MDEBUG */
else
{
strcat( s, "\n;~\n");
newBuffer(s,BT_execute);
}
}
Print
#define Print
Definition emacs.cc:80
fe_fgets_stdin
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition feread.cc:32
VoiceName
const char * VoiceName()
Definition fevoices.cc:58
VoiceBackTrack
void VoiceBackTrack()
Definition fevoices.cc:77
iiDebugMarker
VAR BOOLEAN iiDebugMarker
Definition ipshell.cc:1071
BREAK_LINE_LENGTH
#define BREAK_LINE_LENGTH
Definition ipshell.cc:1072
sdb_flags
VAR int sdb_flags
Definition sdb.cc:31
loop
#define loop
Definition structs.h:71

## iiDeclCommand()

int iiDeclCommand | ( | leftv | sy,
|  | leftv | name,
|  | int | lev,
|  | int | t,
|  | idhdl * | root,
|  | BOOLEAN | isring,
|  | BOOLEAN | init_b )

Definition at line 1206 of file ipshell.cc.

{
BOOLEAN res=FALSE;
BOOLEAN is_qring=FALSE;
const char *id = name->name;
sy->Init();
if ((name->name==NULL)||(isdigit(name->name[0])))
{
WerrorS("object to declare is not a name");
res=TRUE;
}
else
{
if (root==NULL) return TRUE;
if (*root!=IDROOT)
{
if ((currRing==NULL) || (*root!=currRing->idroot))
{
Werror("can not define `%s` in other package",name->name);
return TRUE;
}
}
if (t==QRING_CMD)
{
t=RING_CMD; // qring is always RING_CMD
is_qring=TRUE;
}
if (TEST_V_ALLWARN
&& (name->rtyp!=0)
&& (name->rtyp!=IDHDL)
&& (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
{
Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
currentVoice->filename,yylineno,my_yylinebuf);
}
{
sy->data = (char *)enterid(id,lev,t,root,init_b);
}
if (sy->data!=NULL)
{
sy->rtyp=IDHDL;
currid=sy->name=IDID((idhdl)sy->data);
if (is_qring)
{
IDFLAG((idhdl)sy->data)=sy->flag=Sy_bit(FLAG_QRING_DEF);
}
// name->name=NULL; /* used in enterid */
//sy->e = NULL;
if (name->next!=NULL)
{
sy->next=(leftv)omAllocBin(sleftv_bin);
res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
}
}
else res=TRUE;
}
name->CleanUp();
return res;
}
sleftv::flag
BITSET flag
Definition subexpr.h:90
yylineno
VAR int yylineno
Definition febase.cc:40
my_yylinebuf
VAR char my_yylinebuf[80]
Definition febase.cc:44
currid
const char * currid
Definition grammar.cc:171
currRingHdl
VAR idhdl currRingHdl
Definition ipid.cc:57
IDFLAG
#define IDFLAG(a)
Definition ipid.h:120
FLAG_QRING_DEF
#define FLAG_QRING_DEF
Definition ipid.h:109
IDLEV
#define IDLEV(a)
Definition ipid.h:121
TEST_V_ALLWARN
#define TEST_V_ALLWARN
Definition options.h:145
Sy_bit
#define Sy_bit(x)
Definition options.h:31
QRING_CMD
@ QRING_CMD
Definition tok.h:160

## iiDefaultParameter()

BOOLEAN iiDefaultParameter | ( | leftv | p | ) |

Definition at line 1268 of file ipshell.cc.

{
attr at=NULL;
if (iiCurrProc!=NULL)
at=iiCurrProc->attribute->get("default_arg");
if (at==NULL)
return FALSE;
sleftv tmp;
tmp.Init();
tmp.rtyp=at->atyp;
tmp.data=at->CopyA();
return iiAssign(p,&tmp);
}
attr
sattr * attr
Definition attrib.h:16
sattr::CopyA
void * CopyA()
Definition subexpr.cc:2192
sattr::atyp
int atyp
Definition attrib.h:27

## iiExport() [1/2]

BOOLEAN iiExport | ( | leftv | v,
|  | int | toLev )

Definition at line 1510 of file ipshell.cc.

{
BOOLEAN nok=FALSE;
leftv r=v;
while (v!=NULL)
{
if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
{
Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
nok=TRUE;
}
else
{
if(iiInternalExport(v, toLev))
nok=TRUE;
}
v=v->next;
}
r->CleanUp();
return nok;
}
iiInternalExport
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition ipshell.cc:1411

## iiExport() [2/2]

BOOLEAN iiExport | ( | leftv | v,
|  | int | toLev,
|  | package | pack )

Definition at line 1533 of file ipshell.cc.

{
// if ((pack==basePack)&&(pack!=currPack))
// { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
BOOLEAN nok=FALSE;
leftv rv=v;
while (v!=NULL)
{
if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
)
{
Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
nok=TRUE;
}
else
{
idhdl old=pack->idroot->get( v->name,toLev);
if (old!=NULL)
{
if ((pack==currPack) && (old==(idhdl)v->data))
{
if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
break;
}
else if (IDTYP(old)==v->Typ())
{
if (BVERBOSE(V_REDEFINE))
{
Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
}
v->name=omStrDup(v->name);
killhdl2(old,&(pack->idroot),currRing);
}
else
{
rv->CleanUp();
return TRUE;
}
}
//Print("iiExport: pack=%s\n",IDID(root));
if(iiInternalExport(v, toLev, pack))
{
rv->CleanUp();
return TRUE;
}
}
v=v->next;
}
rv->CleanUp();
return nok;
}
killhdl2
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition ipid.cc:445
BVERBOSE
#define BVERBOSE(a)
Definition options.h:35
V_REDEFINE
#define V_REDEFINE
Definition options.h:45

## iiHighCorner()

poly iiHighCorner | ( | ideal | I,
|  | int | ak )

the largest monomial in R/I

Definition at line 1606 of file ipshell.cc.

{
int i;
if(!idIsZeroDim(I)) return NULL; // not zero-dim.
poly po=NULL;
if (rHasLocalOrMixedOrdering(currRing))
{
scComputeHC(I,currRing->qideal,ak,po);
if (po!=NULL)
{
pGetCoeff(po)=nInit(1);
for (i=rVar(currRing); i>0; i--)
{
int e;
if ((e=pGetExp(po, i)) > 0) pSetExp(po,i,e-1);
}
pSetComp(po,ak);
pSetm(po);
}
}
else
po=pOne();
return po;
}
scComputeHC
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition hdegree.cc:1074
idIsZeroDim
static BOOLEAN idIsZeroDim(ideal i)
Definition ideals.h:180
pGetCoeff
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition monomials.h:44
nInit
#define nInit(i)
Definition numbers.h:24
pSetm
#define pSetm(p)
Definition polys.h:272
pSetComp
#define pSetComp(p, v)
Definition polys.h:39
pGetExp
#define pGetExp(p, i)
Exponent.
Definition polys.h:42
pSetExp
#define pSetExp(p, i, v)
Definition polys.h:43
pOne
#define pOne()
Definition polys.h:316
rHasLocalOrMixedOrdering
static BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:769
rVar
static short rVar(const ring r)
define rVar(r) (r->N)
Definition ring.h:598

## iiInternalExport() [1/2]

BOOLEAN iiInternalExport | ( | leftv | v,
|  | int | toLev )

static

Definition at line 1411 of file ipshell.cc.

{
idhdl h=(idhdl)v->data;
//Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
if (IDLEV(h)==0)
{
if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
}
else
{
h=IDROOT->get(v->name,toLev);
idhdl *root=&IDROOT;
if ((h==NULL)&&(currRing!=NULL))
{
h=currRing->idroot->get(v->name,toLev);
root=&currRing->idroot;
}
BOOLEAN keepring=FALSE;
if ((h!=NULL)&&(IDLEV(h)==toLev))
{
if (IDTYP(h)==v->Typ())
{
if ((IDTYP(h)==RING_CMD)
&& (v->Data()==IDDATA(h)))
{
rIncRefCnt(IDRING(h));
keepring=TRUE;
IDLEV(h)=toLev;
//WarnS("keepring");
return FALSE;
}
if (BVERBOSE(V_REDEFINE))
{
Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
}
if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
killhdl2(h,root,currRing);
}
else
{
WerrorS("object with a different type exists");
return TRUE;
}
}
h=(idhdl)v->data;
IDLEV(h)=toLev;
if (keepring) rDecRefCnt(IDRING(h));
iiNoKeepRing=FALSE;
//Print("export %s\n",IDID(h));
}
return FALSE;
}
IDDATA
#define IDDATA(a)
Definition ipid.h:126
iiLocalRing
VAR ring * iiLocalRing
Definition iplib.cc:482
iiNoKeepRing
STATIC_VAR BOOLEAN iiNoKeepRing
Definition ipshell.cc:85
rIncRefCnt
static ring rIncRefCnt(ring r)
Definition ring.h:849
rDecRefCnt
static void rDecRefCnt(ring r)
Definition ring.h:850

## iiInternalExport() [2/2]

BOOLEAN iiInternalExport | ( | leftv | v,
|  | int | toLev,
|  | package | rootpack )

Definition at line 1464 of file ipshell.cc.

{
idhdl h=(idhdl)v->data;
if(h==NULL)
{
Warn("'%s': no such identifier\n", v->name);
return FALSE;
}
package frompack=v->req_packhdl;
if (frompack==NULL) frompack=currPack;
if ((RingDependend(IDTYP(h)))
|| ((IDTYP(h)==LIST_CMD)
&& (lRingDependend(IDLIST(h)))
)
)
{
//Print("// ==> Ringdependent set nesting to 0\n");
return (iiInternalExport(v, toLev));
}
else
{
IDLEV(h)=toLev;
v->req_packhdl=rootpack;
if (h==frompack->idroot)
{
frompack->idroot=h->next;
}
else
{
idhdl hh=frompack->idroot;
while ((hh!=NULL) && (hh->next!=h))
hh=hh->next;
if ((hh!=NULL) && (hh->next==h))
hh->next=h->next;
else
{
Werror("`%s` not found",v->Name());
return TRUE;
}
}
h->next=rootpack->idroot;
rootpack->idroot=h;
}
return FALSE;
}
IDLIST
#define IDLIST(a)
Definition ipid.h:137
lRingDependend
BOOLEAN lRingDependend(lists L)
Definition lists.cc:222

## iiMakeResolv()

void iiMakeResolv | ( | resolvente | r,
|  | int | length,
|  | int | rlen,
|  | char * | name,
|  | int | typ0,
|  | intvec ** | weights )

Definition at line 854 of file ipshell.cc.

{
lists L=liMakeResolv(r,length,rlen,typ0,weights);
int i=0;
idhdl h;
size_t len=strlen(name)+5;
char * s=(char *)omAlloc(len);
while (i<=L->nr)
{
snprintf(s,len,"%s(%d)",name,i+1);
if (i==0)
h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
else
h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
if (h!=NULL)
{
h->data.uideal=(ideal)L->m[i].data;
h->attribute=L->m[i].attribute;
if (BVERBOSE(V_DEF_RES))
Print("//defining: %s as %d-th syzygy module\n",s,i+1);
}
else
{
idDelete((ideal *)&(L->m[i].data));
Warn("cannot define %s",s);
}
//L->m[i].data=NULL;
//L->m[i].rtyp=0;
//L->m[i].attribute=NULL;
i++;
}
omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
omFreeBin((ADDRESS)L, slists_bin);
omFreeSize((ADDRESS)s,strlen(name)+5);
}
sleftv::attribute
attr attribute
Definition subexpr.h:89
idDelete
#define idDelete(H)
delete an ideal
Definition ideals.h:29
length
static BOOLEAN length(leftv result, leftv arg)
Definition interval.cc:257
liMakeResolv
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition lists.cc:239
omFreeSize
#define omFreeSize(addr, size)
Definition omAllocDecl.h:260
V_DEF_RES
#define V_DEF_RES
Definition options.h:50

## iiMap()

leftv iiMap | ( | map | theMap,
|  | const char * | what )

Definition at line 618 of file ipshell.cc.

{
idhdl w,r;
leftv v;
int i;
nMapFunc nMap;
r=IDROOT->get(theMap->preimage,myynest);
if ((currPack!=basePack)
&&((r==NULL) || ((r->typ != RING_CMD) )))
r=basePack->idroot->get(theMap->preimage,myynest);
if ((r==NULL) && (currRingHdl!=NULL)
&& (strcmp(theMap->preimage,IDID(currRingHdl))==0))
{
r=currRingHdl;
}
if ((r!=NULL) && (r->typ == RING_CMD))
{
ring src_ring=IDRING(r);
if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
{
Werror("can not map from ground field of %s to current ground field",
theMap->preimage);
return NULL;
}
if (IDELEMS(theMap)<src_ring->N)
{
theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
IDELEMS(theMap)*sizeof(poly),
(src_ring->N)*sizeof(poly));
#ifdef HAVE_SHIFTBBA
if (rIsLPRing(src_ring))
{
// src_ring [x,y,z,...]
// curr_ring [a,b,c,...]
//
// map=[a,b,c,d] -> [a,b,c,...]
// map=[a,b] -> [a,b,0,...]
short src_lV = src_ring->isLPring;
short src_ncGenCount = src_ring->LPncGenCount;
short src_nVars = src_lV - src_ncGenCount;
int src_nblocks = src_ring->N / src_lV;
short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
short dest_ncGenCount = currRing->LPncGenCount;
// add missing NULL generators
for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
{
theMap->m[i]=NULL;
}
// remove superfluous generators
for(i = src_nVars; i < IDELEMS(theMap); i++)
{
if (theMap->m[i] != NULL)
{
p_Delete(&(theMap->m[i]), currRing);
theMap->m[i] = NULL;
}
}
// add ncgen mappings
for(i = src_nVars; i < src_lV; i++)
{
short ncGenIndex = i - src_nVars;
if (ncGenIndex < dest_ncGenCount)
{
poly p = p_One(currRing);
p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
p_Setm(p, currRing);
theMap->m[i] = p;
}
else
{
theMap->m[i] = NULL;
}
}
// copy the first block to all other blocks
for(i = 1; i < src_nblocks; i++)
{
for(int j = 0; j < src_lV; j++)
{
theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
}
}
}
else
{
#endif
for(i=IDELEMS(theMap);i<src_ring->N;i++)
theMap->m[i]=NULL;
#ifdef HAVE_SHIFTBBA
}
#endif
IDELEMS(theMap)=src_ring->N;
}
if (what==NULL)
{
WerrorS("argument of a map must have a name");
}
else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
{
char *save_r=NULL;
v=(leftv)omAlloc0Bin(sleftv_bin);
sleftv tmpW;
tmpW.Init();
tmpW.rtyp=IDTYP(w);
if (tmpW.rtyp==MAP_CMD)
{
tmpW.rtyp=IDEAL_CMD;
save_r=IDMAP(w)->preimage;
IDMAP(w)->preimage=0;
}
tmpW.data=IDDATA(w);
// check overflow
BOOLEAN overflow=FALSE;
if ((tmpW.rtyp==IDEAL_CMD)
|| (tmpW.rtyp==MODUL_CMD)
|| (tmpW.rtyp==SMATRIX_CMD)
|| (tmpW.rtyp==MAP_CMD))
{
ideal id=(ideal)tmpW.data;
long *degs=NULL;
if (IDELEMS(id)>0) degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
for(int i=IDELEMS(id)-1;i>=0;i--)
{
poly p=id->m[i];
if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
else degs[i]=0;
}
for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
{
if (theMap->m[j]!=NULL)
{
long deg_monexp=pTotaldegree(theMap->m[j]);
for(int i=IDELEMS(id)-1;i>=0;i--)
{
poly p=id->m[i];
if ((p!=NULL) && (degs[i]!=0) &&
((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
{
overflow=TRUE;
break;
}
}
}
}
if (degs!=NULL) omFreeSize(degs,IDELEMS(id)*sizeof(long));
}
else if ((tmpW.rtyp==POLY_CMD)
|| (tmpW.rtyp==VECTOR_CMD))
{
for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
{
if (theMap->m[j]!=NULL)
{
long deg_monexp=pTotaldegree(theMap->m[j]);
poly p=(poly)tmpW.data;
long deg=0;
if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
{
overflow=TRUE;
break;
}
}
}
}
if (overflow)
#ifdef HAVE_SHIFTBBA
// in Letterplace rings the exponent is always 0 or 1! ignore this warning.
if (!rIsLPRing(currRing))
{
#endif
Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
#ifdef HAVE_SHIFTBBA
}
#endif
#if 0
if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
{
v->rtyp=tmpW.rtyp;
v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
}
else
#endif
{
if ((tmpW.rtyp==IDEAL_CMD)
||(tmpW.rtyp==MODUL_CMD)
||(tmpW.rtyp==MATRIX_CMD)
||(tmpW.rtyp==SMATRIX_CMD)
||(tmpW.rtyp==MAP_CMD))
{
v->rtyp=tmpW.rtyp;
char *tmp = theMap->preimage;
theMap->preimage=(char*)1L;
// map gets 1 as its rank (as an ideal)
v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
theMap->preimage=tmp; // map gets its preimage back
}
if (v->data==NULL) /*i.e. not IDEAL/MODUL/SMATRIX/MATRIX/MAP */
{
if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
{
Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
omFreeBin((ADDRESS)v, sleftv_bin);
if (save_r!=NULL) IDMAP(w)->preimage=save_r;
return NULL;
}
}
}
if (save_r!=NULL)
{
IDMAP(w)->preimage=save_r;
IDMAP((idhdl)v)->preimage=omStrDup(save_r);
v->rtyp=MAP_CMD;
}
return v;
}
else
{
Werror("%s undefined in %s",what,theMap->preimage);
}
}
else
{
Werror("cannot find preimage %s",theMap->preimage);
}
return NULL;
}
idrec::typ
int typ
Definition idrec.h:43
n_SetMap
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition coeffs.h:703
nMapFunc
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition coeffs.h:80
w
const CanonicalForm & w
Definition facAbsFact.cc:51
j
int j
Definition facHensel.cc:110
maMapIdeal
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition gen_maps.cc:88
MAP_CMD
@ MAP_CMD
Definition grammar.cc:286
SMATRIX_CMD
@ SMATRIX_CMD
Definition grammar.cc:292
idIs0
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
Definition simpleideals.cc:960
IDMAP
#define IDMAP(a)
Definition ipid.h:135
IDIDEAL
#define IDIDEAL(a)
Definition ipid.h:133
maApplyFetch
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition maps_ip.cc:45
omReallocSize
#define omReallocSize(addr, o_size, size)
Definition omAllocDecl.h:220
p_One
poly p_One(const ring r)
Definition p_polys.cc:1314
p_SetExp
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition p_polys.h:490
p_Setm
static void p_Setm(poly p, const ring r)
Definition p_polys.h:235
p_Delete
static void p_Delete(poly *p, const ring r)
Definition p_polys.h:903
p_Copy
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition p_polys.h:848
p_Totaldegree
static long p_Totaldegree(poly p, const ring r)
Definition p_polys.h:1528
pTotaldegree
static long pTotaldegree(poly p)
Definition polys.h:283
polyset
poly * polyset
Definition polys.h:260
rIsLPRing
static BOOLEAN rIsLPRing(const ring r)
Definition ring.h:417
idInit
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition simpleideals.cc:35
IDELEMS
#define IDELEMS(i)
Definition simpleideals.h:23

## iiOpsTwoChar()

int iiOpsTwoChar | ( | const char * | s | ) |

Definition at line 122 of file ipshell.cc.

{
/* not handling: &&, ||, ** */
if (s[1]=='\0') return s[0];
else if (s[2]!='\0') return 0;
switch(s[0])
{
case '.': if (s[1]=='.') return DOTDOT;
else return 0;
case ':': if (s[1]==':') return COLONCOLON;
else return 0;
case '-': if (s[1]=='-') return MINUSMINUS;
else return 0;
case '+': if (s[1]=='+') return PLUSPLUS;
else return 0;
case '=': if (s[1]=='=') return EQUAL_EQUAL;
else return 0;
case '<': if (s[1]=='=') return LE;
else if (s[1]=='>') return NOTEQUAL;
else return 0;
case '>': if (s[1]=='=') return GE;
else return 0;
case '!': if (s[1]=='=') return NOTEQUAL;
else return 0;
}
return 0;
}
PLUSPLUS
@ PLUSPLUS
Definition grammar.cc:274
MINUSMINUS
@ MINUSMINUS
Definition grammar.cc:271
GE
@ GE
Definition grammar.cc:269
EQUAL_EQUAL
@ EQUAL_EQUAL
Definition grammar.cc:268
LE
@ LE
Definition grammar.cc:270
NOTEQUAL
@ NOTEQUAL
Definition grammar.cc:273
DOTDOT
@ DOTDOT
Definition grammar.cc:267
COLONCOLON
@ COLONCOLON
Definition grammar.cc:275

## iiParameter()

BOOLEAN iiParameter | ( | leftv | p | ) |

Definition at line 1384 of file ipshell.cc.

{
if (iiCurrArgs==NULL)
{
if (strcmp(p->name,"#")==0)
return iiDefaultParameter(p);
Werror("not enough arguments for proc %s",VoiceName());
p->CleanUp();
return TRUE;
}
leftv h=iiCurrArgs;
leftv rest=h->next; /*iiCurrArgs is not NULL here*/
if (strcmp(p->name,"#")==0)
{
rest=NULL;
}
else
{
h->next=NULL;
}
BOOLEAN res=iiAssign(p,h);
iiCurrArgs=rest; // may be NULL
h->CleanUp();
omFreeBin((ADDRESS)h, sleftv_bin);
return res;
}
iiDefaultParameter
BOOLEAN iiDefaultParameter(leftv p)
Definition ipshell.cc:1268

## iiRegularity()

int iiRegularity | ( | lists | L | ) |

Definition at line 1045 of file ipshell.cc.

{
int len,reg,typ0;
resolvente r=liFindRes(L,&len,&typ0);
if (r==NULL)
return -2;
intvec *weights=NULL;
int add_row_shift=0;
intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
if (ww!=NULL)
{
weights=ivCopy(ww);
add_row_shift = ww->min_in();
(*weights) -= add_row_shift;
}
//Print("attr:%x\n",weights);
intvec *dummy=syBetti(r,len,&reg,weights);
if (weights!=NULL) delete weights;
delete dummy;
omFreeSize((ADDRESS)r,len*sizeof(ideal));
return reg+1+add_row_shift;
}
atGet
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition attrib.cc:132
intvec::min_in
int min_in()
Definition intvec.h:122
ivCopy
intvec * ivCopy(const intvec *o)
Definition intvec.h:146
liFindRes
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition lists.cc:344
syBetti
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition syz.cc:787

## iiReportTypes()

void iiReportTypes | ( | int | nr,
|  | int | t,
|  | const short * | T )

static

Definition at line 6556 of file ipshell.cc.

{
char buf[250];
buf[0]='\0';
if (nr==0)
snprintf(buf,250,"wrong length of parameters(%d), expected ",t);
else if (t==0)
snprintf(buf,250,"par. %d is of undefined, expected ",nr);
else
snprintf(buf,250,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
for(int i=1;i<=T[0];i++)
{
strcat(buf,"`");
strcat(buf,Tok2Cmdname(T[i]));
strcat(buf,"`");
if (i<T[0]) strcat(buf,",");
}
WerrorS(buf);
}
T
STATIC_VAR jList * T
Definition janet.cc:30
buf
int status int void * buf
Definition si_signals.h:69

## iiSetReturn()

void iiSetReturn | ( | const leftv | source | ) |

Definition at line 6634 of file ipshell.cc.

{
if ((source->next==NULL)&&(source->e==NULL))
{
if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
{
memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
source->Init();
return;
}
if (source->rtyp==IDHDL)
{
if ((IDLEV((idhdl)source->data)==myynest)
&&(IDTYP((idhdl)source->data)!=RING_CMD))
{
iiRETURNEXPR.Init();
iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
iiRETURNEXPR.data=IDDATA((idhdl)source->data);
iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
iiRETURNEXPR.attribute=IDATTR((idhdl)source->data);
IDATTR((idhdl)source->data)=NULL;
IDDATA((idhdl)source->data)=NULL;
source->name=NULL;
source->attribute=NULL;
return;
}
}
}
iiRETURNEXPR.Copy(source);
}
sleftv::e
Subexpr e
Definition subexpr.h:105
IDATTR
#define IDATTR(a)
Definition ipid.h:123
ALIAS_CMD
@ ALIAS_CMD
Definition tok.h:34

## iiTestAssume()

BOOLEAN iiTestAssume | ( | leftv | a,
|  | leftv | b )

Definition at line 6453 of file ipshell.cc.

{
// assume a: level
if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
{
if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
char assume_yylinebuf[80];
strncpy(assume_yylinebuf,my_yylinebuf,79);
int lev=(long)a->Data();
int startlev=0;
idhdl h=ggetid("assumeLevel");
if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
if(lev <=startlev)
{
BOOLEAN bo=b->Eval();
if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
}
}
b->CleanUp();
a->CleanUp();
return FALSE;
}
IDINT
#define IDINT(a)
Definition ipid.h:125

## iiTwoOps()

const char * iiTwoOps | ( | int | t | ) |

Definition at line 89 of file ipshell.cc.

{
if (t<127)
{
STATIC_VAR char ch[2];
switch (t)
{
case '&':
return "and";
case '|':
return "or";
default:
ch[0]=t;
ch[1]='\0';
return ch;
}
}
switch (t)
{
case COLONCOLON: return "::";
case DOTDOT: return "..";
//case PLUSEQUAL: return "+=";
//case MINUSEQUAL: return "-=";
case MINUSMINUS: return "--";
case PLUSPLUS: return "++";
case EQUAL_EQUAL: return "==";
case LE: return "<=";
case GE: return ">=";
case NOTEQUAL: return "<>";
default: return Tok2Cmdname(t);
}
}
STATIC_VAR
#define STATIC_VAR
Definition globaldefs.h:7

## iiWRITE()

BOOLEAN iiWRITE | ( | leftv | res,
|  | leftv | v )

Definition at line 587 of file ipshell.cc.

{
sleftv vf;
if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
{
WerrorS("link expected");
return TRUE;
}
si_link l=(si_link)vf.Data();
if (vf.next == NULL)
{
WerrorS("write: need at least two arguments");
return TRUE;
}
BOOLEAN b;
if (strcmp(l->mode,"string")==0)
b=ssiWrite2(l,res,vf.next);
else
b=slWrite(l,vf.next); /* iiConvert preserves next */
if (b)
{
const char *s;
if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
else s=sNoName_fe;
Werror("cannot write to %s",s);
}
vf.CleanUp();
return b;
}
sNoName_fe
const char sNoName_fe[]
Definition fevoices.cc:57
iiTestConvert
int iiTestConvert(int inputType, int outputType)
Definition gentable.cc:298
iiConvert
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition ipconv.cc:450
slWrite
BOOLEAN slWrite(si_link l, leftv v)
Definition silink.cc:307
si_link
ip_link * si_link
Definition silink.h:20
ssiWrite2
BOOLEAN ssiWrite2(si_link l, leftv res, leftv v)
Definition ssiLink.cc:3475
LINK_CMD
@ LINK_CMD
Definition tok.h:117

## jjBETTI()

BOOLEAN jjBETTI | ( | leftv | res,
|  | leftv | u )

Definition at line 975 of file ipshell.cc.

{
sleftv tmp;
tmp.Init();
tmp.rtyp=INT_CMD;
tmp.data=(void *)1;
if ((u->Typ()==IDEAL_CMD)
|| (u->Typ()==MODUL_CMD))
return jjBETTI2_ID(res,u,&tmp);
else
return jjBETTI2(res,u,&tmp);
}
jjBETTI2_ID
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition ipshell.cc:988
jjBETTI2
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition ipshell.cc:1009

## jjBETTI2()

BOOLEAN jjBETTI2 | ( | leftv | res,
|  | leftv | u,
|  | leftv | v )

Definition at line 1009 of file ipshell.cc.

{
resolvente r;
int len;
int reg,typ0;
lists l=(lists)u->Data();
intvec *weights=NULL;
int add_row_shift=0;
intvec *ww=NULL;
if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
if (ww!=NULL)
{
weights=ivCopy(ww);
add_row_shift = ww->min_in();
(*weights) -= add_row_shift;
}
//Print("attr:%x\n",weights);
r=liFindRes(l,&len,&typ0);
if (r==NULL) return TRUE;
intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
res->data=(void*)res_im;
omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
//Print("rowShift: %d ",add_row_shift);
for(int i=1;i<=res_im->rows();i++)
{
if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
else break;
}
//Print(" %d\n",add_row_shift);
atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
if (weights!=NULL) delete weights;
return FALSE;
}
atSet
void atSet(idhdl root, char *name, void *data, int typ)
Definition attrib.cc:153
intvec::rows
int rows() const
Definition intvec.h:97
IMATELEM
#define IMATELEM(M, I, J)
Definition intvec.h:86

## jjBETTI2_ID()

BOOLEAN jjBETTI2_ID | ( | leftv | res,
|  | leftv | u,
|  | leftv | v )

Definition at line 988 of file ipshell.cc.

{
lists l=(lists) omAllocBin(slists_bin);
l->Init(1);
l->m[0].rtyp=u->Typ();
l->m[0].data=u->Data();
attr *a=u->Attribute();
if (a!=NULL)
l->m[0].attribute=*a;
sleftv tmp2;
tmp2.Init();
tmp2.rtyp=LIST_CMD;
tmp2.data=(void *)l;
BOOLEAN r=jjBETTI2(res,&tmp2,v);
l->m[0].data=NULL;
l->m[0].attribute=NULL;
l->m[0].rtyp=DEF_CMD;
l->Clean();
return r;
}
sleftv::Attribute
attr * Attribute()
Definition subexpr.cc:1505
tmp2
CFList tmp2
Definition facFqBivar.cc:75
DEF_CMD
@ DEF_CMD
Definition tok.h:58

## jjCHARSERIES()

BOOLEAN jjCHARSERIES | ( | leftv | res,
|  | leftv | u )

Definition at line 3349 of file ipshell.cc.

{
res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
return (res->data==NULL);
}
singclap_irrCharSeries
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition clapsing.cc:1614

## jjINT_S_TO_ID()

void jjINT_S_TO_ID | ( | int | n,
|  | int * | e,
|  | leftv | res )

static

Definition at line 6288 of file ipshell.cc.

{
if (n==0) n=1;
ideal l=idInit(n,1);
int i;
poly p;
for(i=rVar(currRing);i>0;i--)
{
if (e[i]>0)
{
n--;
p=pOne();
pSetExp(p,i,1);
pSetm(p);
l->m[n]=p;
if (n==0) break;
}
}
res->data=(char*)l;
setFlag(res,FLAG_STD);
omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
}
setFlag
#define setFlag(A, F)
Definition ipid.h:113
FLAG_STD
#define FLAG_STD
Definition ipid.h:106

## jjMINRES()

BOOLEAN jjMINRES | ( | leftv | res,
|  | leftv | v )

Definition at line 954 of file ipshell.cc.

{
int len=0;
int typ0;
lists L=(lists)v->Data();
intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
int add_row_shift = 0;
if (weights==NULL)
weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
if (weights!=NULL) add_row_shift=weights->min_in();
resolvente rr=liFindRes(L,&len,&typ0);
if (rr==NULL) return TRUE;
resolvente r=iiCopyRes(rr,len);
syMinimizeResolvente(r,len,0);
omFreeSize((ADDRESS)rr,len*sizeof(ideal));
len++;
res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
return FALSE;
}
iiCopyRes
static resolvente iiCopyRes(resolvente r, int l)
Definition ipshell.cc:944
syMinimizeResolvente
void syMinimizeResolvente(resolvente res, int length, int first)
Definition syz.cc:367

## jjPROC()

BOOLEAN jjPROC | ( | leftv | res,
|  | leftv | u,
|  | leftv | v )

extern

Definition at line 1617 of file iparith.cc.

{
void *d;
Subexpr e;
int typ;
BOOLEAN t=FALSE;
idhdl tmp_proc=NULL;
if ((u->rtyp!=IDHDL)||(u->e!=NULL))
{
tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
tmp_proc->id="_auto";
tmp_proc->typ=PROC_CMD;
tmp_proc->data.pinf=(procinfo *)u->Data();
tmp_proc->ref=1;
d=u->data; u->data=(void *)tmp_proc;
e=u->e; u->e=NULL;
t=TRUE;
typ=u->rtyp; u->rtyp=IDHDL;
}
BOOLEAN sl;
if (u->req_packhdl==currPack)
sl = iiMake_proc((idhdl)u->data,NULL,v);
else
sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
if (t)
{
u->rtyp=typ;
u->data=d;
u->e=e;
omFreeSize(tmp_proc,sizeof(idrec));
}
if (sl) return TRUE;
memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
iiRETURNEXPR.Init();
return FALSE;
}
idrec
Definition idrec.h:35
idrec::data
utypes data
Definition idrec.h:40
idrec::ref
short ref
Definition idrec.h:46
idrec::id
const char * id
Definition idrec.h:39
sleftv::req_packhdl
package req_packhdl
Definition subexpr.h:106
iiMake_proc
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition iplib.cc:513

## jjRESULTANT()

BOOLEAN jjRESULTANT | ( | leftv | res,
|  | leftv | u,
|  | leftv | v,
|  | leftv | w )

Definition at line 3342 of file ipshell.cc.

{
res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
(poly)w->CopyD(), currRing);
return errorreported;
}
singclap_resultant
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition clapsing.cc:357
sleftv::CopyD
void * CopyD(int t)
Definition subexpr.cc:714
errorreported
VAR short errorreported
Definition feFopen.cc:23

## jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID | ( | leftv | res,
|  | leftv | u )

Definition at line 6318 of file ipshell.cc.

{
int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
ideal I=(ideal)u->Data();
int i;
int n=0;
for(i=I->nrows*I->ncols-1;i>=0;i--)
{
int n0=pGetVariables(I->m[i],e);
if (n0>n) n=n0;
}
jjINT_S_TO_ID(n,e,res);
return FALSE;
}
jjINT_S_TO_ID
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition ipshell.cc:6288
pGetVariables
#define pGetVariables(p, e)
Definition polys.h:252

## jjVARIABLES_P()

BOOLEAN jjVARIABLES_P | ( | leftv | res,
|  | leftv | u )

Definition at line 6310 of file ipshell.cc.

{
int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
int n=pGetVariables((poly)u->Data(),e);
jjINT_S_TO_ID(n,e,res);
return FALSE;
}

## killlocals()

void killlocals | ( | int | v | ) |

Definition at line 387 of file ipshell.cc.

{
BOOLEAN changed=FALSE;
idhdl sh=currRingHdl;
ring cr=currRing;
if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
//if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
killlocals_rec(&(basePack->idroot),v,currRing);
if (iiRETURNEXPR_len > myynest)
{
int t=iiRETURNEXPR.Typ();
if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
{
leftv h=&iiRETURNEXPR;
if (((ring)h->data)->idroot!=NULL)
killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
}
else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
{
leftv h=&iiRETURNEXPR;
changed |=killlocals_list(v,(lists)h->data);
}
}
if (changed)
{
currRingHdl=rFindHdl(cr,NULL);
if (currRingHdl==NULL)
currRing=NULL;
else if(cr!=currRing)
rChangeCurrRing(cr);
}
if (myynest<=1) iiNoKeepRing=TRUE;
//Print("end killlocals >= %d\n",v);
//listall();
}
iiRETURNEXPR_len
VAR int iiRETURNEXPR_len
Definition iplib.cc:484
killlocals_list
BOOLEAN killlocals_list(int v, lists L)
Definition ipshell.cc:367
rFindHdl
idhdl rFindHdl(ring r, idhdl n)
Definition ipshell.cc:1701
killlocals_rec
void killlocals_rec(idhdl *root, int v, ring r)
Definition ipshell.cc:331
killlocals0
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition ipshell.cc:296
rChangeCurrRing
void rChangeCurrRing(ring r)
Definition polys.cc:16

## killlocals0()

void killlocals0 | ( | int | v,
|  | idhdl * | localhdl,
|  | const ring | r )

static

Definition at line 296 of file ipshell.cc.

{
idhdl h = *localhdl;
while (h!=NULL)
{
int vv;
//Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
if ((vv=IDLEV(h))>0)
{
if (vv < v)
{
if (iiNoKeepRing)
{
//PrintS(" break\n");
return;
}
h = IDNEXT(h);
//PrintLn();
}
else //if (vv >= v)
{
idhdl nexth = IDNEXT(h);
killhdl2(h,localhdl,r);
h = nexth;
//PrintS("kill\n");
}
}
else
{
h = IDNEXT(h);
//PrintLn();
}
}
}
IDNEXT
#define IDNEXT(a)
Definition ipid.h:118

## killlocals_list()

BOOLEAN killlocals_list | ( | int | v,
|  | lists | L )

Definition at line 367 of file ipshell.cc.

{
if (L==NULL) return FALSE;
BOOLEAN changed=FALSE;
int n=L->nr;
for(;n>=0;n--)
{
leftv h=&(L->m[n]);
void *d=h->data;
if ((h->rtyp==RING_CMD)
&& (((ring)d)->idroot!=NULL))
{
if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
}
else if (h->rtyp==LIST_CMD)
changed|=killlocals_list(v,(lists)d);
}
return changed;
}

## killlocals_rec()

void killlocals_rec | ( | idhdl * | root,
|  | int | v,
|  | ring | r )

Definition at line 331 of file ipshell.cc.

{
idhdl h=*root;
while (h!=NULL)
{
if (IDLEV(h)>=v)
{
// Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
idhdl n=IDNEXT(h);
killhdl2(h,root,r);
h=n;
}
else if (IDTYP(h)==PACKAGE_CMD)
{
// Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
if (IDPACKAGE(h)!=basePack)
killlocals_rec(&(IDRING(h)->idroot),v,r);
h=IDNEXT(h);
}
else if (IDTYP(h)==RING_CMD)
{
if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
// we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
{
// Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
}
h=IDNEXT(h);
}
else
{
// Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
h=IDNEXT(h);
}
}
}

## kQHWeight()

BOOLEAN kQHWeight | ( | leftv | res,
|  | leftv | v )

Definition at line 3325 of file ipshell.cc.

{
res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
if (res->data==NULL)
res->data=(char *)new intvec(rVar(currRing));
return FALSE;
}
id_QHomWeight
intvec * id_QHomWeight(ideal id, const ring r)
Definition simpleideals.cc:1917

## kWeight()

BOOLEAN kWeight | ( | leftv | res,
|  | leftv | id )

Definition at line 3297 of file ipshell.cc.

{
ideal F=(ideal)id->Data();
intvec * iv = new intvec(rVar(currRing));
polyset s;
int sl, n, i;
int *x;
res->data=(char *)iv;
s = F->m;
sl = IDELEMS(F) - 1;
n = rVar(currRing);
if (sl==-1)
{
for(int i=0;i<n;i++) (*iv)[i]=1;
return FALSE;
}
double wNsqr = (double)2.0 / (double)n;
wFunctional = wFunctionalBuch;
x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
wCall(s, sl, x, wNsqr, currRing);
for (i = n; i!=0; i--)
(*iv)[i-1] = x[i + n + 1];
omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
return FALSE;
}
x
Variable x
Definition cfModGcd.cc:4090
wFunctional
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight.cc:20
wCall
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition weight.cc:108
wFunctionalBuch
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight0.cc:78

## list1()

void list1 | ( | const char * | s,
|  | idhdl | h,
|  | BOOLEAN | c,
|  | BOOLEAN | fullname )

static

Definition at line 150 of file ipshell.cc.

{
char buffer[22];
int l;
char buf2[128];
if(fullname) snprintf(buf2,128, "%s::%s", "", IDID(h));
else snprintf(buf2,128, "%s", IDID(h));
Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
if (h == currRingHdl) PrintS("*");
PrintS(Tok2Cmdname((int)IDTYP(h)));
ipListFlag(h);
switch(IDTYP(h))
{
case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
case INT_CMD: Print(" %d",IDINT(h)); break;
case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
break;
case POLY_CMD:
case VECTOR_CMD:if (c)
{
PrintS(" ");wrp(IDPOLY(h));
if(IDPOLY(h) != NULL)
{
Print(", %d monomial(s)",pLength(IDPOLY(h)));
}
}
break;
case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));// and continue
case IDEAL_CMD: Print(", %u generator(s)",
IDELEMS(IDIDEAL(h))); break;
case MAP_CMD:
Print(" from %s",IDMAP(h)->preimage); break;
case MATRIX_CMD:Print(" %u x %u"
,MATROWS(IDMATRIX(h))
,MATCOLS(IDMATRIX(h))
);
break;
case SMATRIX_CMD:Print(" %u x %u"
,(int)(IDIDEAL(h)->rank)
,IDELEMS(IDIDEAL(h))
);
break;
case PACKAGE_CMD:
paPrint(IDID(h),IDPACKAGE(h));
break;
case PROC_CMD: if((IDPROC(h)->libname!=NULL)
&& (strlen(IDPROC(h)->libname)>0))
Print(" from %s",IDPROC(h)->libname);
if(IDPROC(h)->language==LANG_C)
PrintS(" (C)");
if(IDPROC(h)->is_static)
PrintS(" (static)");
break;
case STRING_CMD:
{
char *s;
l=strlen(IDSTRING(h));
memset(buffer,0,sizeof(buffer));
strncpy(buffer,IDSTRING(h),si_min(l,20));
if ((s=strchr(buffer,'\n'))!=NULL)
{
*s='\0';
}
PrintS(" ");
PrintS(buffer);
if((s!=NULL) ||(l>20))
{
Print("..., %d char(s)",l);
}
break;
}
case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
break;
case RING_CMD:
if ((IDRING(h)==currRing) && (currRingHdl!=h))
PrintS("(*)"); /* this is an alias to currRing */
//Print(" ref:%d",IDRING(h)->ref);
#ifdef RDEBUG
if (traceit &TRACE_SHOW_RINGS)
Print(" <%lx>",(long)(IDRING(h)));
#endif
break;
#ifdef SINGULAR_4_2
case CNUMBER_CMD:
{ number2 n=(number2)IDDATA(h);
Print(" (%s)",nCoeffName(n->cf));
break;
}
case CMATRIX_CMD:
{ bigintmat *b=(bigintmat*)IDDATA(h);
Print(" %d x %d (%s)",
b->rows(),b->cols(),
nCoeffName(b->basecoeffs()));
break;
}
#endif
/*default: break;*/
}
PrintLn();
}
si_min
static int si_min(const int a, const int b)
Definition auxiliary.h:126
bigintmat
Matrices of numbers.
Definition bigintmat.h:51
nCoeffName
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition coeffs.h:962
buf2
CanonicalForm buf2
Definition facFqBivar.cc:76
ipListFlag
void ipListFlag(idhdl h)
Definition ipid.cc:619
IDMATRIX
#define IDMATRIX(a)
Definition ipid.h:134
IDSTRING
#define IDSTRING(a)
Definition ipid.h:136
IDINTVEC
#define IDINTVEC(a)
Definition ipid.h:128
IDPOLY
#define IDPOLY(a)
Definition ipid.h:130
paPrint
void paPrint(const char *n, package p)
Definition ipshell.cc:6333
MATROWS
#define MATROWS(i)
Definition matpol.h:26
MATCOLS
#define MATCOLS(i)
Definition matpol.h:27
pLength
static int pLength(poly a)
Definition p_polys.h:190
wrp
void wrp(poly p)
Definition polys.h:311
PrintS
void PrintS(const char *s)
Definition reporter.cc:288
PrintLn
void PrintLn()
Definition reporter.cc:314
traceit
EXTERN_VAR int traceit
Definition reporter.h:24
TRACE_SHOW_RINGS
#define TRACE_SHOW_RINGS
Definition reporter.h:36
LANG_C
@ LANG_C
Definition subexpr.h:22
CMATRIX_CMD
@ CMATRIX_CMD
Definition tok.h:46
CNUMBER_CMD
@ CNUMBER_CMD
Definition tok.h:47

## list_cmd()

void list_cmd | ( | int | typ,
|  | const char * | what,
|  | const char * | prefix,
|  | BOOLEAN | iterate,
|  | BOOLEAN | fullname )

Definition at line 426 of file ipshell.cc.

{
package savePack=currPack;
idhdl h,start;
BOOLEAN all = typ<0;
BOOLEAN really_all=FALSE;
if ( typ==0 )
{
if (strcmp(what,"all")==0)
{
if (currPack!=basePack)
list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
really_all=TRUE;
h=basePack->idroot;
}
else
{
h = ggetid(what);
if (h!=NULL)
{
if (iterate) list1(prefix,h,TRUE,fullname);
if (IDTYP(h)==ALIAS_CMD) PrintS("A");
if (IDTYP(h)==RING_CMD)
{
h=IDRING(h)->idroot;
}
else if(IDTYP(h)==PACKAGE_CMD)
{
currPack=IDPACKAGE(h);
//Print("list_cmd:package\n");
all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
h=IDPACKAGE(h)->idroot;
}
else
{
currPack=savePack;
return;
}
}
else
{
Werror("%s is undefined",what);
currPack=savePack;
return;
}
}
all=TRUE;
}
else if (RingDependend(typ))
{
h = currRing->idroot;
}
else
h = IDROOT;
start=h;
while (h!=NULL)
{
if ((all
&& (IDTYP(h)!=PROC_CMD)
&&(IDTYP(h)!=PACKAGE_CMD)
&&(IDTYP(h)!=CRING_CMD)
)
|| (typ == IDTYP(h))
|| ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
)
{
list1(prefix,h,start==currRingHdl, fullname);
if ((IDTYP(h)==RING_CMD)
&& (really_all || (all && (h==currRingHdl)))
&& ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
{
list_cmd(0,IDID(h),"// ",FALSE);
}
if (IDTYP(h)==PACKAGE_CMD && really_all)
{
package save_p=currPack;
currPack=IDPACKAGE(h);
list_cmd(0,IDID(h),"// ",FALSE);
currPack=save_p;
}
}
h = IDNEXT(h);
}
currPack=savePack;
}
list_cmd
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition ipshell.cc:426
list1
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition ipshell.cc:150

## list_error()

void list_error | ( | semicState | state | ) |

Definition at line 3470 of file ipshell.cc.

{
switch( state )
{
case semicListTooShort:
WerrorS( "the list is too short" );
break;
case semicListTooLong:
WerrorS( "the list is too long" );
break;
case semicListFirstElementWrongType:
WerrorS( "first element of the list should be int" );
break;
case semicListSecondElementWrongType:
WerrorS( "second element of the list should be int" );
break;
case semicListThirdElementWrongType:
WerrorS( "third element of the list should be int" );
break;
case semicListFourthElementWrongType:
WerrorS( "fourth element of the list should be intvec" );
break;
case semicListFifthElementWrongType:
WerrorS( "fifth element of the list should be intvec" );
break;
case semicListSixthElementWrongType:
WerrorS( "sixth element of the list should be intvec" );
break;
case semicListNNegative:
WerrorS( "first element of the list should be positive" );
break;
case semicListWrongNumberOfNumerators:
WerrorS( "wrong number of numerators" );
break;
case semicListWrongNumberOfDenominators:
WerrorS( "wrong number of denominators" );
break;
case semicListWrongNumberOfMultiplicities:
WerrorS( "wrong number of multiplicities" );
break;
case semicListMuNegative:
WerrorS( "the Milnor number should be positive" );
break;
case semicListPgNegative:
WerrorS( "the geometrical genus should be nonnegative" );
break;
case semicListNumNegative:
WerrorS( "all numerators should be positive" );
break;
case semicListDenNegative:
WerrorS( "all denominators should be positive" );
break;
case semicListMulNegative:
WerrorS( "all multiplicities should be positive" );
break;
case semicListNotSymmetric:
WerrorS( "it is not symmetric" );
break;
case semicListNotMonotonous:
WerrorS( "it is not monotonous" );
break;
case semicListMilnorWrong:
WerrorS( "the Milnor number is wrong" );
break;
case semicListPGWrong:
WerrorS( "the geometrical genus is wrong" );
break;
default:
WerrorS( "unspecific error" );
break;
}
}

## list_is_spectrum()

semicState list_is_spectrum | ( | lists | l | ) |

Definition at line 4256 of file ipshell.cc.

{
// -------------------
// check list length
// -------------------
if( l->nr < 5 )
{
return semicListTooShort;
}
else if( l->nr > 5 )
{
return semicListTooLong;
}
// -------------
// check types
// -------------
if( l->m[0].rtyp != INT_CMD )
{
return semicListFirstElementWrongType;
}
else if( l->m[1].rtyp != INT_CMD )
{
return semicListSecondElementWrongType;
}
else if( l->m[2].rtyp != INT_CMD )
{
return semicListThirdElementWrongType;
}
else if( l->m[3].rtyp != INTVEC_CMD )
{
return semicListFourthElementWrongType;
}
else if( l->m[4].rtyp != INTVEC_CMD )
{
return semicListFifthElementWrongType;
}
else if( l->m[5].rtyp != INTVEC_CMD )
{
return semicListSixthElementWrongType;
}
// -------------------------
// check number of entries
// -------------------------
int mu = (int)(long)(l->m[0].Data( ));
int pg = (int)(long)(l->m[1].Data( ));
int n = (int)(long)(l->m[2].Data( ));
if( n <= 0 )
{
return semicListNNegative;
}
intvec *num = (intvec*)l->m[3].Data( );
intvec *den = (intvec*)l->m[4].Data( );
intvec *mul = (intvec*)l->m[5].Data( );
if( n != num->length( ) )
{
return semicListWrongNumberOfNumerators;
}
else if( n != den->length( ) )
{
return semicListWrongNumberOfDenominators;
}
else if( n != mul->length( ) )
{
return semicListWrongNumberOfMultiplicities;
}
// --------
// values
// --------
if( mu <= 0 )
{
return semicListMuNegative;
}
if( pg < 0 )
{
return semicListPgNegative;
}
int i;
for( i=0; i<n; i++ )
{
if( (*num)[i] <= 0 )
{
return semicListNumNegative;
}
if( (*den)[i] <= 0 )
{
return semicListDenNegative;
}
if( (*mul)[i] <= 0 )
{
return semicListMulNegative;
}
}
// ----------------
// check symmetry
// ----------------
int j;
for( i=0, j=n-1; i<=j; i++,j-- )
{
if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
(*den)[i] != (*den)[j] ||
(*mul)[i] != (*mul)[j] )
{
return semicListNotSymmetric;
}
}
// ----------------
// check monotony
// ----------------
for( i=0, j=1; i<n/2; i++,j++ )
{
if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
{
return semicListNotMonotonous;
}
}
// ---------------------
// check Milnor number
// ---------------------
for( mu=0, i=0; i<n; i++ )
{
mu += (*mul)[i];
}
if( mu != (int)(long)(l->m[0].Data( )) )
{
return semicListMilnorWrong;
}
// -------------------------
// check geometrical genus
// -------------------------
for( pg=0, i=0; i<n; i++ )
{
if( (*num)[i]<=(*den)[i] )
{
pg += (*mul)[i];
}
}
if( pg != (int)(long)(l->m[1].Data( )) )
{
return semicListPGWrong;
}
return semicOK;
}
mu
static matrix mu(matrix A, const ring R)
Definition matpol.cc:2028

## listOfRoots()

lists listOfRoots | ( | rootArranger * | self,
|  | const unsigned int | oprec )

Definition at line 5082 of file ipshell.cc.

{
int i,j;
int count= self->roots[0]->getAnzRoots(); // number of roots
int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
if ( self->found_roots )
{
listofroots->Init( count );
for (i=0; i < count; i++)
{
lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
onepoint->Init(elem);
for ( j= 0; j < elem; j++ )
{
if ( !rField_is_long_C(currRing) )
{
onepoint->m[j].rtyp=STRING_CMD;
onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
}
else
{
onepoint->m[j].rtyp=NUMBER_CMD;
onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
}
onepoint->m[j].next= NULL;
onepoint->m[j].name= NULL;
}
listofroots->m[i].rtyp=LIST_CMD;
listofroots->m[i].data=(void *)onepoint;
listofroots->m[j].next= NULL;
listofroots->m[j].name= NULL;
}
}
else
{
listofroots->Init( 0 );
}
return listofroots;
}
rootArranger::roots
rootContainer ** roots
Definition mpr_numeric.h:167
rootArranger::found_roots
bool found_roots
Definition mpr_numeric.h:172
rootContainer::getRoot
gmp_complex * getRoot(const int i)
Definition mpr_numeric.h:88
rootContainer::getAnzRoots
int getAnzRoots()
Definition mpr_numeric.h:97
rootContainer::getAnzElems
int getAnzElems()
Definition mpr_numeric.h:95
slists
Definition lists.h:24
n_Copy
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition coeffs.h:457
complexToStr
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition mpr_complex.cc:693
rField_is_long_C
static BOOLEAN rField_is_long_C(const ring r)
Definition ring.h:551
count
int status int void size_t count
Definition si_signals.h:69

## loNewtonP()

BOOLEAN loNewtonP | ( | leftv | res,
|  | leftv | arg1 )

compute Newton Polytopes of input polynomials

Definition at line 4566 of file ipshell.cc.

{
res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
return FALSE;
}
loNewtonPolytope
ideal loNewtonPolytope(const ideal id)
Definition mpr_base.cc:3191

## loSimplex()

BOOLEAN loSimplex | ( | leftv | res,
|  | leftv | args )

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4572 of file ipshell.cc.

{
if ( !(rField_is_long_R(currRing)) )
{
WerrorS("Ground field not implemented!");
return TRUE;
}
simplex * LP;
matrix m;
leftv v= args;
if ( v->Typ() != MATRIX_CMD ) // 1: matrix
return TRUE;
else
m= (matrix)(v->CopyD());
LP = new simplex(MATROWS(m),MATCOLS(m));
LP->mapFromMatrix(m);
v= v->next;
if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
return TRUE;
else
LP->m= (int)(long)(v->Data());
v= v->next;
if ( v->Typ() != INT_CMD ) // 3: n = number of variables
return TRUE;
else
LP->n= (int)(long)(v->Data());
v= v->next;
if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
return TRUE;
else
LP->m1= (int)(long)(v->Data());
v= v->next;
if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
return TRUE;
else
LP->m2= (int)(long)(v->Data());
v= v->next;
if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
return TRUE;
else
LP->m3= (int)(long)(v->Data());
#ifdef mprDEBUG_PROT
Print("m (constraints) %d\n",LP->m);
Print("n (columns) %d\n",LP->n);
Print("m1 (<=) %d\n",LP->m1);
Print("m2 (>=) %d\n",LP->m2);
Print("m3 (==) %d\n",LP->m3);
#endif
LP->compute();
lists lres= (lists)omAlloc( sizeof(slists) );
lres->Init( 6 );
lres->m[0].rtyp= MATRIX_CMD; // output matrix
lres->m[0].data=(void*)LP->mapToMatrix(m);
lres->m[1].rtyp= INT_CMD; // found a solution?
lres->m[1].data=(void*)(long)LP->icase;
lres->m[2].rtyp= INTVEC_CMD;
lres->m[2].data=(void*)LP->posvToIV();
lres->m[3].rtyp= INTVEC_CMD;
lres->m[3].data=(void*)LP->zrovToIV();
lres->m[4].rtyp= INT_CMD;
lres->m[4].data=(void*)(long)LP->m;
lres->m[5].rtyp= INT_CMD;
lres->m[5].data=(void*)(long)LP->n;
res->data= (void*)lres;
return FALSE;
}
m
int m
Definition cfEzgcd.cc:128
simplex
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition mpr_numeric.h:195
simplex::zrovToIV
intvec * zrovToIV()
Definition mpr_numeric.cc:1084
simplex::m1
int m1
Definition mpr_numeric.h:200
simplex::n
int n
Definition mpr_numeric.h:199
simplex::m2
int m2
Definition mpr_numeric.h:200
simplex::mapFromMatrix
BOOLEAN mapFromMatrix(matrix m)
Definition mpr_numeric.cc:1011
simplex::icase
int icase
Definition mpr_numeric.h:201
simplex::compute
void compute()
Definition mpr_numeric.cc:1095
simplex::m3
int m3
Definition mpr_numeric.h:200
simplex::m
int m
Definition mpr_numeric.h:198
simplex::mapToMatrix
matrix mapToMatrix(matrix m)
Definition mpr_numeric.cc:1040
simplex::posvToIV
intvec * posvToIV()
Definition mpr_numeric.cc:1073
rField_is_long_R
static BOOLEAN rField_is_long_R(const ring r)
Definition ring.h:548

## mpJacobi()

BOOLEAN mpJacobi | ( | leftv | res,
|  | leftv | a )

Definition at line 3064 of file ipshell.cc.

{
int i,j;
matrix result;
ideal id=(ideal)a->Data();
result =mpNew(IDELEMS(id),rVar(currRing));
for (i=1; i<=IDELEMS(id); i++)
{
for (j=1; j<=rVar(currRing); j++)
{
MATELEM(result,i,j) = pDiff(id->m[i-1],j);
}
}
res->data=(char *)result;
return FALSE;
}
result
return result
Definition facAbsBiFact.cc:76
mpNew
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition matpol.cc:37
MATELEM
#define MATELEM(mat, i, j)
1-based access to matrix
Definition matpol.h:29
pDiff
#define pDiff(a, b)
Definition polys.h:297

## mpKoszul()

BOOLEAN mpKoszul | ( | leftv | res,
|  | leftv | c,
|  | leftv | b,
|  | leftv | id )

Definition at line 3086 of file ipshell.cc.

{
int n=(int)(long)b->Data();
int d=(int)(long)c->Data();
int k,l,sign,row,col;
matrix result;
ideal temp;
BOOLEAN bo;
poly p;
if ((d>n) || (d<1) || (n<1))
{
res->data=(char *)mpNew(1,1);
return FALSE;
}
int *choise = (int*)omAlloc(d*sizeof(int));
if (id==NULL)
temp=idMaxIdeal(1);
else
temp=(ideal)id->Data();
k = binom(n,d);
l = k*d;
l /= n-d+1;
result =mpNew(l,k);
col = 1;
idInitChoise(d,1,n,&bo,choise);
while (!bo)
{
sign = 1;
for (l=1;l<=d;l++)
{
if (choise[l-1]<=IDELEMS(temp))
{
p = pCopy(temp->m[choise[l-1]-1]);
if (sign == -1) p = pNeg(p);
sign *= -1;
row = idGetNumberOfChoise(l-1,d,1,n,choise);
MATELEM(result,row,col) = p;
}
}
col++;
idGetNextChoise(d,n,&bo,choise);
}
omFreeSize(choise,d*sizeof(int));
if (id==NULL) idDelete(&temp);
res->data=(char *)result;
return FALSE;
}
k
int k
Definition cfEzgcd.cc:99
binom
int binom(int n, int r)
Definition simpleideals.cc:1212
idGetNextChoise
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
Definition simpleideals.cc:1154
idMaxIdeal
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition ideals.h:33
idGetNumberOfChoise
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
Definition simpleideals.cc:1180
idInitChoise
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
Definition simpleideals.cc:1132
pNeg
#define pNeg(p)
Definition polys.h:199
pCopy
#define pCopy(p)
return a copy of the poly
Definition polys.h:186
sign
static int sign(int x)
Definition ring.cc:3504

## nuLagSolve()

BOOLEAN nuLagSolve | ( | leftv | res,
|  | leftv | arg1,
|  | leftv | arg2,
|  | leftv | arg3 )

find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.

Good for polynomials with low and middle degree (<40). Arguments 3: poly arg1 , int arg2 , int arg3 arg2>0: defines precision of fractional part if ground field is Q arg3: number of iterations for approximation of roots (default=2) Returns a list of all (complex) roots of the polynomial arg1

Definition at line 4681 of file ipshell.cc.

{
poly gls;
gls= (poly)(arg1->Data());
int howclean= (int)(long)arg3->Data();
if ( gls == NULL || pIsConstant( gls ) )
{
WerrorS("Input polynomial is constant!");
return TRUE;
}
if (rField_is_Zp(currRing))
{
int* r=Zp_roots(gls, currRing);
lists rlist;
rlist= (lists)omAlloc( sizeof(slists) );
rlist->Init( r[0] );
for(int i=r[0];i>0;i--)
{
rlist->m[i-1].data=n_Init(r[i],currRing->cf);
rlist->m[i-1].rtyp=NUMBER_CMD;
}
omFree(r);
res->data=rlist;
res->rtyp= LIST_CMD;
return FALSE;
}
if ( !(rField_is_R(currRing) ||
rField_is_Q(currRing) ||
rField_is_long_R(currRing) ||
rField_is_long_C(currRing)) )
{
WerrorS("Ground field not implemented!");
return TRUE;
}
if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
rField_is_long_C(currRing)) )
{
unsigned long int ii = (unsigned long int)arg2->Data();
setGMPFloatDigits( ii, ii );
}
int ldummy;
int deg= currRing->pLDeg( gls, &ldummy, currRing );
int i,vpos=0;
poly piter;
lists elist;
elist= (lists)omAlloc( sizeof(slists) );
elist->Init( 0 );
if ( rVar(currRing) > 1 )
{
piter= gls;
for ( i= 1; i <= rVar(currRing); i++ )
if ( pGetExp( piter, i ) )
{
vpos= i;
break;
}
while ( piter )
{
for ( i= 1; i <= rVar(currRing); i++ )
if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
{
WerrorS("The input polynomial must be univariate!");
return TRUE;
}
pIter( piter );
}
}
rootContainer * roots= new rootContainer();
number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
piter= gls;
for ( i= deg; i >= 0; i-- )
{
if ( piter && pTotaldegree(piter) == i )
{
pcoeffs[i]= nCopy( pGetCoeff( piter ) );
//nPrint( pcoeffs[i] );PrintS(" ");
pIter( piter );
}
else
{
pcoeffs[i]= nInit(0);
}
}
#ifdef mprDEBUG_PROT
for (i=deg; i >= 0; i--)
{
nPrint( pcoeffs[i] );PrintS(" ");
}
PrintLn();
#endif
roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
roots->solver( howclean );
int elem= roots->getAnzRoots();
char *dummy;
int j;
lists rlist;
rlist= (lists)omAlloc( sizeof(slists) );
rlist->Init( elem );
if (rField_is_long_C(currRing))
{
for ( j= 0; j < elem; j++ )
{
rlist->m[j].rtyp=NUMBER_CMD;
rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
//rlist->m[j].data=(void *)(number)(roots->getRoot(j));
}
}
else
{
for ( j= 0; j < elem; j++ )
{
dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
rlist->m[j].rtyp=STRING_CMD;
rlist->m[j].data=(void *)dummy;
}
}
elist->Clean();
//omFreeSize( (ADDRESS) elist, sizeof(slists) );
// this is (via fillContainer) the same data as in root
//for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
//omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
delete roots;
res->data= (void*)rlist;
return FALSE;
}
Zp_roots
int * Zp_roots(poly p, const ring r)
Definition clapsing.cc:2242
rootContainer
complex root finder for univariate polynomials based on laguers algorithm
Definition mpr_numeric.h:66
rootContainer::fillContainer
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition mpr_numeric.cc:300
rootContainer::onepoly
@ onepoly
Definition mpr_numeric.h:68
rootContainer::solver
bool solver(const int polishmode=PM_NONE)
Definition mpr_numeric.cc:437
slists::Clean
void Clean(ring r=currRing)
Definition lists.h:26
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
pIter
#define pIter(p)
Definition monomials.h:37
gmp_output_digits
EXTERN_VAR size_t gmp_output_digits
Definition mpr_base.h:115
setGMPFloatDigits
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition mpr_complex.cc:60
nCopy
#define nCopy(n)
Definition numbers.h:15
nPrint
#define nPrint(a)
only for debug, over any initialized currRing
Definition numbers.h:46
pIsConstant
#define pIsConstant(p)
like above, except that Comp must be 0
Definition polys.h:239
rField_is_R
static BOOLEAN rField_is_R(const ring r)
Definition ring.h:524
rField_is_Zp
static BOOLEAN rField_is_Zp(const ring r)
Definition ring.h:506
rField_is_Q
static BOOLEAN rField_is_Q(const ring r)
Definition ring.h:512

## nuMPResMat()

BOOLEAN nuMPResMat | ( | leftv | res,
|  | leftv | arg1,
|  | leftv | arg2 )

returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)

Definition at line 4658 of file ipshell.cc.

{
ideal gls = (ideal)(arg1->Data());
int imtype= (int)(long)arg2->Data();
uResultant::resMatType mtype= determineMType( imtype );
// check input ideal ( = polynomial system )
if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
{
return TRUE;
}
uResultant *resMat= new uResultant( gls, mtype, false );
if (resMat!=NULL)
{
res->rtyp = MODUL_CMD;
res->data= (void*)resMat->accessResMat()->getMatrix();
if (!errorreported) delete resMat;
}
return errorreported;
}
resMatrixBase::getMatrix
virtual ideal getMatrix()
Definition mpr_base.h:31
uResultant
Base class for solving 0-dim poly systems using u-resultant.
Definition mpr_base.h:63
uResultant::resMatType
resMatType
Definition mpr_base.h:65
uResultant::accessResMat
resMatrixBase * accessResMat()
Definition mpr_base.h:78
mprOk
@ mprOk
Definition mpr_base.h:98
determineMType
uResultant::resMatType determineMType(int imtype)
mprIdealCheck
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

## nuUResSolve()

BOOLEAN nuUResSolve | ( | leftv | res,
|  | leftv | args )

solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).

Resultant method can be MPR_DENSE, which uses Macaulay Resultant (good for dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant (Gelfand, Kapranov, Zelevinsky). Arguments 4: ideal i, int k, int l, int m k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) l>0: defines precision of fractional part if ground field is Q m=0,1,2: number of iterations for approximation of roots (default=2) Returns a list containing the roots of the system.

Definition at line 4925 of file ipshell.cc.

{
leftv v= args;
ideal gls;
int imtype;
int howclean;
// get ideal
if ( v->Typ() != IDEAL_CMD )
return TRUE;
else gls= (ideal)(v->Data());
v= v->next;
// get resultant matrix type to use (0,1)
if ( v->Typ() != INT_CMD )
return TRUE;
else imtype= (int)(long)v->Data();
v= v->next;
if (imtype==0)
{
ideal test_id=idInit(1,1);
int j;
for(j=IDELEMS(gls)-1;j>=0;j--)
{
if (gls->m[j]!=NULL)
{
test_id->m[0]=gls->m[j];
intvec *dummy_w=id_QHomWeight(test_id, currRing);
if (dummy_w!=NULL)
{
WerrorS("Newton polytope not of expected dimension");
delete dummy_w;
return TRUE;
}
}
}
}
// get and set precision in digits ( > 0 )
if ( v->Typ() != INT_CMD )
return TRUE;
else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
rField_is_long_C(currRing)) )
{
unsigned long int ii=(unsigned long int)v->Data();
setGMPFloatDigits( ii, ii );
}
v= v->next;
// get interpolation steps (0,1,2)
if ( v->Typ() != INT_CMD )
return TRUE;
else howclean= (int)(long)v->Data();
uResultant::resMatType mtype= determineMType( imtype );
int i,count;
lists listofroots= NULL;
number smv= NULL;
BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
//emptylist= (lists)omAlloc( sizeof(slists) );
//emptylist->Init( 0 );
//res->rtyp = LIST_CMD;
//res->data= (void *)emptylist;
// check input ideal ( = polynomial system )
if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
{
return TRUE;
}
uResultant * ures;
rootContainer ** iproots;
rootContainer ** muiproots;
rootArranger * arranger;
// main task 1: setup of resultant matrix
ures= new uResultant( gls, mtype );
if ( ures->accessResMat()->initState() != resMatrixBase::ready )
{
WerrorS("Error occurred during matrix setup!");
return TRUE;
}
// if dense resultant, check if minor nonsingular
if ( mtype == uResultant::denseResMat )
{
smv= ures->accessResMat()->getSubDet();
#ifdef mprDEBUG_PROT
PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
#endif
if ( nIsZero(smv) )
{
WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
return TRUE;
}
}
// main task 2: Interpolate specialized resultant polynomials
if ( interpolate_det )
iproots= ures->interpolateDenseSP( false, smv );
else
iproots= ures->specializeInU( false, smv );
// main task 3: Interpolate specialized resultant polynomials
if ( interpolate_det )
muiproots= ures->interpolateDenseSP( true, smv );
else
muiproots= ures->specializeInU( true, smv );
#ifdef mprDEBUG_PROT
int c= iproots[0]->getAnzElems();
for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
c= muiproots[0]->getAnzElems();
for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
#endif
// main task 4: Compute roots of specialized polys and match them up
arranger= new rootArranger( iproots, muiproots, howclean );
arranger->solve_all();
// get list of roots
if ( arranger->success() )
{
arranger->arrange();
listofroots= listOfRoots(arranger, gmp_output_digits );
}
else
{
WerrorS("Solver was unable to find any roots!");
return TRUE;
}
// free everything
count= iproots[0]->getAnzElems();
for (i=0; i < count; i++) delete iproots[i];
omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
count= muiproots[0]->getAnzElems();
for (i=0; i < count; i++) delete muiproots[i];
omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
delete ures;
delete arranger;
if (smv!=NULL) nDelete( &smv );
res->data= (void *)listofroots;
//emptylist->Clean();
// omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
return FALSE;
}
resMatrixBase::getSubDet
virtual number getSubDet()
Definition mpr_base.h:37
resMatrixBase::ready
@ ready
Definition mpr_base.h:26
resMatrixBase::initState
virtual IStateType initState() const
Definition mpr_base.h:41
rootArranger
Definition mpr_numeric.h:150
rootArranger::solve_all
void solve_all()
Definition mpr_numeric.cc:858
rootArranger::success
bool success()
Definition mpr_numeric.h:162
rootArranger::arrange
void arrange()
Definition mpr_numeric.cc:883
uResultant::specializeInU
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition mpr_base.cc:3060
uResultant::interpolateDenseSP
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition mpr_base.cc:2922
uResultant::denseResMat
@ denseResMat
Definition mpr_base.h:65
listOfRoots
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition ipshell.cc:5082
nDelete
#define nDelete(n)
Definition numbers.h:16
nIsZero
#define nIsZero(n)
Definition numbers.h:19
pWrite
void pWrite(poly p)
Definition polys.h:309

## nuVanderSys()

BOOLEAN nuVanderSys | ( | leftv | res,
|  | leftv | arg1,
|  | leftv | arg2,
|  | leftv | arg3 )

COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.

Definition at line 4824 of file ipshell.cc.

{
int i;
ideal p,w;
p= (ideal)arg1->Data();
w= (ideal)arg2->Data();
// w[0] = f(p^0)
// w[1] = f(p^1)
// ...
// p can be a vector of numbers (multivariate polynom)
// or one number (univariate polynom)
// tdg = deg(f)
int n= IDELEMS( p );
int m= IDELEMS( w );
int tdg= (int)(long)arg3->Data();
res->data= (void*)NULL;
// check the input
if ( tdg < 1 )
{
WerrorS("Last input parameter must be > 0!");
return TRUE;
}
if ( n != rVar(currRing) )
{
Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
return TRUE;
}
if ( m != (int)pow((double)tdg+1,(double)n) )
{
Werror("Size of second input ideal must be equal to %d!",
(int)pow((double)tdg+1,(double)n));
return TRUE;
}
if ( !(rField_is_Q(currRing) /* ||
rField_is_R() || rField_is_long_R() ||
rField_is_long_C()*/ ) )
{
WerrorS("Ground field not implemented!");
return TRUE;
}
number tmp;
number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
for ( i= 0; i < n; i++ )
{
pevpoint[i]=nInit(0);
if ( (p->m)[i] )
{
tmp = pGetCoeff( (p->m)[i] );
if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
{
omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
return TRUE;
}
} else tmp= NULL;
if ( !nIsZero(tmp) )
{
if ( !pIsConstant((p->m)[i]))
{
omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
WerrorS("Elements of first input ideal must be numbers!");
return TRUE;
}
pevpoint[i]= nCopy( tmp );
}
}
number *wresults= (number *)omAlloc( m * sizeof( number ) );
for ( i= 0; i < m; i++ )
{
wresults[i]= nInit(0);
if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
{
if ( !pIsConstant((w->m)[i]))
{
omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
WerrorS("Elements of second input ideal must be numbers!");
return TRUE;
}
wresults[i]= nCopy(pGetCoeff((w->m)[i]));
}
}
vandermonde vm( m, n, tdg, pevpoint, FALSE );
number *ncpoly= vm.interpolateDense( wresults );
// do not free ncpoly[]!!
poly rpoly= vm.numvec2poly( ncpoly );
omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
res->data= (void*)rpoly;
return FALSE;
}
pow
Rational pow(const Rational &a, int e)
Definition GMPrat.cc:411
vandermonde
vandermonde system solver for interpolating polynomials from their values
Definition mpr_numeric.h:29
nIsMOne
#define nIsMOne(n)
Definition numbers.h:26
nIsOne
#define nIsOne(n)
Definition numbers.h:25

## paPrint()

void paPrint | ( | const char * | n,
|  | package | p )

Definition at line 6333 of file ipshell.cc.

{
Print(" %s (",n);
switch (p->language)
{
case LANG_SINGULAR: PrintS("S"); break;
case LANG_C: PrintS("C"); break;
case LANG_TOP: PrintS("T"); break;
case LANG_MAX: PrintS("M"); break;
case LANG_NONE: PrintS("N"); break;
default: PrintS("U");
}
if(p->libname!=NULL)
Print(",%s", p->libname);
PrintS(")");
}
LANG_MAX
@ LANG_MAX
Definition subexpr.h:22
LANG_SINGULAR
@ LANG_SINGULAR
Definition subexpr.h:22
LANG_TOP
@ LANG_TOP
Definition subexpr.h:22

## rCompose()

ring rCompose | ( | const lists | L,
|  | const BOOLEAN | check_comp,
|  | const long | bitmask,
|  | const int | isLetterplace )

Definition at line 2782 of file ipshell.cc.

{
if ((L->nr!=3)
#ifdef HAVE_PLURAL
&&(L->nr!=5)
#endif
)
return NULL;
int is_gf_char=0;
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// 3: qideal
// possibly:
// 4: C
// 5: D
ring R = (ring) omAlloc0Bin(sip_sring_bin);
// ------------------------------------------------------------------
// 0: char:
if (L->m[0].Typ()==CRING_CMD)
{
R->cf=(coeffs)L->m[0].Data();
R->cf->ref++;
}
else if (L->m[0].Typ()==INT_CMD)
{
int ch = (int)(long)L->m[0].Data();
assume( ch >= 0 );
if (ch == 0) // Q?
R->cf = nInitChar(n_Q, NULL);
else
{
int l = IsPrime(ch); // Zp?
if( l != ch )
{
Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
ch = l;
}
#ifndef TEST_ZN_AS_ZP
R->cf = nInitChar(n_Zp, (void*)(long)ch);
#else
mpz_t modBase;
mpz_init_set_ui(modBase,(long) ch);
ZnmInfo info;
info.base= modBase;
info.exp= 1;
R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
R->cf->is_field=1;
R->cf->is_domain=1;
R->cf->has_simple_Inverse=1;
#endif
}
}
else if (L->m[0].Typ()==LIST_CMD) // something complicated...
{
lists LL=(lists)L->m[0].Data();
if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
{
rComposeRing(LL, R); // Ring!?
}
else
if (LL->nr < 3)
rComposeC(LL,R); // R, long_R, long_C
else
{
if (LL->m[0].Typ()==INT_CMD)
{
int ch = (int)(long)LL->m[0].Data();
while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
if (fftable[is_gf_char]==0) is_gf_char=-1;
if(is_gf_char!= -1)
{
GFInfo param;
param.GFChar = ch;
param.GFDegree = 1;
param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
// nfInitChar should be able to handle the case when ch is in fftables!
R->cf = nInitChar(n_GF, (void*)&param);
}
}
if( R->cf == NULL )
{
ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
if (extRing==NULL)
{
WerrorS("could not create the specified coefficient field");
goto rCompose_err;
}
if( extRing->qideal != NULL ) // Algebraic extension
{
AlgExtInfo extParam;
extParam.r = extRing;
R->cf = nInitChar(n_algExt, (void*)&extParam);
}
else // Transcendental extension
{
TransExtInfo extParam;
extParam.r = extRing;
R->cf = nInitChar(n_transExt, &extParam);
}
//rDecRefCnt(R);
}
}
}
else
{
WerrorS("coefficient field must be described by `int` or `list`");
goto rCompose_err;
}
if( R->cf == NULL )
{
WerrorS("could not create coefficient field described by the input!");
goto rCompose_err;
}
// ------------------------- VARS ---------------------------
if (rComposeVar(L,R)) goto rCompose_err;
// ------------------------ ORDER ------------------------------
if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
// ------------------------ ??????? --------------------
if (!isLetterplace) rRenameVars(R);
#ifdef HAVE_SHIFTBBA
else
{
R->isLPring=isLetterplace;
R->ShortOut=FALSE;
R->CanShortOut=FALSE;
}
#endif
if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
rComplete(R);
// ------------------------ Q-IDEAL ------------------------
if (L->m[3].Typ()==IDEAL_CMD)
{
ideal q=(ideal)L->m[3].Data();
if ((q!=NULL) && (q->m!=NULL) && (q->m[0]!=NULL))
{
if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
{
#if 0
WerrorS("coefficient fields must be equal if q-ideal !=0");
goto rCompose_err;
#else
ring orig_ring=currRing;
rChangeCurrRing(R);
int *perm=NULL;
int *par_perm=NULL;
int par_perm_size=0;
nMapFunc nMap;
if ((nMap=nSetMap(orig_ring->cf))==NULL)
{
if (rEqual(orig_ring,currRing))
{
nMap=n_SetMap(currRing->cf, currRing->cf);
}
else
// Allow imap/fetch to be make an exception only for:
if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
(rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
rField_is_Zp(currRing) || rField_is_Zp_a(currRing) ||
rField_is_Zn(currRing)))
||
(rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
(rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
{
par_perm_size=rPar(orig_ring);
// if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
// naSetChar(rInternalChar(orig_ring),orig_ring);
// else ntSetChar(rInternalChar(orig_ring),orig_ring);
nSetChar(currRing->cf);
}
else
{
WerrorS("coefficient fields must be equal if q-ideal !=0");
goto rCompose_err;
}
}
perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
if (par_perm_size!=0)
par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
int i;
#if 0
// use imap:
maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
currRing->names,currRing->N,currRing->parameter, currRing->P,
perm,par_perm, currRing->ch);
#else
// use fetch
if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
{
for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
}
else if (par_perm_size!=0)
for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
#endif
ideal dest_id=idInit(IDELEMS(q),1);
for(i=IDELEMS(q)-1; i>=0; i--)
{
dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
par_perm,par_perm_size);
// PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
pTest(dest_id->m[i]);
}
R->qideal=dest_id;
if (perm!=NULL)
omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
if (par_perm!=NULL)
omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
rChangeCurrRing(orig_ring);
#endif
}
else
R->qideal=idrCopyR(q,currRing,R);
}
}
else
{
WerrorS("q-ideal must be given as `ideal`");
goto rCompose_err;
}
// ---------------------------------------------------------------
#ifdef HAVE_PLURAL
if (L->nr==5)
{
if (nc_CallPlural((matrix)L->m[4].Data(),
(matrix)L->m[5].Data(),
NULL,NULL,
R,
true, // !!!
true, false,
currRing, FALSE)) goto rCompose_err;
// takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
}
#endif
return R;
rCompose_err:
if (R->N>0)
{
int i;
if (R->names!=NULL)
{
i=R->N-1;
while (i>=0) { omfree(R->names[i]); i--; }
omFree(R->names);
}
}
omfree(R->order);
omfree(R->block0);
omfree(R->block1);
omfree(R->wvhdl);
omFree(R);
return NULL;
}
AlgExtInfo::r
ring r
Definition algext.h:37
AlgExtInfo
struct for passing initialization parameters to naInitChar
Definition algext.h:37
GFInfo::GFDegree
int GFDegree
Definition coeffs.h:102
n_GF
@ n_GF
\GF{p^n < 2^16}
Definition coeffs.h:32
n_Q
@ n_Q
rational (GMP) numbers
Definition coeffs.h:30
n_algExt
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition coeffs.h:35
n_Zn
@ n_Zn
only used if HAVE_RINGS is defined
Definition coeffs.h:44
n_Zp
@ n_Zp
\F{p < 2^31}
Definition coeffs.h:29
n_transExt
@ n_transExt
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition coeffs.h:38
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
fftable
const unsigned short fftable[]
Definition ffields.cc:27
nSetChar
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition coeffs.h:446
GFInfo::GFPar_name
const char * GFPar_name
Definition coeffs.h:103
GFInfo::GFChar
int GFChar
Definition coeffs.h:101
GFInfo
Creation data needed for finite fields.
Definition coeffs.h:100
rRenameVars
static void rRenameVars(ring R)
Definition ipshell.cc:2395
rComposeC
void rComposeC(lists L, ring R)
Definition ipshell.cc:2252
rComposeOrder
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition ipshell.cc:2482
rCompose
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition ipshell.cc:2782
rComposeRing
void rComposeRing(lists L, ring R)
Definition ipshell.cc:2303
rComposeVar
static BOOLEAN rComposeVar(const lists L, ring R)
Definition ipshell.cc:2437
info
#define info
Definition libparse.cc:1256
nc_CallPlural
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type,...
Definition old.gring.cc:2692
maFindPerm
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition maps.cc:155
assume
#define assume(x)
Definition mod2.h:389
coeffs
The main handler for Singular numbers which are suitable for Singular polynomials.
nSetMap
#define nSetMap(R)
Definition numbers.h:43
omfree
#define omfree(addr)
Definition omAllocDecl.h:237
p_PermPoly
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition p_polys.cc:4256
pTest
#define pTest(p)
Definition polys.h:415
idrCopyR
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition prCopy.cc:192
IsPrime
int IsPrime(int p)
Definition prime.cc:61
rComplete
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition ring.cc:3527
sip_sring_bin
VAR omBin sip_sring_bin
Definition ring.cc:43
rEqual
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition ring.cc:1752
rField_is_Zp_a
static BOOLEAN rField_is_Zp_a(const ring r)
Definition ring.h:535
rField_is_Zn
static BOOLEAN rField_is_Zn(const ring r)
Definition ring.h:518
rPar
static int rPar(const ring r)
(r->cf->P)
Definition ring.h:605
rInternalChar
static int rInternalChar(const ring r)
Definition ring.h:695
rField_is_Q_a
static BOOLEAN rField_is_Q_a(const ring r)
Definition ring.h:545
ZnmInfo
Definition rmodulon.h:17
R
#define R
Definition sirandom.c:27
TransExtInfo::r
ring r
Definition transext.h:88
TransExtInfo
struct for passing initialization parameters to naInitChar
Definition transext.h:88

## rComposeC()

void rComposeC | ( | lists | L,
|  | ring | R )

Definition at line 2252 of file ipshell.cc.

{
// ----------------------------------------
// 0: char/ cf - ring
if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
{
WerrorS("invalid coeff. field description, expecting 0");
return;
}
// R->cf->ch=0;
// ----------------------------------------
// 0, (r1,r2) [, "i" ]
if (L->m[1].rtyp!=LIST_CMD)
{
WerrorS("invalid coeff. field description, expecting precision list");
return;
}
lists LL=(lists)L->m[1].data;
if ((LL->nr!=1)
|| (LL->m[0].rtyp!=INT_CMD)
|| (LL->m[1].rtyp!=INT_CMD))
{
WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
return;
}
int r1=(int)(long)LL->m[0].data;
int r2=(int)(long)LL->m[1].data;
r1=si_min(r1,32767);
r2=si_min(r2,32767);
LongComplexInfo par; memset(&par, 0, sizeof(par));
par.float_len=r1;
par.float_len2=r2;
if (L->nr==2) // complex
{
if (L->m[2].rtyp!=STRING_CMD)
{
WerrorS("invalid coeff. field description, expecting parameter name");
return;
}
par.par_name=(char*)L->m[2].data;
R->cf = nInitChar(n_long_C, &par);
}
else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
R->cf = nInitChar(n_R, NULL);
else /* && L->nr==1*/
{
R->cf = nInitChar(n_long_R, &par);
}
}
n_R
@ n_R
single prescision (6,6) real numbers
Definition coeffs.h:31
n_long_R
@ n_long_R
real floating point (GMP) numbers
Definition coeffs.h:33
n_long_C
@ n_long_C
complex floating point (GMP) numbers
Definition coeffs.h:41
LongComplexInfo::float_len2
short float_len2
additional char-flags, rInit
Definition coeffs.h:109
LongComplexInfo::par_name
const char * par_name
parameter name
Definition coeffs.h:110
LongComplexInfo::float_len
short float_len
additional char-flags, rInit
Definition coeffs.h:108
LongComplexInfo
Definition coeffs.h:107
SHORT_REAL_LENGTH
#define SHORT_REAL_LENGTH
Definition numbers.h:57

## rComposeOrder()

BOOLEAN rComposeOrder | ( | const lists | L,
|  | const BOOLEAN | check_comp,
|  | ring | R )

inline static

Definition at line 2482 of file ipshell.cc.

{
assume(R!=NULL);
long bitmask=0L;
if (L->m[2].Typ()==LIST_CMD)
{
lists v=(lists)L->m[2].Data();
int n= v->nr+2;
int j_in_R,j_in_L;
// do we have an entry "L",... ?: set bitmask
for (int j=0; j < n-1; j++)
{
if (v->m[j].Typ()==LIST_CMD)
{
lists vv=(lists)v->m[j].Data();
if ((vv->nr==1)
&&(vv->m[0].Typ()==STRING_CMD)
&&(strcmp((char*)vv->m[0].Data(),"L")==0))
{
number nn=(number)vv->m[1].Data();
if (vv->m[1].Typ()==BIGINT_CMD)
bitmask=n_Int(nn,coeffs_BIGINT);
else if (vv->m[1].Typ()==INT_CMD)
bitmask=(long)nn;
else
{
Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
return TRUE;
}
break;
}
}
}
if (bitmask!=0) n--;
// initialize fields of R
R->order=(rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
R->block0=(int *)omAlloc0((n+1)*sizeof(int));
R->block1=(int *)omAlloc0((n+1)*sizeof(int));
R->wvhdl=(int**)omAlloc0((n+1)*sizeof(int_ptr));
// init order, so that rBlocks works correctly
for (j_in_R= n-2; j_in_R>=0; j_in_R--)
R->order[j_in_R] = ringorder_unspec;
// orderings
for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
{
// todo: a(..), M
if (v->m[j_in_L].Typ()!=LIST_CMD)
{
WerrorS("ordering must be list of lists");
return TRUE;
}
lists vv=(lists)v->m[j_in_L].Data();
if ((vv->nr==1)
&& (vv->m[0].Typ()==STRING_CMD))
{
if (strcmp((char*)vv->m[0].Data(),"L")==0)
{
j_in_R--;
continue;
}
if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)
&& (vv->m[1].Typ()!=INTMAT_CMD))
{
PrintS(lString(vv));
Werror("ordering name must be a (string,intvec), not (string,%s)",Tok2Cmdname(vv->m[1].Typ()));
return TRUE;
}
R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
if (j_in_R==0) R->block0[0]=1;
else
{
int jj=j_in_R-1;
while((jj>=0)
&& ((R->order[jj]== ringorder_a)
|| (R->order[jj]== ringorder_aa)
|| (R->order[jj]== ringorder_am)
|| (R->order[jj]== ringorder_c)
|| (R->order[jj]== ringorder_C)
|| (R->order[jj]== ringorder_s)
|| (R->order[jj]== ringorder_S)
))
{
//Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
jj--;
}
if (jj<0) R->block0[j_in_R]=1;
else R->block0[j_in_R]=R->block1[jj]+1;
}
intvec *iv;
if (vv->m[1].Typ()==INT_CMD)
{
int l=si_max(1,(int)(long)vv->m[1].Data());
iv=new intvec(l);
for(int i=0;i<l;i++) (*iv)[i]=1;
}
else
iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC/INTMAT
int iv_len=iv->length();
if (iv_len==0)
{
Werror("empty intvec for ordering %d (%s)",j_in_R+1,rSimpleOrdStr(R->order[j_in_R]));
return TRUE;
}
if (R->order[j_in_R]==ringorder_M)
{
if (vv->m[1].rtyp==INTMAT_CMD) iv->makeVector();
iv_len=iv->length();
}
if ((R->order[j_in_R]!=ringorder_s)
&&(R->order[j_in_R]!=ringorder_c)
&&(R->order[j_in_R]!=ringorder_C))
{
if (R->order[j_in_R]==ringorder_M)
{
int sq=(int)sqrt((double)(iv_len));
R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+sq-1);
}
else
R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
if (R->block1[j_in_R]>R->N)
{
if (R->block0[j_in_R]>R->N)
{
Print("R->block0[j_in_R]=%d,N=%d\n",R->block0[j_in_R],R->N);
Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
return TRUE;
}
R->block1[j_in_R]=R->N;
iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
}
//Print("block %d(%s) from %d to %d\n",j_in_R,
// rSimpleOrdStr(R->order[j_in_R]),R->block0[j_in_R], R->block1[j_in_R]);
}
int i;
switch (R->order[j_in_R])
{
case ringorder_ws:
case ringorder_Ws:
R->OrdSgn=-1; // and continue
case ringorder_aa:
case ringorder_a:
case ringorder_wp:
case ringorder_Wp:
R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
for (i=0; i<iv_len;i++)
{
R->wvhdl[j_in_R][i]=(*iv)[i];
}
break;
case ringorder_am:
R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
for (i=0; i<iv_len;i++)
{
R->wvhdl[j_in_R][i]=(*iv)[i];
}
R->wvhdl[j_in_R][i]=iv->length() - iv_len;
//printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
for (; i<iv->length(); i++)
{
R->wvhdl[j_in_R][i+1]=(*iv)[i];
}
break;
case ringorder_M:
R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
if (R->block1[j_in_R]>R->N)
{
R->block1[j_in_R]=R->N;
}
break;
case ringorder_ls:
case ringorder_ds:
case ringorder_Ds:
case ringorder_rs:
R->OrdSgn=-1;
case ringorder_lp:
case ringorder_dp:
case ringorder_Dp:
case ringorder_rp:
case ringorder_Ip:
#if 0
for (i=0; i<iv_len;i++)
{
if (((*iv)[i]!=1)&&(iv_len!=1))
{
iv->show(1);
Warn("ignore weight %d for ord %d (%s) at pos %d\n>>%s<<",
(*iv)[i],j_in_R+1,rSimpleOrdStr(R->order[j_in_R]),i+1,my_yylinebuf);
break;
}
}
#endif // break absfact.tst
break;
case ringorder_S:
break;
case ringorder_c:
case ringorder_C:
R->block1[j_in_R]=R->block0[j_in_R]=0;
break;
case ringorder_s:
R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
rSetSyzComp(R->block0[j_in_R],R);
break;
case ringorder_IS:
{
R->block1[j_in_R] = R->block0[j_in_R] = 0;
if( iv->length() > 0 )
{
const int s = (*iv)[0];
assume( -2 < s && s < 2 );
R->block1[j_in_R] = R->block0[j_in_R] = s;
}
break;
}
case 0:
case ringorder_unspec:
break;
case ringorder_L: /* cannot happen */
case ringorder_a64: /*not implemented */
WerrorS("ring order not implemented");
return TRUE;
}
delete iv;
}
else
{
PrintS(lString(vv));
WerrorS("ordering name must be a (string,intvec)");
return TRUE;
}
}
// sanity check
j_in_R=n-2;
if ((R->order[j_in_R]==ringorder_c)
|| (R->order[j_in_R]==ringorder_C)
|| (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
if (R->block1[j_in_R] != R->N)
{
if (((R->order[j_in_R]==ringorder_dp) ||
(R->order[j_in_R]==ringorder_ds) ||
(R->order[j_in_R]==ringorder_Dp) ||
(R->order[j_in_R]==ringorder_Ds) ||
(R->order[j_in_R]==ringorder_rp) ||
(R->order[j_in_R]==ringorder_rs) ||
(R->order[j_in_R]==ringorder_lp) ||
(R->order[j_in_R]==ringorder_ls))
&&
R->block0[j_in_R] <= R->N)
{
R->block1[j_in_R] = R->N;
}
else
{
Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
return TRUE;
}
}
if (R->block0[j_in_R]>R->N)
{
Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
for(int ii=0;ii<=j_in_R;ii++)
Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
return TRUE;
}
if (check_comp)
{
BOOLEAN comp_order=FALSE;
int jj;
for(jj=0;jj<n;jj++)
{
if ((R->order[jj]==ringorder_c) ||
(R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
}
if (!comp_order)
{
R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
R->order[n-1]=ringorder_C;
R->block0[n-1]=0;
R->block1[n-1]=0;
R->wvhdl[n-1]=NULL;
n++;
}
}
}
else
{
WerrorS("ordering must be given as `list`");
return TRUE;
}
if (bitmask!=0) { R->bitmask=bitmask; R->wanted_maxExp=bitmask; }
return FALSE;
}
si_max
static int si_max(const int a, const int b)
Definition auxiliary.h:125
intvec::makeVector
void makeVector()
Definition intvec.h:103
intvec::show
void show(int mat=0, int spaces=0) const
Definition intvec.cc:149
n_Int
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ....
Definition coeffs.h:550
lString
char * lString(lists l, BOOLEAN typed, int dim)
Definition lists.cc:409
sqrt
gmp_float sqrt(const gmp_float &a)
Definition mpr_complex.cc:319
omRealloc0Size
#define omRealloc0Size(addr, o_size, size)
Definition omAllocDecl.h:221
coeffs_BIGINT
VAR coeffs coeffs_BIGINT
Definition polys.cc:14
rSimpleOrdStr
const char * rSimpleOrdStr(int ord)
Definition ring.cc:78
rOrderName
rRingOrder_t rOrderName(char *ordername)
Definition ring.cc:512
rSetSyzComp
void rSetSyzComp(int k, const ring r)
Definition ring.cc:5230
ringorder_rp
#define ringorder_rp
Definition ring.h:100
rRingOrder_t
rRingOrder_t
order stuff
Definition ring.h:69
ringorder_lp
@ ringorder_lp
Definition ring.h:78
ringorder_a
@ ringorder_a
Definition ring.h:71
ringorder_am
@ ringorder_am
Definition ring.h:90
ringorder_a64
@ ringorder_a64
for int64 weights
Definition ring.h:72
ringorder_C
@ ringorder_C
Definition ring.h:74
ringorder_S
@ ringorder_S
S?
Definition ring.h:76
ringorder_ds
@ ringorder_ds
Definition ring.h:86
ringorder_Dp
@ ringorder_Dp
Definition ring.h:81
ringorder_unspec
@ ringorder_unspec
Definition ring.h:96
ringorder_L
@ ringorder_L
Definition ring.h:91
ringorder_Ds
@ ringorder_Ds
Definition ring.h:87
ringorder_Ip
@ ringorder_Ip
Definition ring.h:84
ringorder_dp
@ ringorder_dp
Definition ring.h:79
ringorder_c
@ ringorder_c
Definition ring.h:73
ringorder_aa
@ ringorder_aa
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition ring.h:93
ringorder_Wp
@ ringorder_Wp
Definition ring.h:83
ringorder_ws
@ ringorder_ws
Definition ring.h:88
ringorder_Ws
@ ringorder_Ws
Definition ring.h:89
ringorder_IS
@ ringorder_IS
Induced (Schreyer) ordering.
Definition ring.h:95
ringorder_ls
@ ringorder_ls
degree, ip
Definition ring.h:85
ringorder_s
@ ringorder_s
s?
Definition ring.h:77
ringorder_wp
@ ringorder_wp
Definition ring.h:82
ringorder_M
@ ringorder_M
Definition ring.h:75
ringorder_rs
#define ringorder_rs
Definition ring.h:101
int_ptr
int * int_ptr
Definition structs.h:50
BIGINT_CMD
@ BIGINT_CMD
Definition tok.h:38

## rComposeRing()

void rComposeRing | ( | lists | L,
|  | ring | R )

Definition at line 2303 of file ipshell.cc.

{
// ----------------------------------------
// 0: string: integer
// no further entries --> Z
mpz_t modBase;
unsigned int modExponent = 1;
if (L->nr == 0)
{
mpz_init_set_ui(modBase,0);
modExponent = 1;
}
// ----------------------------------------
// 1:
else
{
if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
lists LL=(lists)L->m[1].data;
if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
{
number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
// assume that tmp is integer, not rational
mpz_init(modBase);
n_MPZ (modBase, tmp, coeffs_BIGINT);
}
else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
{
mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
}
else
{
mpz_init_set_ui(modBase,0);
}
if (LL->nr >= 1)
{
modExponent = (unsigned long) LL->m[1].data;
}
else
{
modExponent = 1;
}
}
// ----------------------------------------
if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
{
WerrorS("Wrong ground ring specification (module is 1)");
return;
}
if (modExponent < 1)
{
WerrorS("Wrong ground ring specification (exponent smaller than 1)");
return;
}
// module is 0 ---> integers
if (mpz_sgn1(modBase) == 0)
{
R->cf=nInitChar(n_Z,NULL);
}
// we have an exponent
else if (modExponent > 1)
{
//R->cf->ch = R->cf->modExponent;
if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
{
/* this branch should be active for modExponent = 2..32 resp. 2..64,
depending on the size of a long on the respective platform */
R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
}
else
{
//ringtype 3
ZnmInfo info;
info.base= modBase;
info.exp= modExponent;
R->cf=nInitChar(n_Znm,(void*) &info);
}
}
// just a module m > 1
else
{
//ringtype = 2;
//const int ch = mpz_get_ui(modBase);
ZnmInfo info;
info.base= modBase;
info.exp= modExponent;
R->cf=nInitChar(n_Zn,(void*) &info);
}
mpz_clear(modBase);
}
n_Znm
@ n_Znm
only used if HAVE_RINGS is defined
Definition coeffs.h:45
n_Z2m
@ n_Z2m
only used if HAVE_RINGS is defined
Definition coeffs.h:46
n_Z
@ n_Z
only used if HAVE_RINGS is defined
Definition coeffs.h:43
n_MPZ
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition coeffs.h:554
mpz_sgn1
#define mpz_sgn1(A)
Definition si_gmp.h:18

## rComposeVar()

BOOLEAN rComposeVar | ( | const lists | L,
|  | ring | R )

inline static

Definition at line 2437 of file ipshell.cc.

{
assume(R!=NULL);
if (L->m[1].Typ()==LIST_CMD)
{
lists v=(lists)L->m[1].Data();
R->N = v->nr+1;
if (R->N<=0)
{
WerrorS("no ring variables");
return TRUE;
}
R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
int i;
for(i=0;i<R->N;i++)
{
if (v->m[i].Typ()==STRING_CMD)
R->names[i]=omStrDup((char *)v->m[i].Data());
else if (v->m[i].Typ()==POLY_CMD)
{
poly p=(poly)v->m[i].Data();
int nr=pIsPurePower(p);
if (nr>0)
R->names[i]=omStrDup(currRing->names[nr-1]);
else
{
Werror("var name %d must be a string or a ring variable",i+1);
return TRUE;
}
}
else
{
Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
return TRUE;
}
}
}
else
{
WerrorS("variable must be given as `list`");
return TRUE;
}
return FALSE;
}
pIsPurePower
#define pIsPurePower(p)
Definition polys.h:249
char_ptr
char * char_ptr
Definition structs.h:49

## rDecompose()

lists rDecompose | ( | const ring | r | ) |

Definition at line 2153 of file ipshell.cc.

{
assume( r != NULL );
const coeffs C = r->cf;
assume( C != NULL );
// sanity check: require currRing==r for rings with polynomial data
if ( (r!=currRing) && (
(nCoeff_is_algExt(C) && (C != currRing->cf))
|| (r->qideal != NULL)
#ifdef HAVE_PLURAL
|| (rIsPluralRing(r))
#endif
)
)
{
WerrorS("ring with polynomial data must be the base ring or compatible");
return NULL;
}
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// 3: qideal
// possibly:
// 4: C
// 5: D
lists L=(lists)omAlloc0Bin(slists_bin);
if (rIsPluralRing(r))
L->Init(6);
else
L->Init(4);
// ----------------------------------------
// 0: char/ cf - ring
if (rField_is_numeric(r))
{
rDecomposeC(&(L->m[0]),r);
}
else if (rField_is_Ring(r))
{
rDecomposeRing(&(L->m[0]),r);
}
else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
{
rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
}
else if(rField_is_GF(r))
{
lists Lc=(lists)omAlloc0Bin(slists_bin);
Lc->Init(4);
// char:
Lc->m[0].rtyp=INT_CMD;
Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
// var:
lists Lv=(lists)omAlloc0Bin(slists_bin);
Lv->Init(1);
Lv->m[0].rtyp=STRING_CMD;
Lv->m[0].data=(void *)omStrDup(*rParameter(r));
Lc->m[1].rtyp=LIST_CMD;
Lc->m[1].data=(void*)Lv;
// ord:
lists Lo=(lists)omAlloc0Bin(slists_bin);
Lo->Init(1);
lists Loo=(lists)omAlloc0Bin(slists_bin);
Loo->Init(2);
Loo->m[0].rtyp=STRING_CMD;
Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
intvec *iv=new intvec(1); (*iv)[0]=1;
Loo->m[1].rtyp=INTVEC_CMD;
Loo->m[1].data=(void *)iv;
Lo->m[0].rtyp=LIST_CMD;
Lo->m[0].data=(void*)Loo;
Lc->m[2].rtyp=LIST_CMD;
Lc->m[2].data=(void*)Lo;
// q-ideal:
Lc->m[3].rtyp=IDEAL_CMD;
Lc->m[3].data=(void *)idInit(1,1);
// ----------------------
L->m[0].rtyp=LIST_CMD;
L->m[0].data=(void*)Lc;
}
else if (rField_is_Zp(r) || rField_is_Q(r))
{
L->m[0].rtyp=INT_CMD;
L->m[0].data=(void *)(long)r->cf->ch;
}
else
{
L->m[0].rtyp=CRING_CMD;
L->m[0].data=(void *)r->cf;
r->cf->ref++;
}
// ----------------------------------------
rDecompose_23456(r,L);
return L;
}
Lc
CanonicalForm Lc(const CanonicalForm &f)
Definition canonicalform.h:307
nCoeff_is_algExt
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition coeffs.h:905
rDecomposeC
static void rDecomposeC(leftv h, const ring R)
Definition ipshell.cc:1853
rDecomposeCF
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition ipshell.cc:1729
rDecomposeRing
void rDecomposeRing(leftv h, const ring R)
Definition ipshell.cc:1915
rDecompose_23456
static void rDecompose_23456(const ring r, lists L)
Definition ipshell.cc:2013
rIsPluralRing
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition ring.h:406
rParameter
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition ring.h:631
rField_is_numeric
static BOOLEAN rField_is_numeric(const ring r)
Definition ring.h:521
rField_is_GF
static BOOLEAN rField_is_GF(const ring r)
Definition ring.h:527
rField_is_Ring
#define rField_is_Ring(R)
Definition ring.h:491

## rDecompose_23456()

void rDecompose_23456 | ( | const ring | r,
|  | lists | L )

static

Definition at line 2013 of file ipshell.cc.

{
// ----------------------------------------
// 1: list (var)
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(r->N);
int i;
for(i=0; i<r->N; i++)
{
LL->m[i].rtyp=STRING_CMD;
LL->m[i].data=(void *)omStrDup(r->names[i]);
}
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
// ----------------------------------------
// 2: list (ord)
LL=(lists)omAlloc0Bin(slists_bin);
i=rBlocks(r)-1;
LL->Init(i);
i--;
lists LLL;
for(; i>=0; i--)
{
intvec *iv;
int j;
LL->m[i].rtyp=LIST_CMD;
LLL=(lists)omAlloc0Bin(slists_bin);
LLL->Init(2);
LLL->m[0].rtyp=STRING_CMD;
LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
if((r->order[i] == ringorder_IS)
|| (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
{
assume( r->block0[i] == r->block1[i] );
const int s = r->block0[i];
assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
iv=new intvec(1);
(*iv)[0] = s;
}
else if (r->block1[i]-r->block0[i] >=0 )
{
int bl=j=r->block1[i]-r->block0[i];
if (r->order[i]==ringorder_M)
{
j=(j+1)*(j+1)-1;
bl=j+1;
}
else if (r->order[i]==ringorder_am)
{
j+=r->wvhdl[i][bl+1];
}
iv=new intvec(j+1);
if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
{
for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
}
else switch (r->order[i])
{
case ringorder_dp:
case ringorder_Dp:
case ringorder_ds:
case ringorder_Ds:
case ringorder_lp:
case ringorder_ls:
case ringorder_rp:
for(;j>=0; j--) (*iv)[j]=1;
break;
default: /* do nothing */;
}
}
else
{
iv=new intvec(1);
}
LLL->m[1].rtyp=INTVEC_CMD;
LLL->m[1].data=(void *)iv;
LL->m[i].data=(void *)LLL;
}
L->m[2].rtyp=LIST_CMD;
L->m[2].data=(void *)LL;
// ----------------------------------------
// 3: qideal
L->m[3].rtyp=IDEAL_CMD;
if (r->qideal==NULL)
L->m[3].data=(void *)idInit(1,1);
else
L->m[3].data=(void *)idCopy(r->qideal);
// ----------------------------------------
#ifdef HAVE_PLURAL // NC! in rDecompose
if (rIsPluralRing(r))
{
L->m[4].rtyp=MATRIX_CMD;
L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
L->m[5].rtyp=MATRIX_CMD;
L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
}
#endif
}
mp_Copy
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition matpol.cc:57
rBlocks
static int rBlocks(const ring r)
Definition ring.h:574

## rDecompose_CF()

BOOLEAN rDecompose_CF | ( | leftv | res,
|  | const coeffs | C )

Definition at line 1943 of file ipshell.cc.

{
assume( C != NULL );
// sanity check: require currRing==r for rings with polynomial data
if ( nCoeff_is_algExt(C) && (C != currRing->cf))
{
WerrorS("ring with polynomial data must be the base ring or compatible");
return TRUE;
}
if (nCoeff_is_numeric(C))
{
rDecomposeC_41(res,C);
}
else if (nCoeff_is_Ring(C))
{
rDecomposeRing_41(res,C);
}
else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
{
rDecomposeCF(res, C->extRing, currRing);
}
else if(nCoeff_is_GF(C))
{
lists Lc=(lists)omAlloc0Bin(slists_bin);
Lc->Init(4);
// char:
Lc->m[0].rtyp=INT_CMD;
Lc->m[0].data=(void*)(long)C->m_nfCharQ;
// var:
lists Lv=(lists)omAlloc0Bin(slists_bin);
Lv->Init(1);
Lv->m[0].rtyp=STRING_CMD;
Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
Lc->m[1].rtyp=LIST_CMD;
Lc->m[1].data=(void*)Lv;
// ord:
lists Lo=(lists)omAlloc0Bin(slists_bin);
Lo->Init(1);
lists Loo=(lists)omAlloc0Bin(slists_bin);
Loo->Init(2);
Loo->m[0].rtyp=STRING_CMD;
Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
intvec *iv=new intvec(1); (*iv)[0]=1;
Loo->m[1].rtyp=INTVEC_CMD;
Loo->m[1].data=(void *)iv;
Lo->m[0].rtyp=LIST_CMD;
Lo->m[0].data=(void*)Loo;
Lc->m[2].rtyp=LIST_CMD;
Lc->m[2].data=(void*)Lo;
// q-ideal:
Lc->m[3].rtyp=IDEAL_CMD;
Lc->m[3].data=(void *)idInit(1,1);
// ----------------------
res->rtyp=LIST_CMD;
res->data=(void*)Lc;
}
else
{
res->rtyp=INT_CMD;
res->data=(void *)(long)C->ch;
}
// ----------------------------------------
return FALSE;
}
nCoeff_is_GF
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition coeffs.h:834
nCoeff_is_numeric
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition coeffs.h:827
n_ParameterNames
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition coeffs.h:773
nCoeff_is_Ring
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition coeffs.h:732
rDecomposeC_41
static void rDecomposeC_41(leftv h, const coeffs C)
Definition ipshell.cc:1819
rDecomposeRing_41
static void rDecomposeRing_41(leftv h, const coeffs C)
Definition ipshell.cc:1888

## rDecompose_list_cf()

lists rDecompose_list_cf | ( | const ring | r | ) |

Definition at line 2114 of file ipshell.cc.

{
assume( r != NULL );
const coeffs C = r->cf;
assume( C != NULL );
// sanity check: require currRing==r for rings with polynomial data
if ( (r!=currRing) && (
(r->qideal != NULL)
#ifdef HAVE_PLURAL
|| (rIsPluralRing(r))
#endif
)
)
{
WerrorS("ring with polynomial data must be the base ring or compatible");
return NULL;
}
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// 3: qideal
// possibly:
// 4: C
// 5: D
lists L=(lists)omAlloc0Bin(slists_bin);
if (rIsPluralRing(r))
L->Init(6);
else
L->Init(4);
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=CRING_CMD;
L->m[0].data=(char*)r->cf; r->cf->ref++;
// ----------------------------------------
rDecompose_23456(r,L);
return L;
}

## rDecomposeC()

void rDecomposeC | ( | leftv | h,
|  | const ring | R )

static

Definition at line 1853 of file ipshell.cc.

{
lists L=(lists)omAlloc0Bin(slists_bin);
if (rField_is_long_C(R)) L->Init(3);
else L->Init(2);
h->rtyp=LIST_CMD;
h->data=(void *)L;
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=INT_CMD;
L->m[0].data=(void *)0;
// ----------------------------------------
// 1:
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(2);
LL->m[0].rtyp=INT_CMD;
LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
LL->m[1].rtyp=INT_CMD;
LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
// ----------------------------------------
// 2: list (par)
if (rField_is_long_C(R))
{
L->m[2].rtyp=STRING_CMD;
L->m[2].data=(void *)omStrDup(*rParameter(R));
}
// ----------------------------------------
}

## rDecomposeC_41()

void rDecomposeC_41 | ( | leftv | h,
|  | const coeffs | C )

static

Definition at line 1819 of file ipshell.cc.

{
lists L=(lists)omAlloc0Bin(slists_bin);
if (nCoeff_is_long_C(C)) L->Init(3);
else L->Init(2);
h->rtyp=LIST_CMD;
h->data=(void *)L;
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=INT_CMD;
L->m[0].data=(void *)0;
// ----------------------------------------
// 1:
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(2);
LL->m[0].rtyp=INT_CMD;
LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
LL->m[1].rtyp=INT_CMD;
LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
// ----------------------------------------
// 2: list (par)
if (nCoeff_is_long_C(C))
{
L->m[2].rtyp=STRING_CMD;
L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
}
// ----------------------------------------
}
nCoeff_is_long_C
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition coeffs.h:889

## rDecomposeCF()

void rDecomposeCF | ( | leftv | h,
|  | const ring | r,
|  | const ring | R )

Definition at line 1729 of file ipshell.cc.

{
lists L=(lists)omAlloc0Bin(slists_bin);
L->Init(4);
h->rtyp=LIST_CMD;
h->data=(void *)L;
// 0: char/ cf - ring
// 1: list (var)
// 2: list (ord)
// 3: qideal
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=INT_CMD;
L->m[0].data=(void *)(long)r->cf->ch;
// ----------------------------------------
// 1: list (var)
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(r->N);
int i;
for(i=0; i<r->N; i++)
{
LL->m[i].rtyp=STRING_CMD;
LL->m[i].data=(void *)omStrDup(r->names[i]);
}
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
// ----------------------------------------
// 2: list (ord)
LL=(lists)omAlloc0Bin(slists_bin);
i=rBlocks(r)-1;
LL->Init(i);
i--;
lists LLL;
for(; i>=0; i--)
{
intvec *iv;
int j;
LL->m[i].rtyp=LIST_CMD;
LLL=(lists)omAlloc0Bin(slists_bin);
LLL->Init(2);
LLL->m[0].rtyp=STRING_CMD;
LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
if (r->block1[i]-r->block0[i] >=0 )
{
j=r->block1[i]-r->block0[i];
if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
iv=new intvec(j+1);
if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
{
for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
}
else switch (r->order[i])
{
case ringorder_dp:
case ringorder_Dp:
case ringorder_ds:
case ringorder_Ds:
case ringorder_lp:
case ringorder_rp:
case ringorder_ls:
for(;j>=0; j--) (*iv)[j]=1;
break;
default: /* do nothing */;
}
}
else
{
iv=new intvec(1);
}
LLL->m[1].rtyp=INTVEC_CMD;
LLL->m[1].data=(void *)iv;
LL->m[i].data=(void *)LLL;
}
L->m[2].rtyp=LIST_CMD;
L->m[2].data=(void *)LL;
// ----------------------------------------
// 3: qideal
L->m[3].rtyp=IDEAL_CMD;
if (nCoeff_is_transExt(R->cf))
L->m[3].data=(void *)idInit(1,1);
else
{
ideal q=idInit(IDELEMS(r->qideal));
q->m[0]=p_Init(R);
pSetCoeff0(q->m[0],n_Copy((number)(r->qideal->m[0]),R->cf));
L->m[3].data=(void *)q;
// I->m[0] = pNSet(R->minpoly);
}
// ----------------------------------------
}
nCoeff_is_transExt
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition coeffs.h:913
pSetCoeff0
#define pSetCoeff0(p, n)
Definition monomials.h:59
p_Init
static poly p_Init(const ring r, omBin bin)
Definition p_polys.h:1341

## rDecomposeRing()

void rDecomposeRing | ( | leftv | h,
|  | const ring | R )

Definition at line 1915 of file ipshell.cc.

{
lists L=(lists)omAlloc0Bin(slists_bin);
if (rField_is_Z(R)) L->Init(1);
else L->Init(2);
h->rtyp=LIST_CMD;
h->data=(void *)L;
// 0: char/ cf - ring
// 1: list (module)
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=STRING_CMD;
L->m[0].data=(void *)omStrDup("integer");
// ----------------------------------------
// 1: module
if (rField_is_Z(R)) return;
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(2);
LL->m[0].rtyp=BIGINT_CMD;
LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
LL->m[1].rtyp=INT_CMD;
LL->m[1].data=(void *) R->cf->modExponent;
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
}
n_InitMPZ
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition coeffs.h:545
rField_is_Z
static BOOLEAN rField_is_Z(const ring r)
Definition ring.h:515

## rDecomposeRing_41()

void rDecomposeRing_41 | ( | leftv | h,
|  | const coeffs | C )

static

Definition at line 1888 of file ipshell.cc.

{
lists L=(lists)omAlloc0Bin(slists_bin);
if (nCoeff_is_Ring(C)) L->Init(1);
else L->Init(2);
h->rtyp=LIST_CMD;
h->data=(void *)L;
// 0: char/ cf - ring
// 1: list (module)
// ----------------------------------------
// 0: char/ cf - ring
L->m[0].rtyp=STRING_CMD;
L->m[0].data=(void *)omStrDup("integer");
// ----------------------------------------
// 1: modulo
if (nCoeff_is_Z(C)) return;
lists LL=(lists)omAlloc0Bin(slists_bin);
LL->Init(2);
LL->m[0].rtyp=BIGINT_CMD;
LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
LL->m[1].rtyp=INT_CMD;
LL->m[1].data=(void *) C->modExponent;
L->m[1].rtyp=LIST_CMD;
L->m[1].data=(void *)LL;
}
nCoeff_is_Z
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition coeffs.h:811

## rDefault()

idhdl rDefault | ( | const char * | s | ) |

Definition at line 1645 of file ipshell.cc.

{
idhdl tmp=NULL;
if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
if (tmp==NULL) return NULL;
if (sLastPrinted.RingDependend())
{
sLastPrinted.CleanUp();
}
ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
#ifndef TEST_ZN_AS_ZP
r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
#else
mpz_t modBase;
mpz_init_set_ui(modBase, (long)32003);
ZnmInfo info;
info.base= modBase;
info.exp= 1;
r->cf=nInitChar(n_Zn,(void*) &info);
r->cf->is_field=1;
r->cf->is_domain=1;
r->cf->has_simple_Inverse=1;
#endif
r->N = 3;
/*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
/*names*/
r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
r->names[0] = omStrDup("x");
r->names[1] = omStrDup("y");
r->names[2] = omStrDup("z");
/*weights: entries for 3 blocks: NULL*/
r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
/*order: dp,C,0*/
r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
r->block0 = (int *)omAlloc0(3 * sizeof(int *));
r->block1 = (int *)omAlloc0(3 * sizeof(int *));
/* ringorder dp for the first block: var 1..3 */
r->order[0] = ringorder_dp;
r->block0[0] = 1;
r->block1[0] = 3;
/* ringorder C for the second block: no vars */
r->order[1] = ringorder_C;
/* the last block: everything is 0 */
r->order[2] = (rRingOrder_t)0;
/* complete ring intializations */
rComplete(r);
rSetHdl(tmp);
return currRingHdl;
}

## rFindHdl()

idhdl rFindHdl | ( | ring | r,
|  | idhdl | n )

Definition at line 1701 of file ipshell.cc.

{
if ((r==NULL)||(r->VarOffset==NULL))
return NULL;
idhdl h=rSimpleFindHdl(r,IDROOT,n);
if (h!=NULL) return h;
if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
if (h!=NULL) return h;
proclevel *p=procstack;
while(p!=NULL)
{
if ((p->cPack!=basePack)
&& (p->cPack!=currPack))
h=rSimpleFindHdl(r,p->cPack->idroot,n);
if (h!=NULL) return h;
p=p->next;
}
idhdl tmp=basePack->idroot;
while (tmp!=NULL)
{
if (IDTYP(tmp)==PACKAGE_CMD)
h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
if (h!=NULL) return h;
tmp=IDNEXT(tmp);
}
return NULL;
}
proclevel
Definition ipid.h:56
procstack
VAR proclevel * procstack
Definition ipid.cc:50
rSimpleFindHdl
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition ipshell.cc:6269

## rInit()

ring rInit | ( | leftv | pn,
|  | leftv | rv,
|  | leftv | ord )

Definition at line 5628 of file ipshell.cc.

{
int float_len=0;
int float_len2=0;
ring R = NULL;
//BOOLEAN ffChar=FALSE;
/* ch -------------------------------------------------------*/
// get ch of ground field
// allocated ring
R = (ring) omAlloc0Bin(sip_sring_bin);
coeffs cf = NULL;
assume( pn != NULL );
const int P = pn->listLength();
if (pn->Typ()==CRING_CMD)
{
cf=(coeffs)pn->CopyD();
leftv pnn=pn;
if(P>1) /*parameter*/
{
pnn = pnn->next;
const int pars = pnn->listLength();
assume( pars > 0 );
char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
if (rSleftvList2StringArray(pnn, names))
{
WerrorS("parameter expected");
goto rInitError;
}
TransExtInfo extParam;
extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
for(int i=pars-1; i>=0;i--)
{
omFree(names[i]);
}
omFree(names);
cf = nInitChar(n_transExt, &extParam);
}
assume( cf != NULL );
}
else if (pn->Typ()==INT_CMD)
{
int ch = (int)(long)pn->Data();
leftv pnn=pn;
/* parameter? -------------------------------------------------------*/
pnn = pnn->next;
if (pnn == NULL) // no params!?
{
if (ch!=0)
{
int ch2=IsPrime(ch);
if ((ch<2)||(ch!=ch2))
{
Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
ch=32003;
}
#ifndef TEST_ZN_AS_ZP
cf = nInitChar(n_Zp, (void*)(long)ch);
#else
mpz_t modBase;
mpz_init_set_ui(modBase, (long)ch);
ZnmInfo info;
info.base= modBase;
info.exp= 1;
cf=nInitChar(n_Zn,(void*) &info);
cf->is_field=1;
cf->is_domain=1;
cf->has_simple_Inverse=1;
#endif
}
else
cf = nInitChar(n_Q, (void*)(long)ch);
}
else
{
const int pars = pnn->listLength();
assume( pars > 0 );
// predefined finite field: (p^k, a)
if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
{
GFInfo param;
param.GFChar = ch;
param.GFDegree = 1;
param.GFPar_name = pnn->name;
cf = nInitChar(n_GF, &param);
}
else // (0/p, a, b, ..., z)
{
if ((ch!=0) && (ch!=IsPrime(ch)))
{
WerrorS("too many parameters");
goto rInitError;
}
char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
if (rSleftvList2StringArray(pnn, names))
{
WerrorS("parameter expected");
goto rInitError;
}
TransExtInfo extParam;
extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
for(int i=pars-1; i>=0;i--)
{
omFree(names[i]);
}
omFree(names);
cf = nInitChar(n_transExt, &extParam);
}
}
//if (cf==NULL) ->Error: Invalid ground field specification
}
else if ((pn->name != NULL)
&& ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
{
leftv pnn=pn->next;
BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
{
float_len=(int)(long)pnn->Data();
float_len2=float_len;
pnn=pnn->next;
if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
{
float_len2=(int)(long)pnn->Data();
pnn=pnn->next;
}
}
if (!complex_flag)
complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
if( !complex_flag && (float_len <= (short)SHORT_REAL_LENGTH))
cf=nInitChar(n_R, NULL);
else // longR or longC?
{
LongComplexInfo param;
param.float_len = si_min (float_len, 32767);
param.float_len2 = si_min (float_len2, 32767);
// set the parameter name
if (complex_flag)
{
if (param.float_len < SHORT_REAL_LENGTH)
{
param.float_len= SHORT_REAL_LENGTH;
param.float_len2= SHORT_REAL_LENGTH;
}
if ((pnn == NULL) || (pnn->name == NULL))
param.par_name=(const char*)"i"; //default to i
else
param.par_name = (const char*)pnn->name;
}
cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
}
assume( cf != NULL );
}
else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
{
// TODO: change to use coeffs_BIGINT!?
mpz_t modBase;
unsigned int modExponent = 1;
mpz_init_set_si(modBase, 0);
if (pn->next!=NULL)
{
leftv pnn=pn;
if (pnn->next->Typ()==INT_CMD)
{
pnn=pnn->next;
mpz_set_ui(modBase, (long) pnn->Data());
if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
{
pnn=pnn->next;
modExponent = (long) pnn->Data();
}
while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
{
pnn=pnn->next;
mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
}
}
else if (pnn->next->Typ()==BIGINT_CMD)
{
number p=(number)pnn->next->CopyD();
n_MPZ(modBase,p,coeffs_BIGINT);
n_Delete(&p,coeffs_BIGINT);
}
}
else
cf=nInitChar(n_Z,NULL);
if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
{
WerrorS("Wrong ground ring specification (module is 1)");
goto rInitError;
}
if (modExponent < 1)
{
WerrorS("Wrong ground ring specification (exponent smaller than 1");
goto rInitError;
}
// module is 0 ---> integers ringtype = 4;
// we have an exponent
if (modExponent > 1 && cf == NULL)
{
if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
{
/* this branch should be active for modExponent = 2..32 resp. 2..64,
depending on the size of a long on the respective platform */
//ringtype = 1; // Use Z/2^ch
cf=nInitChar(n_Z2m,(void*)(long)modExponent);
}
else
{
if (mpz_sgn1(modBase)==0)
{
WerrorS("modulus must not be 0 or parameter not allowed");
goto rInitError;
}
//ringtype = 3;
ZnmInfo info;
info.base= modBase;
info.exp= modExponent;
cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
}
}
// just a module m > 1
else if (cf == NULL)
{
if (mpz_sgn1(modBase)==0)
{
WerrorS("modulus must not be 0 or parameter not allowed");
goto rInitError;
}
//ringtype = 2;
ZnmInfo info;
info.base= modBase;
info.exp= modExponent;
cf=nInitChar(n_Zn,(void*) &info);
}
assume( cf != NULL );
mpz_clear(modBase);
}
// ring NEW = OLD, (), (); where OLD is a polynomial ring...
else if ((pn->Typ()==RING_CMD) && (P == 1))
{
ring r=(ring)pn->Data();
if (r->qideal==NULL)
{
TransExtInfo extParam;
extParam.r = r;
extParam.r->ref++;
cf = nInitChar(n_transExt, &extParam); // R(a)
}
else if (IDELEMS(r->qideal)==1)
{
AlgExtInfo extParam;
extParam.r=r;
extParam.r->ref++;
cf = nInitChar(n_algExt, &extParam); // R[a]/<minideal>
}
else
{
WerrorS("algebraic extension ring must have one minpoly");
goto rInitError;
}
}
else
{
WerrorS("Wrong or unknown ground field specification");
#if 0
// debug stuff for unknown cf descriptions:
sleftv* p = pn;
while (p != NULL)
{
Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
PrintLn();
p = p->next;
}
#endif
goto rInitError;
}
/*every entry in the new ring is initialized to 0*/
/* characteristic -----------------------------------------------*/
/* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
* 0 1 : Q(a,...) *names FALSE
* 0 -1 : R NULL FALSE 0
* 0 -1 : R NULL FALSE prec. >6
* 0 -1 : C *names FALSE prec. 0..?
* p p : Fp NULL FALSE
* p -p : Fp(a) *names FALSE
* q q : GF(q=p^n) *names TRUE
*/
if (cf==NULL)
{
WerrorS("Invalid ground field specification");
goto rInitError;
// const int ch=32003;
// cf=nInitChar(n_Zp, (void*)(long)ch);
}
assume( R != NULL );
R->cf = cf;
/* names and number of variables-------------------------------------*/
{
int l=rv->listLength();
if (l>MAX_SHORT)
{
Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
goto rInitError;
}
R->N = l; /*rv->listLength();*/
}
R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
if (rSleftvList2StringArray(rv, R->names))
{
WerrorS("name of ring variable expected");
goto rInitError;
}
/* check names and parameters for conflicts ------------------------- */
rRenameVars(R); // conflicting variables will be renamed
/* ordering -------------------------------------------------------------*/
if (rSleftvOrdering2Ordering(ord, R))
goto rInitError;
// Complete the initialization
if (rComplete(R,1))
goto rInitError;
/*#ifdef HAVE_RINGS
// currently, coefficients which are ring elements require a global ordering:
if (rField_is_Ring(R) && (R->OrdSgn==-1))
{
WerrorS("global ordering required for these coefficients");
goto rInitError;
}
#endif*/
rTest(R);
// try to enter the ring into the name list
// need to clean up sleftv here, before this ring can be set to
// new currRing or currRing can be killed beacuse new ring has
// same name
pn->CleanUp();
rv->CleanUp();
ord->CleanUp();
//if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
// goto rInitError;
//memcpy(IDRING(tmp),R,sizeof(*R));
// set current ring
//omFreeBin(R, ip_sring_bin);
//return tmp;
return R;
// error case:
rInitError:
if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
pn->CleanUp();
rv->CleanUp();
ord->CleanUp();
return NULL;
}
cf
CanonicalForm cf
Definition cfModGcd.cc:4091
n_Delete
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition coeffs.h:461
rDefault
idhdl rDefault(const char *s)
Definition ipshell.cc:1645
MAX_SHORT
const short MAX_SHORT
Definition ipshell.cc:5616
rSleftvOrdering2Ordering
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition ipshell.cc:5308
rSleftvList2StringArray
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition ipshell.cc:5580
rDelete
void rDelete(ring r)
unconditionally deletes fields in r
Definition ring.cc:454
rTest
#define rTest(r)
Definition ring.h:794

## rKill() [1/2]

void rKill | ( | idhdl | h | ) |

Definition at line 6226 of file ipshell.cc.

{
ring r = IDRING(h);
int ref=0;
if (r!=NULL)
{
// avoid, that sLastPrinted is the last reference to the base ring:
// clean up before killing the last "named" refrence:
if ((sLastPrinted.rtyp==RING_CMD)
&& (sLastPrinted.data==(void*)r))
{
sLastPrinted.CleanUp(r);
}
ref=r->ref;
if ((ref<=0)&&(r==currRing))
{
// cleanup DENOMINATOR_LIST
if (DENOMINATOR_LIST!=NULL)
{
denominator_list dd=DENOMINATOR_LIST;
if (TEST_V_ALLWARN)
Warn("deleting denom_list for ring change from %s",IDID(h));
do
{
n_Delete(&(dd->n),currRing->cf);
dd=dd->next;
omFreeBinAddr(DENOMINATOR_LIST);
DENOMINATOR_LIST=dd;
} while(DENOMINATOR_LIST!=NULL);
}
}
rKill(r);
}
if (h==currRingHdl)
{
if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
else
{
currRingHdl=rFindHdl(r,currRingHdl);
}
}
}
rKill
void rKill(ring r)
Definition ipshell.cc:6181
DENOMINATOR_LIST
VAR denominator_list DENOMINATOR_LIST
Definition kutil.cc:79
denominator_list
denominator_list_s * denominator_list
Definition kutil.h:64
denominator_list_s::n
number n
Definition kutil.h:66
denominator_list_s::next
denominator_list next
Definition kutil.h:66

## rKill() [2/2]

void rKill | ( | ring | r | ) |

Definition at line 6181 of file ipshell.cc.

{
if ((r->ref<=0)&&(r->order!=NULL))
{
#ifdef RDEBUG
if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
#endif
int j;
for (j=0;j<myynest;j++)
{
if (iiLocalRing[j]==r)
{
if (j==0) WarnS("killing the basering for level 0");
iiLocalRing[j]=NULL;
}
}
// any variables depending on r ?
while (r->idroot!=NULL)
{
r->idroot->lev=myynest; // avoid warning about kill global objects
killhdl2(r->idroot,&(r->idroot),r);
}
if (r==currRing)
{
// all dependend stuff is done, clean global vars:
if (sLastPrinted.RingDependend())
{
sLastPrinted.CleanUp();
}
//if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
//{
// WerrorS("return value depends on local ring variable (export missing ?)");
// iiRETURNEXPR.CleanUp();
//}
currRing=NULL;
currRingHdl=NULL;
}
/* nKillChar(r); will be called from inside of rDelete */
rDelete(r);
return;
}
rDecRefCnt(r);
}

## rOptimizeOrdAsSleftv()

leftv rOptimizeOrdAsSleftv | ( | leftv | ord | ) |

static

Definition at line 5189 of file ipshell.cc.

{
// change some bad orderings/combination into better ones
leftv h=ord;
while(h!=NULL)
{
BOOLEAN change=FALSE;
intvec *iv = (intvec *)(h->data);
// ws(-i) -> wp(i)
if ((*iv)[1]==ringorder_ws)
{
BOOLEAN neg=TRUE;
for(int i=2;i<iv->length();i++)
if((*iv)[i]>=0) { neg=FALSE; break; }
if (neg)
{
(*iv)[1]=ringorder_wp;
for(int i=2;i<iv->length();i++)
(*iv)[i]= - (*iv)[i];
change=TRUE;
}
}
// Ws(-i) -> Wp(i)
if ((*iv)[1]==ringorder_Ws)
{
BOOLEAN neg=TRUE;
for(int i=2;i<iv->length();i++)
if((*iv)[i]>=0) { neg=FALSE; break; }
if (neg)
{
(*iv)[1]=ringorder_Wp;
for(int i=2;i<iv->length();i++)
(*iv)[i]= -(*iv)[i];
change=TRUE;
}
}
// wp(1) -> dp
if ((*iv)[1]==ringorder_wp)
{
BOOLEAN all_one=TRUE;
for(int i=2;i<iv->length();i++)
if((*iv)[i]!=1) { all_one=FALSE; break; }
if (all_one)
{
intvec *iv2=new intvec(3);
(*iv2)[0]=1;
(*iv2)[1]=ringorder_dp;
(*iv2)[2]=iv->length()-2;
delete iv;
iv=iv2;
h->data=iv2;
change=TRUE;
}
}
// Wp(1) -> Dp
if ((*iv)[1]==ringorder_Wp)
{
BOOLEAN all_one=TRUE;
for(int i=2;i<iv->length();i++)
if((*iv)[i]!=1) { all_one=FALSE; break; }
if (all_one)
{
intvec *iv2=new intvec(3);
(*iv2)[0]=1;
(*iv2)[1]=ringorder_Dp;
(*iv2)[2]=iv->length()-2;
delete iv;
iv=iv2;
h->data=iv2;
change=TRUE;
}
}
// dp(1)/Dp(1)/rp(1) -> lp(1)
if (((*iv)[1]==ringorder_dp)
|| ((*iv)[1]==ringorder_Dp)
|| ((*iv)[1]==ringorder_rp))
{
if (iv->length()==3)
{
if ((*iv)[2]==1)
{
if(h->next!=NULL)
{
intvec *iv2 = (intvec *)(h->next->data);
if ((*iv2)[1]==ringorder_lp)
{
(*iv)[1]=ringorder_lp;
change=TRUE;
}
}
}
}
}
// lp(i),lp(j) -> lp(i+j)
if(((*iv)[1]==ringorder_lp)
&& (h->next!=NULL))
{
intvec *iv2 = (intvec *)(h->next->data);
if ((*iv2)[1]==ringorder_lp)
{
leftv hh=h->next;
h->next=hh->next;
hh->next=NULL;
if ((*iv2)[0]==1)
(*iv)[2] += 1; // last block unspecified, at least 1
else
(*iv)[2] += (*iv2)[2];
hh->CleanUp();
omFreeBin(hh,sleftv_bin);
change=TRUE;
}
}
// -------------------
if (!change) h=h->next;
}
return ord;
}

## rRenameVars()

void rRenameVars | ( | ring | R | ) |

static

Definition at line 2395 of file ipshell.cc.

{
int i,j;
BOOLEAN ch;
do
{
ch=0;
for(i=0;i<R->N-1;i++)
{
for(j=i+1;j<R->N;j++)
{
if (strcmp(R->names[i],R->names[j])==0)
{
ch=TRUE;
Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`in >>%s<<\nin %s:%d",i+1,j+1,R->names[i],R->names[i],my_yylinebuf,currentVoice->filename,yylineno);
omFree(R->names[j]);
size_t len=2+strlen(R->names[i]);
R->names[j]=(char *)omAlloc(len);
snprintf(R->names[j],len,"@%s",R->names[i]);
}
}
}
}
while (ch);
for(i=0;i<rPar(R); i++)
{
for(j=0;j<R->N;j++)
{
if (strcmp(rParameter(R)[i],R->names[j])==0)
{
Warn("name conflict par(%d) and var(%d): `%s`, rename the VARIABLE to `@@(%d)`in >>%s<<\nin %s:%d",i+1,j+1,R->names[j],i+1,my_yylinebuf,currentVoice->filename,yylineno);
// omFree(rParameter(R)[i]);
// rParameter(R)[i]=(char *)omAlloc(10);
// sprintf(rParameter(R)[i],"@@(%d)",i+1);
omFree(R->names[j]);
R->names[j]=(char *)omAlloc(16);
snprintf(R->names[j],16,"@@(%d)",i+1);
}
}
}
}

## rSetHdl()

void rSetHdl | ( | idhdl | h | ) |

Definition at line 5129 of file ipshell.cc.

{
ring rg = NULL;
if (h!=NULL)
{
// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
rg = IDRING(h);
if (rg==NULL) return; //id <>NULL, ring==NULL
omCheckAddrSize((ADDRESS)h,sizeof(idrec));
if (IDID(h)) // OB: ????
omCheckAddr((ADDRESS)IDID(h));
rTest(rg);
}
else return;
// clean up history
if (currRing!=NULL)
{
if(sLastPrinted.RingDependend())
{
sLastPrinted.CleanUp();
}
if (rg!=currRing)/*&&(currRing!=NULL)*/
{
if (rg->cf!=currRing->cf)
{
denominator_list dd=DENOMINATOR_LIST;
if (DENOMINATOR_LIST!=NULL)
{
if (TEST_V_ALLWARN)
Warn("deleting denom_list for ring change to %s",IDID(h));
do
{
n_Delete(&(dd->n),currRing->cf);
dd=dd->next;
omFreeBinAddr(DENOMINATOR_LIST);
DENOMINATOR_LIST=dd;
} while(DENOMINATOR_LIST!=NULL);
}
}
}
}
// test for valid "currRing":
if ((rg!=NULL) && (rg->idroot==NULL))
{
ring old=rg;
rg=rAssure_HasComp(rg);
if (old!=rg)
{
rKill(old);
IDRING(h)=rg;
}
}
/*------------ change the global ring -----------------------*/
rChangeCurrRing(rg);
currRingHdl = h;
}
omCheckAddr
#define omCheckAddr(addr)
Definition omAllocDecl.h:328
omCheckAddrSize
#define omCheckAddrSize(addr, size)
Definition omAllocDecl.h:327
rAssure_HasComp
ring rAssure_HasComp(const ring r)
Definition ring.cc:4717

## rSimpleFindHdl()

idhdl rSimpleFindHdl | ( | const ring | r,
|  | const idhdl | root,
|  | const idhdl | n )

static

Definition at line 6269 of file ipshell.cc.

{
idhdl h=root;
while (h!=NULL)
{
if ((IDTYP(h)==RING_CMD)
&& (h!=n)
&& (IDRING(h)==r)
)
{
return h;
}
h=IDNEXT(h);
}
return NULL;
}

## rSleftvList2StringArray()

BOOLEAN rSleftvList2StringArray | ( | leftv | sl,
|  | char ** | p )

static

Definition at line 5580 of file ipshell.cc.

{
while(sl!=NULL)
{
if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
{
*p = omStrDup(sl->Name());
}
else if (sl->name!=NULL)
{
*p = (char*)sl->name;
sl->name=NULL;
}
else if (sl->rtyp==POLY_CMD)
{
sleftv s_sl;
iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
if (s_sl.name != NULL)
{
*p = (char*)s_sl.name; s_sl.name=NULL;
}
else
*p = NULL;
sl->next = s_sl.next;
s_sl.next = NULL;
s_sl.CleanUp();
if (*p == NULL) return TRUE;
}
else return TRUE;
p++;
sl=sl->next;
}
return FALSE;
}

## rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering | ( | sleftv * | ord,
|  | ring | R )

Definition at line 5308 of file ipshell.cc.

{
int last = 0, o=0, n = 1, i=0, typ = 1, j;
ord=rOptimizeOrdAsSleftv(ord);
sleftv *sl = ord;
// determine nBlocks
while (sl!=NULL)
{
intvec *iv = (intvec *)(sl->data);
if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
i++;
else if ((*iv)[1]==ringorder_L)
{
R->wanted_maxExp=(*iv)[2]*2+1;
n--;
}
else if (((*iv)[1]!=ringorder_a)
&& ((*iv)[1]!=ringorder_a64)
&& ((*iv)[1]!=ringorder_am))
o++;
n++;
sl=sl->next;
}
// check whether at least one real ordering
if (o==0)
{
WerrorS("invalid combination of orderings");
return TRUE;
}
// if no c/C ordering is given, increment n
if (i==0) n++;
else if (i != 1)
{
// throw error if more than one is given
WerrorS("more than one ordering c/C specified");
return TRUE;
}
// initialize fields of R
R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
R->block0=(int *)omAlloc0(n*sizeof(int));
R->block1=(int *)omAlloc0(n*sizeof(int));
R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
// init order, so that rBlocks works correctly
for (j=0; j < n-1; j++)
R->order[j] = ringorder_unspec;
// set last _C order, if no c/C order was given
if (i == 0) R->order[n-2] = ringorder_C;
/* init orders */
sl=ord;
n=-1;
while (sl!=NULL)
{
intvec *iv;
iv = (intvec *)(sl->data);
if ((*iv)[1]!=ringorder_L)
{
n++;
/* the format of an ordering:
* iv[0]: factor
* iv[1]: ordering
* iv[2..end]: weights
*/
R->order[n] = (rRingOrder_t)((*iv)[1]);
typ=1;
switch ((*iv)[1])
{
case ringorder_ws:
case ringorder_Ws:
typ=-1; // and continue
case ringorder_wp:
case ringorder_Wp:
R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
R->block0[n] = last+1;
for (i=2; i<iv->length(); i++)
{
R->wvhdl[n][i-2] = (*iv)[i];
last++;
if (weights[last]==0) weights[last]=(*iv)[i]*typ;
}
R->block1[n] = si_min(last,R->N);
break;
case ringorder_ls:
case ringorder_ds:
case ringorder_Ds:
case ringorder_rs:
typ=-1; // and continue
case ringorder_lp:
case ringorder_dp:
case ringorder_Dp:
case ringorder_rp:
R->block0[n] = last+1;
if (iv->length() == 3) last+=(*iv)[2];
else last += (*iv)[0];
R->block1[n] = si_min(last,R->N);
if (rCheckIV(iv)) return TRUE;
for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
{
if (weights[i]==0) weights[i]=typ;
}
break;
case ringorder_s: // no 'rank' params!
{
if(iv->length() > 3)
return TRUE;
if(iv->length() == 3)
{
const int s = (*iv)[2];
R->block0[n] = s;
R->block1[n] = s;
}
break;
}
case ringorder_IS:
{
if(iv->length() != 3) return TRUE;
const int s = (*iv)[2];
if( 1 < s || s < -1 ) return TRUE;
R->block0[n] = s;
R->block1[n] = s;
break;
}
case ringorder_S:
case ringorder_c:
case ringorder_C:
{
if (rCheckIV(iv)) return TRUE;
break;
}
case ringorder_aa:
case ringorder_a:
{
R->block0[n] = last+1;
R->block1[n] = si_min(last+iv->length()-2 , R->N);
R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
for (i=2; i<iv->length(); i++)
{
R->wvhdl[n][i-2]=(*iv)[i];
last++;
if (weights[last]==0) weights[last]=(*iv)[i]*typ;
}
last=R->block0[n]-1;
break;
}
case ringorder_am:
{
R->block0[n] = last+1;
R->block1[n] = si_min(last+iv->length()-2 , R->N);
R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
if (R->block1[n]- R->block0[n]+2>=iv->length())
WarnS("missing module weights");
for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
{
R->wvhdl[n][i-2]=(*iv)[i];
last++;
if (weights[last]==0) weights[last]=(*iv)[i]*typ;
}
R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
for (; i<iv->length(); i++)
{
R->wvhdl[n][i-1]=(*iv)[i];
}
last=R->block0[n]-1;
break;
}
case ringorder_a64:
{
R->block0[n] = last+1;
R->block1[n] = si_min(last+iv->length()-2 , R->N);
R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
int64 *w=(int64 *)R->wvhdl[n];
for (i=2; i<iv->length(); i++)
{
w[i-2]=(*iv)[i];
last++;
if (weights[last]==0) weights[last]=(*iv)[i]*typ;
}
last=R->block0[n]-1;
break;
}
case ringorder_M:
{
int Mtyp=rTypeOfMatrixOrder(iv);
if (Mtyp==0) return TRUE;
if (Mtyp==-1) typ = -1;
R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
for (i=2; i<iv->length();i++)
R->wvhdl[n][i-2]=(*iv)[i];
R->block0[n] = last+1;
last += (int)sqrt((double)(iv->length()-2));
R->block1[n] = si_min(last,R->N);
for(i=R->block1[n];i>=R->block0[n];i--)
{
if (weights[i]==0) weights[i]=typ;
}
break;
}
case ringorder_no:
R->order[n] = ringorder_unspec;
return TRUE;
default:
Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
R->order[n] = ringorder_unspec;
return TRUE;
}
}
if (last>R->N)
{
Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
R->N,last);
return TRUE;
}
sl=sl->next;
}
// find OrdSgn:
R->OrdSgn = 1;
for(i=1;i<=R->N;i++)
{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
omFree(weights);
// check for complete coverage
while ( n >= 0 && (
(R->order[n]==ringorder_c)
|| (R->order[n]==ringorder_C)
|| (R->order[n]==ringorder_s)
|| (R->order[n]==ringorder_S)
|| (R->order[n]==ringorder_IS)
)) n--;
assume( n >= 0 );
if (R->block1[n] != R->N)
{
if (((R->order[n]==ringorder_dp) ||
(R->order[n]==ringorder_ds) ||
(R->order[n]==ringorder_Dp) ||
(R->order[n]==ringorder_Ds) ||
(R->order[n]==ringorder_rp) ||
(R->order[n]==ringorder_rs) ||
(R->order[n]==ringorder_lp) ||
(R->order[n]==ringorder_ls))
&&
R->block0[n] <= R->N)
{
R->block1[n] = R->N;
}
else
{
Werror("mismatch of number of vars (%d) and ordering (%d vars)",
R->N,R->block1[n]);
return TRUE;
}
}
return FALSE;
}
int64
long int64
Definition auxiliary.h:68
last
STATIC_VAR poly last
Definition hdegree.cc:1138
rOptimizeOrdAsSleftv
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition ipshell.cc:5189
rTypeOfMatrixOrder
int rTypeOfMatrixOrder(const intvec *order)
Definition ring.cc:186
rCheckIV
BOOLEAN rCheckIV(const intvec *iv)
Definition ring.cc:176
ringorder_no
@ ringorder_no
Definition ring.h:70

## rSubring()

ring rSubring | ( | ring | org_ring,
|  | sleftv * | rv )

Definition at line 6019 of file ipshell.cc.

{
ring R = rCopy0(org_ring);
int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
int n = rBlocks(org_ring), i=0, j;
/* names and number of variables-------------------------------------*/
{
int l=rv->listLength();
if (l>MAX_SHORT)
{
Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
goto rInitError;
}
R->N = l; /*rv->listLength();*/
}
omFree(R->names);
R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
if (rSleftvList2StringArray(rv, R->names))
{
WerrorS("name of ring variable expected");
goto rInitError;
}
/* check names for subring in org_ring ------------------------- */
{
i=0;
for(j=0;j<R->N;j++)
{
for(;i<org_ring->N;i++)
{
if (strcmp(org_ring->names[i],R->names[j])==0)
{
perm[i+1]=j+1;
break;
}
}
if (i>org_ring->N)
{
Werror("variable %d (%s) not in basering",j+1,R->names[j]);
break;
}
}
}
//Print("perm=");
//for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
/* ordering -------------------------------------------------------------*/
for(i=0;i<n;i++)
{
int min_var=-1;
int max_var=-1;
for(j=R->block0[i];j<=R->block1[i];j++)
{
if (perm[j]>0)
{
if (min_var==-1) min_var=perm[j];
max_var=perm[j];
}
}
if (min_var!=-1)
{
//Print("block %d: old %d..%d, now:%d..%d\n",
// i,R->block0[i],R->block1[i],min_var,max_var);
R->block0[i]=min_var;
R->block1[i]=max_var;
if (R->wvhdl[i]!=NULL)
{
omFree(R->wvhdl[i]);
R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
{
if (perm[j]>0)
{
R->wvhdl[i][perm[j]-R->block0[i]]=
org_ring->wvhdl[i][j-org_ring->block0[i]];
//Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
}
}
}
}
else
{
if(R->block0[i]>0)
{
//Print("skip block %d\n",i);
R->order[i]=ringorder_unspec;
if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
R->wvhdl[i]=NULL;
}
//else Print("keep block %d\n",i);
}
}
i=n-1;
while(i>0)
{
// removed unneded blocks
if(R->order[i-1]==ringorder_unspec)
{
for(j=i;j<=n;j++)
{
R->order[j-1]=R->order[j];
R->block0[j-1]=R->block0[j];
R->block1[j-1]=R->block1[j];
if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
R->wvhdl[j-1]=R->wvhdl[j];
}
R->order[n]=ringorder_unspec;
n--;
}
i--;
}
n=rBlocks(org_ring)-1;
while (R->order[n]==0) n--;
while (R->order[n]==ringorder_unspec) n--;
if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
if (R->block1[n] != R->N)
{
if (((R->order[n]==ringorder_dp) ||
(R->order[n]==ringorder_ds) ||
(R->order[n]==ringorder_Dp) ||
(R->order[n]==ringorder_Ds) ||
(R->order[n]==ringorder_rp) ||
(R->order[n]==ringorder_rs) ||
(R->order[n]==ringorder_lp) ||
(R->order[n]==ringorder_ls))
&&
R->block0[n] <= R->N)
{
R->block1[n] = R->N;
}
else
{
Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
R->N,R->block1[n],n);
return NULL;
}
}
omFree(perm);
// find OrdSgn:
R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
//for(i=1;i<=R->N;i++)
//{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
//omFree(weights);
// Complete the initialization
if (rComplete(R,1))
goto rInitError;
rTest(R);
if (rv != NULL) rv->CleanUp();
return R;
// error case:
rInitError:
if (R != NULL) rDelete(R);
if (rv != NULL) rv->CleanUp();
return NULL;
}
rCopy0
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition ring.cc:1427

## scIndIndset()

lists scIndIndset | ( | ideal | S,
|  | BOOLEAN | all,
|  | ideal | Q )

Definition at line 1111 of file ipshell.cc.

{
int i;
indset save;
lists res=(lists)omAlloc0Bin(slists_bin);
hexist = hInit(S, Q, &hNexist);
if (hNexist == 0)
{
intvec *iv=new intvec(rVar(currRing));
for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
res->Init(1);
res->m[0].rtyp=INTVEC_CMD;
res->m[0].data=(intvec*)iv;
return res;
}
save = ISet = (indset)omAlloc0Bin(indlist_bin);
hMu = 0;
hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
hrad = hexist;
hNrad = hNexist;
radmem = hCreate(rVar(currRing) - 1);
hCo = rVar(currRing) + 1;
hNvar = rVar(currRing);
hRadical(hrad, &hNrad, hNvar);
hSupp(hrad, hNrad, hvar, &hNvar);
if (hNvar)
{
hCo = hNvar;
hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
hLexR(hrad, hNrad, hvar, hNvar);
hDimSolve(hpure, hNpure, hrad, hNrad, hvar, hNvar);
}
if (hCo && (hCo < rVar(currRing)))
{
hIndMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
}
if (hMu!=0)
{
ISet = save;
hMu2 = 0;
if (all && (hCo+1 < rVar(currRing)))
{
JSet = (indset)omAlloc0Bin(indlist_bin);
hIndAllMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
i=hMu+hMu2;
res->Init(i);
if (hMu2 == 0)
{
omFreeBin((ADDRESS)JSet, indlist_bin);
}
}
else
{
res->Init(hMu);
}
for (i=0;i<hMu;i++)
{
res->m[i].data = (void *)save->set;
res->m[i].rtyp = INTVEC_CMD;
ISet = save;
save = save->nx;
omFreeBin((ADDRESS)ISet, indlist_bin);
}
omFreeBin((ADDRESS)save, indlist_bin);
if (hMu2 != 0)
{
save = JSet;
for (i=hMu;i<hMu+hMu2;i++)
{
res->m[i].data = (void *)save->set;
res->m[i].rtyp = INTVEC_CMD;
JSet = save;
save = save->nx;
omFreeBin((ADDRESS)JSet, indlist_bin);
}
omFreeBin((ADDRESS)save, indlist_bin);
}
}
else
{
res->Init(0);
omFreeBin((ADDRESS)ISet, indlist_bin);
}
hKill(radmem, rVar(currRing) - 1);
omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
hDelete(hexist, hNexist);
return res;
}
hIndMult
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition hdegree.cc:382
indlist_bin
VAR omBin indlist_bin
Definition hdegree.cc:29
hMu2
VAR int hMu2
Definition hdegree.cc:27
hCo
VAR int hCo
Definition hdegree.cc:27
ISet
VAR indset ISet
Definition hdegree.cc:351
hMu
VAR long hMu
Definition hdegree.cc:28
JSet
VAR indset JSet
Definition hdegree.cc:351
hDimSolve
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition hdegree.cc:35
hIndAllMult
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition hdegree.cc:562
hCreate
monf hCreate(int Nvar)
Definition hutil.cc:996
hvar
VAR varset hvar
Definition hutil.cc:18
hKill
void hKill(monf xmem, int Nvar)
Definition hutil.cc:1010
hNexist
VAR int hNexist
Definition hutil.cc:19
hDelete
void hDelete(scfmon ev, int ev_length)
Definition hutil.cc:140
hPure
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition hutil.cc:621
hwork
VAR scfmon hwork
Definition hutil.cc:16
hSupp
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition hutil.cc:174
hLexR
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition hutil.cc:565
hpure
VAR scmon hpure
Definition hutil.cc:17
hrad
VAR scfmon hrad
Definition hutil.cc:16
radmem
VAR monf radmem
Definition hutil.cc:21
hNpure
VAR int hNpure
Definition hutil.cc:19
hNrad
VAR int hNrad
Definition hutil.cc:19
hInit
scfmon hInit(ideal S, ideal Q, int *Nexist)
Definition hutil.cc:31
hexist
VAR scfmon hexist
Definition hutil.cc:16
hRadical
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition hutil.cc:411
hNvar
VAR int hNvar
Definition hutil.cc:19
scfmon
scmon * scfmon
Definition hutil.h:15
indset
indlist * indset
Definition hutil.h:28
varset
int * varset
Definition hutil.h:16
scmon
int * scmon
Definition hutil.h:14
Q
#define Q
Definition sirandom.c:26

## semicProc()

BOOLEAN semicProc | ( | leftv | res,
|  | leftv | u,
|  | leftv | v )

Definition at line 4554 of file ipshell.cc.

{
sleftv tmp;
tmp.Init();
tmp.rtyp=INT_CMD;
/* tmp.data = (void *)0; -- done by Init */
return semicProc3(res,u,v,&tmp);
}
semicProc3
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition ipshell.cc:4514

## semicProc3()

BOOLEAN semicProc3 | ( | leftv | res,
|  | leftv | u,
|  | leftv | v,
|  | leftv | w )

Definition at line 4514 of file ipshell.cc.

{
semicState state;
BOOLEAN qh=(((int)(long)w->Data())==1);
// -----------------
// check arguments
// -----------------
lists l1 = (lists)u->Data( );
lists l2 = (lists)v->Data( );
if( (state=list_is_spectrum( l1 ))!=semicOK )
{
WerrorS( "first argument is not a spectrum" );
list_error( state );
}
else if( (state=list_is_spectrum( l2 ))!=semicOK )
{
WerrorS( "second argument is not a spectrum" );
list_error( state );
}
else
{
spectrum s1= spectrumFromList( l1 );
spectrum s2= spectrumFromList( l2 );
res->rtyp = INT_CMD;
if (qh)
res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
else
res->data = (void*)(long)(s1.mult_spectrum( s2 ));
}
// -----------------
// check status
// -----------------
return (state!=semicOK);
}
spectrum
Definition semic.h:64
spectrum::mult_spectrum
int mult_spectrum(spectrum &)
Definition semic.cc:396
spectrum::mult_spectrumh
int mult_spectrumh(spectrum &)
Definition semic.cc:425
list_error
void list_error(semicState state)
Definition ipshell.cc:3470
spectrumFromList
spectrum spectrumFromList(lists l)
Definition ipshell.cc:3386
list_is_spectrum
semicState list_is_spectrum(lists l)
Definition ipshell.cc:4256

## siSetCpus()

int siSetCpus | ( | int | cpu | ) |

Definition at line 6665 of file ipshell.cc.

{
int old=(int)(long)feOptValue(FE_OPT_CPUS);
feSetOptValue(FE_OPT_CPUS,cpu);
return old;
}
feSetOptValue
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition feOpt.cc:154
feOptValue
static void * feOptValue(feOptIndex opt)
Definition feOpt.h:40

## spaddProc()

BOOLEAN spaddProc | ( | leftv | result,
|  | leftv | first,
|  | leftv | second )

Definition at line 4431 of file ipshell.cc.

{
semicState state;
// -----------------
// check arguments
// -----------------
lists l1 = (lists)first->Data( );
lists l2 = (lists)second->Data( );
if( (state=list_is_spectrum( l1 )) != semicOK )
{
WerrorS( "first argument is not a spectrum:" );
list_error( state );
}
else if( (state=list_is_spectrum( l2 )) != semicOK )
{
WerrorS( "second argument is not a spectrum:" );
list_error( state );
}
else
{
spectrum s1= spectrumFromList ( l1 );
spectrum s2= spectrumFromList ( l2 );
spectrum sum( s1+s2 );
result->rtyp = LIST_CMD;
result->data = (char*)(getList(sum));
}
return (state!=semicOK);
}
getList
lists getList(spectrum &spec)
Definition ipshell.cc:3398

## spectrumCompute()

spectrumState spectrumCompute | ( | poly | h,
|  | lists * | L,
|  | int | fast )

Definition at line 3812 of file ipshell.cc.

{
int i;
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "spectrumCompute\n";
if( fast==0 ) cout << " no optimization" << endl;
if( fast==1 ) cout << " weight optimization" << endl;
if( fast==2 ) cout << " symmetry optimization" << endl;
#else
fputs( "spectrumCompute\n",stdout );
if( fast==0 ) fputs( " no optimization\n", stdout );
if( fast==1 ) fputs( " weight optimization\n", stdout );
if( fast==2 ) fputs( " symmetry optimization\n", stdout );
#endif
#endif
#endif
// ----------------------
// check if h is zero
// ----------------------
if( h==(poly)NULL )
{
return spectrumZero;
}
// ----------------------------------
// check if h has a constant term
// ----------------------------------
if( hasConstTerm( h, currRing ) )
{
return spectrumBadPoly;
}
// --------------------------------
// check if h has a linear term
// --------------------------------
if( hasLinearTerm( h, currRing ) )
{
*L = (lists)omAllocBin( slists_bin);
(*L)->Init( 1 );
(*L)->m[0].rtyp = INT_CMD; // milnor number
/* (*L)->m[0].data = (void*)0;a -- done by Init */
return spectrumNoSingularity;
}
// ----------------------------------
// compute the jacobi ideal of (h)
// ----------------------------------
ideal J = NULL;
J = idInit( rVar(currRing),1 );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "\n computing the Jacobi ideal...\n";
#else
fputs( "\n computing the Jacobi ideal...\n",stdout );
#endif
#endif
#endif
for( i=0; i<rVar(currRing); i++ )
{
J->m[i] = pDiff( h,i+1); //j );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << " ";
#else
fputs(" ", stdout );
#endif
pWrite( J->m[i] );
#endif
#endif
}
// --------------------------------------------
// compute a standard basis stdJ of jac(h)
// --------------------------------------------
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << endl;
cout << " computing a standard basis..." << endl;
#else
fputs( "\n", stdout );
fputs( " computing a standard basis...\n", stdout );
#endif
#endif
#endif
ideal stdJ = kStd2(J,currRing->qideal,isNotHomog,NULL,NULL);
idSkipZeroes( stdJ );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
for( i=0; i<IDELEMS(stdJ); i++ )
{
#ifdef SPECTRUM_IOSTREAM
cout << " ";
#else
fputs( " ",stdout );
#endif
pWrite( stdJ->m[i] );
}
#endif
#endif
idDelete( &J );
// ------------------------------------------
// check if the h has a singularity
// ------------------------------------------
if( hasOne( stdJ, currRing ) )
{
// -------------------------------
// h is smooth in the origin
// return only the Milnor number
// -------------------------------
*L = (lists)omAllocBin( slists_bin);
(*L)->Init( 1 );
(*L)->m[0].rtyp = INT_CMD; // milnor number
/* (*L)->m[0].data = (void*)0;a -- done by Init */
return spectrumNoSingularity;
}
// ------------------------------------------
// check if the singularity h is isolated
// ------------------------------------------
for( i=rVar(currRing); i>0; i-- )
{
if( hasAxis( stdJ,i, currRing )==FALSE )
{
return spectrumNotIsolated;
}
}
// ------------------------------------------
// compute the highest corner hc of stdJ
// ------------------------------------------
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "\n computing the highest corner...\n";
#else
fputs( "\n computing the highest corner...\n", stdout );
#endif
#endif
#endif
poly hc = (poly)NULL;
scComputeHC( stdJ,currRing->qideal, 0,hc );
if( hc!=(poly)NULL )
{
pGetCoeff(hc) = nInit(1);
for( i=rVar(currRing); i>0; i-- )
{
int e;
if( (e=pGetExp( hc,i ))>0 ) pSetExp( hc,i,e-1 );
}
pSetm( hc );
}
else
{
return spectrumNoHC;
}
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << " ";
#else
fputs( " ", stdout );
#endif
pWrite( hc );
#endif
#endif
// ----------------------------------------
// compute the Newton polygon nph of h
// ----------------------------------------
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "\n computing the newton polygon...\n";
#else
fputs( "\n computing the newton polygon...\n", stdout );
#endif
#endif
#endif
newtonPolygon nph( h, currRing );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
cout << nph;
#endif
#endif
// -----------------------------------------------
// compute the weight corner wc of (stdj,nph)
// -----------------------------------------------
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "\n computing the weight corner...\n";
#else
fputs( "\n computing the weight corner...\n", stdout );
#endif
#endif
#endif
poly wc = ( fast==0 ? pCopy( hc ) :
( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
/* fast==2 */computeWC( nph,
((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << " ";
#else
fputs( " ", stdout );
#endif
pWrite( wc );
#endif
#endif
// -------------
// compute NF
// -------------
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
#ifdef SPECTRUM_IOSTREAM
cout << "\n computing NF...\n" << endl;
#else
fputs( "\n computing NF...\n", stdout );
#endif
#endif
#endif
spectrumPolyList NF( &nph );
computeNF( stdJ,hc,wc,&NF, currRing );
#ifdef SPECTRUM_DEBUG
#ifdef SPECTRUM_PRINT
cout << NF;
#ifdef SPECTRUM_IOSTREAM
cout << endl;
#else
fputs( "\n", stdout );
#endif
#endif
#endif
// ----------------------------
// compute the spectrum of h
// ----------------------------
// spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
return spectrumStateFromList(NF, L, fast );
}
newtonPolygon
Definition npolygon.h:62
spectrumPolyList
Definition splist.h:57
spectrumStateFromList
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition ipshell.cc:3571
kStd2
ideal kStd2(ideal F, ideal Q, tHomog h, intvec **w, bigintmat *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
generic interface to GB/SB computations, large hilbert vectors
Definition kstd1.cc:2607
idSkipZeroes
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
Definition simpleideals.cc:201
hasAxis
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition spectrum.cc:81
hasOne
int hasOne(ideal J, const ring r)
Definition spectrum.cc:96
hasConstTerm
static BOOLEAN hasConstTerm(poly h, const ring r)
Definition spectrum.cc:63
computeWC
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition spectrum.cc:142
hasLinearTerm
static BOOLEAN hasLinearTerm(poly h, const ring r)
Definition spectrum.cc:72
computeNF
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition spectrum.cc:309
isNotHomog
@ isNotHomog
Definition structs.h:32

## spectrumfProc()

BOOLEAN spectrumfProc | ( | leftv | result,
|  | leftv | first )

Definition at line 4187 of file ipshell.cc.

{
spectrumState state = spectrumOK;
// -------------------
// check consistency
// -------------------
// check for a local polynomial ring
if( currRing->OrdSgn != -1 )
// ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
// or should we use:
//if( !ringIsLocal( ) )
{
WerrorS( "only works for local orderings" );
state = spectrumWrongRing;
}
else if( currRing->qideal != NULL )
{
WerrorS( "does not work in quotient rings" );
state = spectrumWrongRing;
}
else
{
lists L = (lists)NULL;
int flag = 2; // symmetric optimization
state = spectrumCompute( (poly)first->Data( ),&L,flag );
if( state==spectrumOK )
{
result->rtyp = LIST_CMD;
result->data = (char*)L;
}
else
{
spectrumPrintError(state);
}
}
return (state!=spectrumOK);
}
spectrumState
spectrumState
Definition ipshell.cc:3553
spectrumCompute
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition ipshell.cc:3812
spectrumPrintError
void spectrumPrintError(spectrumState state)
Definition ipshell.cc:4105

## spectrumFromList()

spectrum spectrumFromList | ( | lists | l | ) |

Definition at line 3386 of file ipshell.cc.

{
spectrum result;
copy_deep( result, l );
return result;
}
copy_deep
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3362

## spectrumPrintError()

void spectrumPrintError | ( | spectrumState | state | ) |

Definition at line 4105 of file ipshell.cc.

{
switch( state )
{
case spectrumZero:
WerrorS( "polynomial is zero" );
break;
case spectrumBadPoly:
WerrorS( "polynomial has constant term" );
break;
case spectrumNoSingularity:
WerrorS( "not a singularity" );
break;
case spectrumNotIsolated:
WerrorS( "the singularity is not isolated" );
break;
case spectrumNoHC:
WerrorS( "highest corner cannot be computed" );
break;
case spectrumDegenerate:
WerrorS( "principal part is degenerate" );
break;
case spectrumOK:
break;
default:
WerrorS( "unknown error occurred" );
break;
}
}

## spectrumProc()

BOOLEAN spectrumProc | ( | leftv | result,
|  | leftv | first )

Definition at line 4136 of file ipshell.cc.

{
spectrumState state = spectrumOK;
// -------------------
// check consistency
// -------------------
// check for a local ring
if( !ringIsLocal(currRing ) )
{
WerrorS( "only works for local orderings" );
state = spectrumWrongRing;
}
// no quotient rings are allowed
else if( currRing->qideal != NULL )
{
WerrorS( "does not work in quotient rings" );
state = spectrumWrongRing;
}
else
{
lists L = (lists)NULL;
int flag = 1; // weight corner optimization is safe
state = spectrumCompute( (poly)first->Data( ),&L,flag );
if( state==spectrumOK )
{
result->rtyp = LIST_CMD;
result->data = (char*)L;
}
else
{
spectrumPrintError(state);
}
}
return (state!=spectrumOK);
}
ringIsLocal
BOOLEAN ringIsLocal(const ring r)
Definition spectrum.cc:461

## spectrumStateFromList()

spectrumState spectrumStateFromList | ( | spectrumPolyList & | speclist,
|  | lists * | L,
|  | int | fast )

Definition at line 3571 of file ipshell.cc.

{
spectrumPolyNode **node = &speclist.root;
spectrumPolyNode *search;
poly f,tmp;
int found,cmp;
Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
( fast==2 ? 2 : 1 ) );
Rational weight_prev( 0,1 );
int mu = 0; // the milnor number
int pg = 0; // the geometrical genus
int n = 0; // number of different spectral numbers
int z = 0; // number of spectral number equal to smax
while( (*node)!=(spectrumPolyNode*)NULL &&
( fast==0 || (*node)->weight<=smax ) )
{
// ---------------------------------------
// determine the first normal form which
// contains the monomial node->mon
// ---------------------------------------
found = FALSE;
search = *node;
while( search!=(spectrumPolyNode*)NULL && found==FALSE )
{
if( search->nf!=(poly)NULL )
{
f = search->nf;
do
{
// --------------------------------
// look for (*node)->mon in f
// --------------------------------
cmp = pCmp( (*node)->mon,f );
if( cmp<0 )
{
f = pNext( f );
}
else if( cmp==0 )
{
// -----------------------------
// we have found a normal form
// -----------------------------
found = TRUE;
// normalize coefficient
number inv = nInvers( pGetCoeff( f ) );
search->nf=__p_Mult_nn( search->nf,inv,currRing );
nDelete( &inv );
// exchange normal forms
tmp = (*node)->nf;
(*node)->nf = search->nf;
search->nf = tmp;
}
}
while( cmp<0 && f!=(poly)NULL );
}
search = search->next;
}
if( found==FALSE )
{
// ------------------------------------------------
// the weight of node->mon is a spectrum number
// ------------------------------------------------
mu++;
if( (*node)->weight<=(Rational)1 ) pg++;
if( (*node)->weight==smax ) z++;
if( (*node)->weight>weight_prev ) n++;
weight_prev = (*node)->weight;
node = &((*node)->next);
}
else
{
// -----------------------------------------------
// determine all other normal form which contain
// the monomial node->mon
// replace for node->mon its normal form
// -----------------------------------------------
while( search!=(spectrumPolyNode*)NULL )
{
if( search->nf!=(poly)NULL )
{
f = search->nf;
do
{
// --------------------------------
// look for (*node)->mon in f
// --------------------------------
cmp = pCmp( (*node)->mon,f );
if( cmp<0 )
{
f = pNext( f );
}
else if( cmp==0 )
{
search->nf = pSub( search->nf,
__pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
pNorm( search->nf );
}
}
while( cmp<0 && f!=(poly)NULL );
}
search = search->next;
}
speclist.delete_node( node );
}
}
// --------------------------------------------------------
// fast computation exploits the symmetry of the spectrum
// --------------------------------------------------------
if( fast==2 )
{
mu = 2*mu - z;
n = ( z > 0 ? 2*n - 1 : 2*n );
}
// --------------------------------------------------------
// compute the spectrum numbers with their multiplicities
// --------------------------------------------------------
intvec *nom = new intvec( n );
intvec *den = new intvec( n );
intvec *mult = new intvec( n );
int count = 0;
int multiplicity = 1;
for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
( fast==0 || search->weight<=smax );
search=search->next )
{
if( search->next==(spectrumPolyNode*)NULL ||
search->weight<search->next->weight )
{
(*nom) [count] = search->weight.get_num_si( );
(*den) [count] = search->weight.get_den_si( );
(*mult)[count] = multiplicity;
multiplicity=1;
count++;
}
else
{
multiplicity++;
}
}
// --------------------------------------------------------
// fast computation exploits the symmetry of the spectrum
// --------------------------------------------------------
if( fast==2 )
{
int n1,n2;
for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
{
(*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
(*den) [n2] = (*den)[n1];
(*mult)[n2] = (*mult)[n1];
}
}
// -----------------------------------
// test if the spectrum is symmetric
// -----------------------------------
if( fast==0 || fast==1 )
{
int symmetric=TRUE;
for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
{
if( (*mult)[n1]!=(*mult)[n2] ||
(*den) [n1]!= (*den)[n2] ||
(*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
{
symmetric = FALSE;
}
}
if( symmetric==FALSE )
{
// ---------------------------------------------
// the spectrum is not symmetric => degenerate
// principal part
// ---------------------------------------------
*L = (lists)omAllocBin( slists_bin);
(*L)->Init( 1 );
(*L)->m[0].rtyp = INT_CMD; // milnor number
(*L)->m[0].data = (void*)(long)mu;
return spectrumDegenerate;
}
}
*L = (lists)omAllocBin( slists_bin);
(*L)->Init( 6 );
(*L)->m[0].rtyp = INT_CMD; // milnor number
(*L)->m[1].rtyp = INT_CMD; // geometrical genus
(*L)->m[2].rtyp = INT_CMD; // number of spectrum values
(*L)->m[3].rtyp = INTVEC_CMD; // nominators
(*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
(*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
(*L)->m[0].data = (void*)(long)mu;
(*L)->m[1].data = (void*)(long)pg;
(*L)->m[2].data = (void*)(long)n;
(*L)->m[3].data = (void*)nom;
(*L)->m[4].data = (void*)den;
(*L)->m[5].data = (void*)mult;
return spectrumOK;
}
f
FILE * f
Definition checklibs.c:9
spectrumPolyList::root
spectrumPolyNode * root
Definition splist.h:60
spectrumPolyList::delete_node
void delete_node(spectrumPolyNode **)
Definition splist.cc:256
spectrumPolyNode
Definition splist.h:36
found
bool found
Definition facFactorize.cc:55
search
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
Definition facSparseHensel.h:566
multiplicity
STATIC_VAR int * multiplicity
Definition interpolation.cc:86
pNext
#define pNext(p)
Definition monomials.h:36
nInvers
#define nInvers(a)
Definition numbers.h:33
__pp_Mult_nn
#define __pp_Mult_nn(p, n, r)
Definition p_polys.h:1004
__p_Mult_nn
#define __p_Mult_nn(p, n, r)
Definition p_polys.h:973
pNorm
void pNorm(poly p)
Definition polys.h:363
pSub
#define pSub(a, b)
Definition polys.h:288
pCmp
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition polys.h:116

## spmulProc()

BOOLEAN spmulProc | ( | leftv | result,
|  | leftv | first,
|  | leftv | second )

Definition at line 4473 of file ipshell.cc.

{
semicState state;
// -----------------
// check arguments
// -----------------
lists l = (lists)first->Data( );
int k = (int)(long)second->Data( );
if( (state=list_is_spectrum( l ))!=semicOK )
{
WerrorS( "first argument is not a spectrum" );
list_error( state );
}
else if( k < 0 )
{
WerrorS( "second argument should be positive" );
state = semicMulNegative;
}
else
{
spectrum s= spectrumFromList( l );
spectrum product( k*s );
result->rtyp = LIST_CMD;
result->data = (char*)getList(product);
}
return (state!=semicOK);
}

## syBetti1()

BOOLEAN syBetti1 | ( | leftv | res,
|  | leftv | u )

Definition at line 3166 of file ipshell.cc.

{
sleftv tmp;
tmp.Init();
tmp.rtyp=INT_CMD;
tmp.data=(void *)1;
return syBetti2(res,u,&tmp);
}
syBetti2
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition ipshell.cc:3142

## syBetti2()

BOOLEAN syBetti2 | ( | leftv | res,
|  | leftv | u,
|  | leftv | w )

Definition at line 3142 of file ipshell.cc.

{
syStrategy syzstr=(syStrategy)u->Data();
BOOLEAN minim=(int)(long)w->Data();
int row_shift=0;
int add_row_shift=0;
intvec *weights=NULL;
intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
if (ww!=NULL)
{
weights=ivCopy(ww);
add_row_shift = ww->min_in();
(*weights) -= add_row_shift;
}
res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
if (ww!=NULL) delete weights;
//row_shift += add_row_shift;
//Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
return FALSE;
}
syBettiOfComputation
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition syz1.cc:1756
syStrategy
ssyStrategy * syStrategy
Definition syz.h:36

## syConvList()

syStrategy syConvList | ( | lists | li | ) |

Definition at line 3250 of file ipshell.cc.

{
int typ0;
syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy));
resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
if (fr != NULL)
{
result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
for (int i=result->length-1;i>=0;i--)
{
if (fr[i]!=NULL)
result->fullres[i] = idCopy(fr[i]);
}
result->list_length=result->length;
omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
}
else
{
omFreeSize(result, sizeof(ssyStrategy));
result = NULL;
}
return result;
}
ssyStrategy
Definition syz.h:37

## syConvRes()

lists syConvRes | ( | syStrategy | syzstr,
|  | BOOLEAN | toDel,
|  | int | add_row_shift )

Definition at line 3178 of file ipshell.cc.

{
resolvente fullres = syzstr->fullres;
resolvente minres = syzstr->minres;
const int length = syzstr->length;
if ((fullres==NULL) && (minres==NULL))
{
if (syzstr->hilb_coeffs==NULL)
{ // La Scala
fullres = syReorder(syzstr->res, length, syzstr);
}
else
{ // HRES
minres = syReorder(syzstr->orderedRes, length, syzstr);
syKillEmptyEntres(minres, length);
}
}
resolvente tr;
int typ0=IDEAL_CMD;
if (minres!=NULL)
tr = minres;
else
tr = fullres;
resolvente trueres=NULL;
intvec ** w=NULL;
if (length>0)
{
trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
for (int i=length-1;i>=0;i--)
{
if (tr[i]!=NULL)
{
trueres[i] = idCopy(tr[i]);
}
}
if ( id_RankFreeModule(trueres[0], currRing) > 0)
typ0 = MODUL_CMD;
if (syzstr->weights!=NULL)
{
w = (intvec**)omAlloc0(length*sizeof(intvec*));
for (int i=length-1;i>=0;i--)
{
if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
}
}
}
lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
w, add_row_shift);
if (toDel)
syKillComputation(syzstr);
else
{
if( fullres != NULL && syzstr->fullres == NULL )
syzstr->fullres = fullres;
if( minres != NULL && syzstr->minres == NULL )
syzstr->minres = minres;
}
return li;
}
id_RankFreeModule
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
Definition simpleideals.cc:992
ssyStrategy::hilb_coeffs
intvec ** hilb_coeffs
Definition syz.h:46
ssyStrategy::minres
resolvente minres
Definition syz.h:58
syKillComputation
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition syz1.cc:1495
syReorder
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition syz1.cc:1641
syKillEmptyEntres
void syKillEmptyEntres(resolvente res, int length)
Definition syz1.cc:2199
ssyStrategy::list_length
short list_length
Definition syz.h:62
ssyStrategy::res
resolvente res
Definition syz.h:47
ssyStrategy::fullres
resolvente fullres
Definition syz.h:57
ssyStrategy::weights
intvec ** weights
Definition syz.h:45
ssyStrategy::orderedRes
resolvente orderedRes
Definition syz.h:48
ssyStrategy::length
int length
Definition syz.h:60

## test_cmd()

void test_cmd | ( | int | i | ) |

Definition at line 513 of file ipshell.cc.

{
int ii;
if (i<0)
{
ii= -i;
if (ii < 32)
{
si_opt_1 &= ~Sy_bit(ii);
}
else if (ii < 64)
{
si_opt_2 &= ~Sy_bit(ii-32);
}
else
WerrorS("out of bounds\n");
}
else if (i<32)
{
ii=i;
if (Sy_bit(ii) & kOptions)
{
WarnS("Gerhard, use the option command");
si_opt_1 |= Sy_bit(ii);
}
else if (Sy_bit(ii) & validOpts)
si_opt_1 |= Sy_bit(ii);
}
else if (i<64)
{
ii=i-32;
si_opt_2 |= Sy_bit(ii);
}
else
WerrorS("out of bounds\n");
}
validOpts
VAR BITSET validOpts
Definition kstd1.cc:60
kOptions
VAR BITSET kOptions
Definition kstd1.cc:45

## type_cmd()

void type_cmd | ( | leftv | v | ) |

Definition at line 255 of file ipshell.cc.

{
BOOLEAN oldShortOut = FALSE;
if (currRing != NULL)
{
oldShortOut = currRing->ShortOut;
currRing->ShortOut = 1;
}
int t=v->Typ();
Print("// %s %s ",v->Name(),Tok2Cmdname(t));
switch (t)
{
case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
((intvec*)(v->Data()))->cols()); break;
case MATRIX_CMD:Print(" %u x %u\n" ,
MATROWS((matrix)(v->Data())),
MATCOLS((matrix)(v->Data())));break;
case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
case PROC_CMD:
case RING_CMD:
case IDEAL_CMD: PrintLn(); break;
//case INT_CMD:
//case STRING_CMD:
//case INTVEC_CMD:
//case POLY_CMD:
//case VECTOR_CMD:
//case PACKAGE_CMD:
default:
break;
}
v->Print();
if (currRing != NULL)
currRing->ShortOut = oldShortOut;
}
map
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition cf_map_ext.cc:505

## Variable Documentation

## iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 81 of file ipshell.cc.

## iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 82 of file ipshell.cc.

## iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1071 of file ipshell.cc.

## iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 85 of file ipshell.cc.

## lastreserved

const char* lastreserved =NULL

Definition at line 83 of file ipshell.cc.

## MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5616 of file ipshell.cc.