My Project
Macros | Enumerations | Functions | Variables
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 <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, 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)
 
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)
 
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)
 
syStrategy syForceMin (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 More...
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
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) More...
 
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. More...
 
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. More...
 
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). More...
 
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 More...
 
void iiSetReturn (const leftv source)
 

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 1064 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 3433 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3549 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3359 of file ipshell.cc.

3360{
3361 spec.mu = (int)(long)(l->m[0].Data( ));
3362 spec.pg = (int)(long)(l->m[1].Data( ));
3363 spec.n = (int)(long)(l->m[2].Data( ));
3364
3365 spec.copy_new( spec.n );
3366
3367 intvec *num = (intvec*)l->m[3].Data( );
3368 intvec *den = (intvec*)l->m[4].Data( );
3369 intvec *mul = (intvec*)l->m[5].Data( );
3370
3371 for( int i=0; i<spec.n; i++ )
3372 {
3373 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3374 spec.w[i] = (*mul)[i];
3375 }
3376}
CanonicalForm num(const CanonicalForm &f)
CanonicalForm den(const CanonicalForm &f)
int l
Definition: cfEzgcd.cc:100
int i
Definition: cfEzgcd.cc:132
Definition: intvec.h:23
int mu
Definition: semic.h:67
void copy_new(int)
Definition: semic.cc:54
Rational * s
Definition: semic.h:70
int n
Definition: semic.h:69
int pg
Definition: semic.h:68
int * w
Definition: semic.h:71

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

553{
554 int rc = 0;
555 while (v!=NULL)
556 {
557 switch (v->Typ())
558 {
559 case INT_CMD:
560 case POLY_CMD:
561 case VECTOR_CMD:
562 case NUMBER_CMD:
563 rc++;
564 break;
565 case INTVEC_CMD:
566 case INTMAT_CMD:
567 rc += ((intvec *)(v->Data()))->length();
568 break;
569 case MATRIX_CMD:
570 case IDEAL_CMD:
571 case MODUL_CMD:
572 {
573 matrix mm = (matrix)(v->Data());
574 rc += mm->rows() * mm->cols();
575 }
576 break;
577 case LIST_CMD:
578 rc+=((lists)v->Data())->nr+1;
579 break;
580 default:
581 rc++;
582 }
583 v = v->next;
584 }
585 return rc;
586}
Variable next() const
Definition: factory.h:146
int & cols()
Definition: matpol.h:24
int & rows()
Definition: matpol.h:23
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:39
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ VECTOR_CMD
Definition: grammar.cc:292
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
ip_smatrix * matrix
Definition: matpol.h:43
slists * lists
Definition: mpr_numeric.h:146
#define NULL
Definition: omList.c:12
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ INT_CMD
Definition: tok.h:96

◆ getList()

lists getList ( spectrum spec)

Definition at line 3395 of file ipshell.cc.

3396{
3398
3399 L->Init( 6 );
3400
3401 intvec *num = new intvec( spec.n );
3402 intvec *den = new intvec( spec.n );
3403 intvec *mult = new intvec( spec.n );
3404
3405 for( int i=0; i<spec.n; i++ )
3406 {
3407 (*num) [i] = spec.s[i].get_num_si( );
3408 (*den) [i] = spec.s[i].get_den_si( );
3409 (*mult)[i] = spec.w[i];
3410 }
3411
3412 L->m[0].rtyp = INT_CMD; // milnor number
3413 L->m[1].rtyp = INT_CMD; // geometrical genus
3414 L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3415 L->m[3].rtyp = INTVEC_CMD; // numerators
3416 L->m[4].rtyp = INTVEC_CMD; // denomiantors
3417 L->m[5].rtyp = INTVEC_CMD; // multiplicities
3418
3419 L->m[0].data = (void*)(long)spec.mu;
3420 L->m[1].data = (void*)(long)spec.pg;
3421 L->m[2].data = (void*)(long)spec.n;
3422 L->m[3].data = (void*)num;
3423 L->m[4].data = (void*)den;
3424 L->m[5].data = (void*)mult;
3425
3426 return L;
3427}
int get_num_si()
Definition: GMPrat.cc:138
int get_den_si()
Definition: GMPrat.cc:152
int rtyp
Definition: subexpr.h:91
void * data
Definition: subexpr.h:88
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
INLINE_THIS void Init(int l=0)
VAR omBin slists_bin
Definition: lists.cc:23
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define omAllocBin(bin)
Definition: omAllocDecl.h:205

◆ iiApply()

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

Definition at line 6421 of file ipshell.cc.

6422{
6423 res->Init();
6424 res->rtyp=a->Typ();
6425 switch (res->rtyp /*a->Typ()*/)
6426 {
6427 case INTVEC_CMD:
6428 case INTMAT_CMD:
6429 return iiApplyINTVEC(res,a,op,proc);
6430 case BIGINTMAT_CMD:
6431 return iiApplyBIGINTMAT(res,a,op,proc);
6432 case IDEAL_CMD:
6433 case MODUL_CMD:
6434 case MATRIX_CMD:
6435 return iiApplyIDEAL(res,a,op,proc);
6436 case LIST_CMD:
6437 return iiApplyLIST(res,a,op,proc);
6438 }
6439 WerrorS("first argument to `apply` must allow an index");
6440 return TRUE;
6441}
#define TRUE
Definition: auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
int Typ()
Definition: subexpr.cc:1011
CanonicalForm res
Definition: facAbsFact.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
@ BIGINTMAT_CMD
Definition: grammar.cc:278
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6340
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6382
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6377
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6372

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6372 of file ipshell.cc.

6373{
6374 WerrorS("not implemented");
6375 return TRUE;
6376}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6377 of file ipshell.cc.

6378{
6379 WerrorS("not implemented");
6380 return TRUE;
6381}

◆ iiApplyINTVEC()

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

Definition at line 6340 of file ipshell.cc.

6341{
6342 intvec *aa=(intvec*)a->Data();
6343 sleftv tmp_out;
6344 sleftv tmp_in;
6345 leftv curr=res;
6346 BOOLEAN bo=FALSE;
6347 for(int i=0;i<aa->length(); i++)
6348 {
6349 tmp_in.Init();
6350 tmp_in.rtyp=INT_CMD;
6351 tmp_in.data=(void*)(long)(*aa)[i];
6352 if (proc==NULL)
6353 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6354 else
6355 bo=jjPROC(&tmp_out,proc,&tmp_in);
6356 if (bo)
6357 {
6358 res->CleanUp(currRing);
6359 Werror("apply fails at index %d",i+1);
6360 return TRUE;
6361 }
6362 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6363 else
6364 {
6366 curr=curr->next;
6367 memcpy(curr,&tmp_out,sizeof(tmp_out));
6368 }
6369 }
6370 return FALSE;
6371}
int BOOLEAN
Definition: auxiliary.h:87
#define FALSE
Definition: auxiliary.h:96
int length() const
Definition: intvec.h:94
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void * Data()
Definition: subexpr.cc:1154
void Init()
Definition: subexpr.h:107
leftv next
Definition: subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9093
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1621
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void Werror(const char *fmt,...)
Definition: reporter.cc:189
sleftv * leftv
Definition: structs.h:57

◆ iiApplyLIST()

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

Definition at line 6382 of file ipshell.cc.

6383{
6384 lists aa=(lists)a->Data();
6385 if (aa->nr==-1) /* empty list*/
6386 {
6388 l->Init();
6389 res->data=(void *)l;
6390 return FALSE;
6391 }
6392 sleftv tmp_out;
6393 sleftv tmp_in;
6394 leftv curr=res;
6395 BOOLEAN bo=FALSE;
6396 for(int i=0;i<=aa->nr; i++)
6397 {
6398 tmp_in.Init();
6399 tmp_in.Copy(&(aa->m[i]));
6400 if (proc==NULL)
6401 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6402 else
6403 bo=jjPROC(&tmp_out,proc,&tmp_in);
6404 tmp_in.CleanUp();
6405 if (bo)
6406 {
6407 res->CleanUp(currRing);
6408 Werror("apply fails at index %d",i+1);
6409 return TRUE;
6410 }
6411 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6412 else
6413 {
6415 curr=curr->next;
6416 memcpy(curr,&tmp_out,sizeof(tmp_out));
6417 }
6418 }
6419 return FALSE;
6420}
void Copy(leftv e)
Definition: subexpr.cc:685
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
int nr
Definition: lists.h:44

◆ iiARROW()

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

Definition at line 6470 of file ipshell.cc.

6471{
6472 char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6473 // find end of s:
6474 int end_s=strlen(s);
6475 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6476 s[end_s+1]='\0';
6477 char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6478 sprintf(name,"%s->%s",a,s);
6479 // find start of last expression
6480 int start_s=end_s-1;
6481 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6482 if (start_s<0) // ';' not found
6483 {
6484 sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6485 }
6486 else // s[start_s] is ';'
6487 {
6488 s[start_s]='\0';
6489 sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6490 }
6491 r->Init();
6492 // now produce procinfo for PROC_CMD:
6493 r->data = (void *)omAlloc0Bin(procinfo_bin);
6494 ((procinfo *)(r->data))->language=LANG_NONE;
6496 ((procinfo *)r->data)->data.s.body=ss;
6497 omFree(name);
6498 r->rtyp=PROC_CMD;
6499 //r->rtyp=STRING_CMD;
6500 //r->data=ss;
6501 return FALSE;
6502}
const CanonicalForm int s
Definition: facAbsFact.cc:51
char name(const Variable &v)
Definition: factory.h:189
@ PROC_CMD
Definition: grammar.cc:280
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1049
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define omFree(addr)
Definition: omAllocDecl.h:261
VAR omBin procinfo_bin
Definition: subexpr.cc:42
@ LANG_NONE
Definition: subexpr.h:22

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6504 of file ipshell.cc.

6505{
6506 char* ring_name=omStrDup((char*)r->Name());
6507 int t=arg->Typ();
6508 if (t==RING_CMD)
6509 {
6510 sleftv tmp;
6511 tmp.Init();
6512 tmp.rtyp=IDHDL;
6513 idhdl h=rDefault(ring_name);
6514 tmp.data=(char*)h;
6515 if (h!=NULL)
6516 {
6517 tmp.name=h->id;
6518 BOOLEAN b=iiAssign(&tmp,arg);
6519 if (b) return TRUE;
6520 rSetHdl(ggetid(ring_name));
6521 omFree(ring_name);
6522 return FALSE;
6523 }
6524 else
6525 return TRUE;
6526 }
6527 else if (t==CRING_CMD)
6528 {
6529 sleftv tmp;
6530 sleftv n;
6531 n.Init();
6532 n.name=ring_name;
6533 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6534 if (iiAssign(&tmp,arg)) return TRUE;
6535 //Print("create %s\n",r->Name());
6536 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6537 return FALSE;
6538 }
6539 //Print("create %s\n",r->Name());
6540 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541 return TRUE;// not handled -> error for now
6542}
CanonicalForm b
Definition: cfModGcd.cc:4103
Definition: idrec.h:35
const char * name
Definition: subexpr.h:87
const char * Name()
Definition: subexpr.h:120
VAR int myynest
Definition: febase.cc:41
@ RING_CMD
Definition: grammar.cc:281
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
idhdl ggetid(const char *n)
Definition: ipid.cc:581
#define IDROOT
Definition: ipid.h:19
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1198
idhdl rDefault(const char *s)
Definition: ipshell.cc:1644
void rSetHdl(idhdl h)
Definition: ipshell.cc:5125
STATIC_VAR Poly * h
Definition: janet.cc:971
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define IDHDL
Definition: tok.h:31
@ CRING_CMD
Definition: tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1273 of file ipshell.cc.

1274{
1275 // must be inside a proc, as we simultae an proc_end at the end
1276 if (myynest==0)
1277 {
1278 WerrorS("branchTo can only occur in a proc");
1279 return TRUE;
1280 }
1281 // <string1...stringN>,<proc>
1282 // known: args!=NULL, l>=1
1283 int l=args->listLength();
1284 int ll=0;
1286 if (ll!=(l-1)) return FALSE;
1287 leftv h=args;
1288 // set up the table for type test:
1289 short *t=(short*)omAlloc(l*sizeof(short));
1290 t[0]=l-1;
1291 int b;
1292 int i;
1293 for(i=1;i<l;i++,h=h->next)
1294 {
1295 if (h->Typ()!=STRING_CMD)
1296 {
1297 omFreeBinAddr(t);
1298 Werror("arg %d is not a string",i);
1299 return TRUE;
1300 }
1301 int tt;
1302 b=IsCmd((char *)h->Data(),tt);
1303 if(b) t[i]=tt;
1304 else
1305 {
1306 omFreeBinAddr(t);
1307 Werror("arg %d is not a type name",i);
1308 return TRUE;
1309 }
1310 }
1311 if (h->Typ()!=PROC_CMD)
1312 {
1313 omFreeBinAddr(t);
1314 Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1315 i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1316 return TRUE;
1317 }
1319 omFreeBinAddr(t);
1320 if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1321 {
1322 // get the proc:
1323 iiCurrProc=(idhdl)h->data;
1324 idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1325 procinfo * pi=IDPROC(currProc);
1326 // already loaded ?
1327 if( pi->data.s.body==NULL )
1328 {
1330 if (pi->data.s.body==NULL) return TRUE;
1331 }
1332 // set currPackHdl/currPack
1333 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1334 {
1335 currPack=pi->pack;
1338 //Print("set pack=%s\n",IDID(currPackHdl));
1339 }
1340 // see iiAllStart:
1341 BITSET save1=si_opt_1;
1342 BITSET save2=si_opt_2;
1343 newBuffer( omStrDup(pi->data.s.body), BT_proc,
1344 pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1345 BOOLEAN err=yyparse();
1347 si_opt_1=save1;
1348 si_opt_2=save2;
1349 // now save the return-expr.
1351 memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1353 // warning about args.:
1354 if (iiCurrArgs!=NULL)
1355 {
1356 if (err==0) Warn("too many arguments for %s",IDID(currProc));
1360 }
1361 // similate proc_end:
1362 // - leave input
1363 void myychangebuffer();
1365 // - set the current buffer to its end (this is a pointer in a buffer,
1366 // not a file ptr) "branchTo" is only valid in proc)
1368 // - kill local vars
1370 // - return
1371 newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1372 return (err!=0);
1373 }
1374 return FALSE;
1375}
void * ADDRESS
Definition: auxiliary.h:119
char * buffer
Definition: fevoices.h:69
long fptr
Definition: fevoices.h:70
int listLength()
Definition: subexpr.cc:51
#define Warn
Definition: emacs.cc:77
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:166
VAR Voice * currentVoice
Definition: fevoices.cc:49
@ BT_execute
Definition: fevoices.h:23
@ BT_proc
Definition: fevoices.h:20
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
int yyparse(void)
Definition: grammar.cc:2111
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:9503
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:831
#define IDPROC(a)
Definition: ipid.h:140
#define IDID(a)
Definition: ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:474
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
VAR idhdl iiCurrProc
Definition: ipshell.cc:81
void iiCheckPack(package &p)
Definition: ipshell.cc:1630
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:6562
void killlocals(int v)
Definition: ipshell.cc:386
VAR leftv iiCurrArgs
Definition: ipshell.cc:80
#define pi
Definition: libparse.cc:1145
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
#define omFreeBinAddr(addr)
Definition: omAllocDecl.h:258
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
idrec * idhdl
Definition: ring.h:21
void myychangebuffer()
Definition: scanner.cc:2311
#define BITSET
Definition: structs.h:16
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46
@ STRING_CMD
Definition: tok.h:185

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1630 of file ipshell.cc.

1631{
1632 if (p!=basePack)
1633 {
1634 idhdl t=basePack->idroot;
1635 while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1636 if (t==NULL)
1637 {
1638 WarnS("package not found\n");
1639 p=basePack;
1640 }
1641 }
1642}
int p
Definition: cfModGcd.cc:4078
idhdl next
Definition: idrec.h:38
#define WarnS
Definition: emacs.cc:78
VAR package basePack
Definition: ipid.cc:58
#define IDPACKAGE(a)
Definition: ipid.h:139
#define IDTYP(a)
Definition: ipid.h:119
@ PACKAGE_CMD
Definition: tok.h:149

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1586 of file ipshell.cc.

1587{
1588 if (currRing==NULL)
1589 {
1590 #ifdef SIQ
1591 if (siq<=0)
1592 {
1593 #endif
1594 if (RingDependend(i))
1595 {
1596 WerrorS("no ring active (9)");
1597 return TRUE;
1598 }
1599 #ifdef SIQ
1600 }
1601 #endif
1602 }
1603 return FALSE;
1604}
VAR BOOLEAN siq
Definition: subexpr.cc:48
BOOLEAN RingDependend(int t)
Definition: subexpr.h:142

◆ 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 6562 of file ipshell.cc.

6563{
6564 int l=0;
6565 if (args==NULL)
6566 {
6567 if (type_list[0]==0) return TRUE;
6568 }
6569 else l=args->listLength();
6570 if (l!=(int)type_list[0])
6571 {
6572 if (report) iiReportTypes(0,l,type_list);
6573 return FALSE;
6574 }
6575 for(int i=1;i<=l;i++,args=args->next)
6576 {
6577 short t=type_list[i];
6578 if (t!=ANY_TYPE)
6579 {
6580 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6581 || (t!=args->Typ()))
6582 {
6583 if (report) iiReportTypes(i,args->Typ(),type_list);
6584 return FALSE;
6585 }
6586 }
6587 }
6588 return TRUE;
6589}
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6544
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 936 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

1066{
1067#ifdef HAVE_SDB
1068 sdb_flags=1;
1069#endif
1070 Print("\n-- break point in %s --\n",VoiceName());
1072 char * s;
1074 s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1075 loop
1076 {
1077 memset(s,0,BREAK_LINE_LENGTH+4);
1079 if (s[BREAK_LINE_LENGTH-1]!='\0')
1080 {
1081 Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1082 }
1083 else
1084 break;
1085 }
1086 if (*s=='\n')
1087 {
1089 }
1090#if MDEBUG
1091 else if(strncmp(s,"cont;",5)==0)
1092 {
1094 }
1095#endif /* MDEBUG */
1096 else
1097 {
1098 strcat( s, "\n;~\n");
1100 }
1101}
#define Print
Definition: emacs.cc:80
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:32
const char * VoiceName()
Definition: fevoices.cc:58
void VoiceBackTrack()
Definition: fevoices.cc:77
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:1063
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:1064
VAR int sdb_flags
Definition: sdb.cc:31
#define loop
Definition: structs.h:75

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

1199{
1201 BOOLEAN is_qring=FALSE;
1202 const char *id = name->name;
1203
1204 sy->Init();
1205 if ((name->name==NULL)||(isdigit(name->name[0])))
1206 {
1207 WerrorS("object to declare is not a name");
1208 res=TRUE;
1209 }
1210 else
1211 {
1212 if (root==NULL) return TRUE;
1213 if (*root!=IDROOT)
1214 {
1215 if ((currRing==NULL) || (*root!=currRing->idroot))
1216 {
1217 Werror("can not define `%s` in other package",name->name);
1218 return TRUE;
1219 }
1220 }
1221 if (t==QRING_CMD)
1222 {
1223 t=RING_CMD; // qring is always RING_CMD
1224 is_qring=TRUE;
1225 }
1226
1227 if (TEST_V_ALLWARN
1228 && (name->rtyp!=0)
1229 && (name->rtyp!=IDHDL)
1231 {
1232 Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1234 }
1235 {
1236 sy->data = (char *)enterid(id,lev,t,root,init_b);
1237 }
1238 if (sy->data!=NULL)
1239 {
1240 sy->rtyp=IDHDL;
1241 currid=sy->name=IDID((idhdl)sy->data);
1242 if (is_qring)
1243 {
1245 }
1246 // name->name=NULL; /* used in enterid */
1247 //sy->e = NULL;
1248 if (name->next!=NULL)
1249 {
1251 res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1252 }
1253 }
1254 else res=TRUE;
1255 }
1256 name->CleanUp();
1257 return res;
1258}
char * filename
Definition: fevoices.h:63
BITSET flag
Definition: subexpr.h:90
VAR int yylineno
Definition: febase.cc:40
VAR char my_yylinebuf[80]
Definition: febase.cc:44
const char * currid
Definition: grammar.cc:171
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
VAR idhdl currRingHdl
Definition: ipid.cc:59
#define IDFLAG(a)
Definition: ipid.h:120
#define FLAG_QRING_DEF
Definition: ipid.h:109
#define IDLEV(a)
Definition: ipid.h:121
#define TEST_V_ALLWARN
Definition: options.h:144
#define Sy_bit(x)
Definition: options.h:31
@ QRING_CMD
Definition: tok.h:158

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1260 of file ipshell.cc.

1261{
1262 attr at=NULL;
1263 if (iiCurrProc!=NULL)
1264 at=iiCurrProc->attribute->get("default_arg");
1265 if (at==NULL)
1266 return FALSE;
1267 sleftv tmp;
1268 tmp.Init();
1269 tmp.rtyp=at->atyp;
1270 tmp.data=at->CopyA();
1271 return iiAssign(p,&tmp);
1272}
attr attribute
Definition: idrec.h:41
Definition: attrib.h:21
attr get(const char *s)
Definition: attrib.cc:93
void * CopyA()
Definition: subexpr.cc:2100
int atyp
Definition: attrib.h:27

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1511 of file ipshell.cc.

1512{
1513 BOOLEAN nok=FALSE;
1514 leftv r=v;
1515 while (v!=NULL)
1516 {
1517 if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1518 {
1519 Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1520 nok=TRUE;
1521 }
1522 else
1523 {
1524 if(iiInternalExport(v, toLev))
1525 nok=TRUE;
1526 }
1527 v=v->next;
1528 }
1529 r->CleanUp();
1530 return nok;
1531}
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1412

◆ iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

1535{
1536// if ((pack==basePack)&&(pack!=currPack))
1537// { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1538 BOOLEAN nok=FALSE;
1539 leftv rv=v;
1540 while (v!=NULL)
1541 {
1542 if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1543 )
1544 {
1545 Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1546 nok=TRUE;
1547 }
1548 else
1549 {
1550 idhdl old=pack->idroot->get( v->name,toLev);
1551 if (old!=NULL)
1552 {
1553 if ((pack==currPack) && (old==(idhdl)v->data))
1554 {
1555 if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1556 break;
1557 }
1558 else if (IDTYP(old)==v->Typ())
1559 {
1560 if (BVERBOSE(V_REDEFINE))
1561 {
1562 Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1563 }
1564 v->name=omStrDup(v->name);
1565 killhdl2(old,&(pack->idroot),currRing);
1566 }
1567 else
1568 {
1569 rv->CleanUp();
1570 return TRUE;
1571 }
1572 }
1573 //Print("iiExport: pack=%s\n",IDID(root));
1574 if(iiInternalExport(v, toLev, pack))
1575 {
1576 rv->CleanUp();
1577 return TRUE;
1578 }
1579 }
1580 v=v->next;
1581 }
1582 rv->CleanUp();
1583 return nok;
1584}
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:445
#define BVERBOSE(a)
Definition: options.h:35
#define V_REDEFINE
Definition: options.h:45

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1606 of file ipshell.cc.

1607{
1608 int i;
1609 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1610 poly po=NULL;
1612 {
1613 scComputeHC(I,currRing->qideal,ak,po);
1614 if (po!=NULL)
1615 {
1616 pGetCoeff(po)=nInit(1);
1617 for (i=rVar(currRing); i>0; i--)
1618 {
1619 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1620 }
1621 pSetComp(po,ak);
1622 pSetm(po);
1623 }
1624 }
1625 else
1626 po=pOne();
1627 return po;
1628}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition: hdegree.cc:1101
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:176
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
#define nInit(i)
Definition: numbers.h:24
#define pSetm(p)
Definition: polys.h:271
#define pSetComp(p, v)
Definition: polys.h:38
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pOne()
Definition: polys.h:315
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:593
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:761

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1412 of file ipshell.cc.

1413{
1414 idhdl h=(idhdl)v->data;
1415 //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1416 if (IDLEV(h)==0)
1417 {
1418 if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1419 }
1420 else
1421 {
1422 h=IDROOT->get(v->name,toLev);
1423 idhdl *root=&IDROOT;
1424 if ((h==NULL)&&(currRing!=NULL))
1425 {
1426 h=currRing->idroot->get(v->name,toLev);
1427 root=&currRing->idroot;
1428 }
1429 BOOLEAN keepring=FALSE;
1430 if ((h!=NULL)&&(IDLEV(h)==toLev))
1431 {
1432 if (IDTYP(h)==v->Typ())
1433 {
1434 if ((IDTYP(h)==RING_CMD)
1435 && (v->Data()==IDDATA(h)))
1436 {
1438 keepring=TRUE;
1439 IDLEV(h)=toLev;
1440 //WarnS("keepring");
1441 return FALSE;
1442 }
1443 if (BVERBOSE(V_REDEFINE))
1444 {
1445 Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1446 }
1447 if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1448 killhdl2(h,root,currRing);
1449 }
1450 else
1451 {
1452 WerrorS("object with a different type exists");
1453 return TRUE;
1454 }
1455 }
1456 h=(idhdl)v->data;
1457 IDLEV(h)=toLev;
1458 if (keepring) rDecRefCnt(IDRING(h));
1460 //Print("export %s\n",IDID(h));
1461 }
1462 return FALSE;
1463}
if(!FE_OPT_NO_SHELL_FLAG)(void) system(sys)
#define IDDATA(a)
Definition: ipid.h:126
#define IDRING(a)
Definition: ipid.h:127
VAR ring * iiLocalRing
Definition: iplib.cc:473
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
static ring rIncRefCnt(ring r)
Definition: ring.h:843
static void rDecRefCnt(ring r)
Definition: ring.h:844

◆ iiInternalExport() [2/2]

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

Definition at line 1465 of file ipshell.cc.

1466{
1467 idhdl h=(idhdl)v->data;
1468 if(h==NULL)
1469 {
1470 Warn("'%s': no such identifier\n", v->name);
1471 return FALSE;
1472 }
1473 package frompack=v->req_packhdl;
1474 if (frompack==NULL) frompack=currPack;
1475 if ((RingDependend(IDTYP(h)))
1476 || ((IDTYP(h)==LIST_CMD)
1477 && (lRingDependend(IDLIST(h)))
1478 )
1479 )
1480 {
1481 //Print("// ==> Ringdependent set nesting to 0\n");
1482 return (iiInternalExport(v, toLev));
1483 }
1484 else
1485 {
1486 IDLEV(h)=toLev;
1487 v->req_packhdl=rootpack;
1488 if (h==frompack->idroot)
1489 {
1490 frompack->idroot=h->next;
1491 }
1492 else
1493 {
1494 idhdl hh=frompack->idroot;
1495 while ((hh!=NULL) && (hh->next!=h))
1496 hh=hh->next;
1497 if ((hh!=NULL) && (hh->next==h))
1498 hh->next=h->next;
1499 else
1500 {
1501 Werror("`%s` not found",v->Name());
1502 return TRUE;
1503 }
1504 }
1505 h->next=rootpack->idroot;
1506 rootpack->idroot=h;
1507 }
1508 return FALSE;
1509}
#define IDLIST(a)
Definition: ipid.h:137
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

849{
850 lists L=liMakeResolv(r,length,rlen,typ0,weights);
851 int i=0;
852 idhdl h;
853 char * s=(char *)omAlloc(strlen(name)+5);
854
855 while (i<=L->nr)
856 {
857 sprintf(s,"%s(%d)",name,i+1);
858 if (i==0)
859 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860 else
862 if (h!=NULL)
863 {
864 h->data.uideal=(ideal)L->m[i].data;
865 h->attribute=L->m[i].attribute;
867 Print("//defining: %s as %d-th syzygy module\n",s,i+1);
868 }
869 else
870 {
871 idDelete((ideal *)&(L->m[i].data));
872 Warn("cannot define %s",s);
873 }
874 //L->m[i].data=NULL;
875 //L->m[i].rtyp=0;
876 //L->m[i].attribute=NULL;
877 i++;
878 }
879 omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
881 omFreeSize((ADDRESS)s,strlen(name)+5);
882}
attr attribute
Definition: subexpr.h:89
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:50

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

616{
617 idhdl w,r;
618 leftv v;
619 int i;
620 nMapFunc nMap;
621
622 r=IDROOT->get(theMap->preimage,myynest);
623 if ((currPack!=basePack)
624 &&((r==NULL) || ((r->typ != RING_CMD) )))
625 r=basePack->idroot->get(theMap->preimage,myynest);
626 if ((r==NULL) && (currRingHdl!=NULL)
627 && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
628 {
629 r=currRingHdl;
630 }
631 if ((r!=NULL) && (r->typ == RING_CMD))
632 {
633 ring src_ring=IDRING(r);
634 if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
635 {
636 Werror("can not map from ground field of %s to current ground field",
637 theMap->preimage);
638 return NULL;
639 }
640 if (IDELEMS(theMap)<src_ring->N)
641 {
642 theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
643 IDELEMS(theMap)*sizeof(poly),
644 (src_ring->N)*sizeof(poly));
645#ifdef HAVE_SHIFTBBA
646 if (rIsLPRing(src_ring))
647 {
648 // src_ring [x,y,z,...]
649 // curr_ring [a,b,c,...]
650 //
651 // map=[a,b,c,d] -> [a,b,c,...]
652 // map=[a,b] -> [a,b,0,...]
653
654 short src_lV = src_ring->isLPring;
655 short src_ncGenCount = src_ring->LPncGenCount;
656 short src_nVars = src_lV - src_ncGenCount;
657 int src_nblocks = src_ring->N / src_lV;
658
659 short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
660 short dest_ncGenCount = currRing->LPncGenCount;
661
662 // add missing NULL generators
663 for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
664 {
665 theMap->m[i]=NULL;
666 }
667
668 // remove superfluous generators
669 for(i = src_nVars; i < IDELEMS(theMap); i++)
670 {
671 if (theMap->m[i] != NULL)
672 {
673 p_Delete(&(theMap->m[i]), currRing);
674 theMap->m[i] = NULL;
675 }
676 }
677
678 // add ncgen mappings
679 for(i = src_nVars; i < src_lV; i++)
680 {
681 short ncGenIndex = i - src_nVars;
682 if (ncGenIndex < dest_ncGenCount)
683 {
684 poly p = p_One(currRing);
685 p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
686 p_Setm(p, currRing);
687 theMap->m[i] = p;
688 }
689 else
690 {
691 theMap->m[i] = NULL;
692 }
693 }
694
695 // copy the first block to all other blocks
696 for(i = 1; i < src_nblocks; i++)
697 {
698 for(int j = 0; j < src_lV; j++)
699 {
700 theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
701 }
702 }
703 }
704 else
705 {
706#endif
707 for(i=IDELEMS(theMap);i<src_ring->N;i++)
708 theMap->m[i]=NULL;
709#ifdef HAVE_SHIFTBBA
710 }
711#endif
712 IDELEMS(theMap)=src_ring->N;
713 }
714 if (what==NULL)
715 {
716 WerrorS("argument of a map must have a name");
717 }
718 else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
719 {
720 char *save_r=NULL;
722 sleftv tmpW;
723 tmpW.Init();
724 tmpW.rtyp=IDTYP(w);
725 if (tmpW.rtyp==MAP_CMD)
726 {
727 tmpW.rtyp=IDEAL_CMD;
728 save_r=IDMAP(w)->preimage;
729 IDMAP(w)->preimage=0;
730 }
731 tmpW.data=IDDATA(w);
732 // check overflow
733 BOOLEAN overflow=FALSE;
734 if ((tmpW.rtyp==IDEAL_CMD)
735 || (tmpW.rtyp==MODUL_CMD)
736 || (tmpW.rtyp==MAP_CMD))
737 {
738 ideal id=(ideal)tmpW.data;
739 long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
740 for(int i=IDELEMS(id)-1;i>=0;i--)
741 {
742 poly p=id->m[i];
743 if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
744 else degs[i]=0;
745 }
746 for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
747 {
748 if (theMap->m[j]!=NULL)
749 {
750 long deg_monexp=pTotaldegree(theMap->m[j]);
751
752 for(int i=IDELEMS(id)-1;i>=0;i--)
753 {
754 poly p=id->m[i];
755 if ((p!=NULL) && (degs[i]!=0) &&
756 ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
757 {
758 overflow=TRUE;
759 break;
760 }
761 }
762 }
763 }
764 omFreeSize(degs,IDELEMS(id)*sizeof(long));
765 }
766 else if (tmpW.rtyp==POLY_CMD)
767 {
768 for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
769 {
770 if (theMap->m[j]!=NULL)
771 {
772 long deg_monexp=pTotaldegree(theMap->m[j]);
773 poly p=(poly)tmpW.data;
774 long deg=0;
775 if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
776 ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
777 {
778 overflow=TRUE;
779 break;
780 }
781 }
782 }
783 }
784 if (overflow)
785#ifdef HAVE_SHIFTBBA
786 // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
787 if (!rIsLPRing(currRing))
788 {
789#endif
790 Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
791#ifdef HAVE_SHIFTBBA
792 }
793#endif
794#if 0
795 if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
796 {
797 v->rtyp=tmpW.rtyp;
798 v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
799 }
800 else
801#endif
802 {
803 if ((tmpW.rtyp==IDEAL_CMD)
804 ||(tmpW.rtyp==MODUL_CMD)
805 ||(tmpW.rtyp==MATRIX_CMD)
806 ||(tmpW.rtyp==MAP_CMD))
807 {
808 v->rtyp=tmpW.rtyp;
809 char *tmp = theMap->preimage;
810 theMap->preimage=(char*)1L;
811 // map gets 1 as its rank (as an ideal)
812 v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
813 theMap->preimage=tmp; // map gets its preimage back
814 }
815 if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
816 {
817 if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
818 {
819 Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
821 if (save_r!=NULL) IDMAP(w)->preimage=save_r;
822 return NULL;
823 }
824 }
825 }
826 if (save_r!=NULL)
827 {
828 IDMAP(w)->preimage=save_r;
829 IDMAP((idhdl)v)->preimage=omStrDup(save_r);
830 v->rtyp=MAP_CMD;
831 }
832 return v;
833 }
834 else
835 {
836 Werror("%s undefined in %s",what,theMap->preimage);
837 }
838 }
839 else
840 {
841 Werror("cannot find preimage %s",theMap->preimage);
842 }
843 return NULL;
844}
int typ
Definition: idrec.h:43
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:700
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
const CanonicalForm & w
Definition: facAbsFact.cc:51
int j
Definition: facHensel.cc:110
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:87
@ MAP_CMD
Definition: grammar.cc:285
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
#define IDMAP(a)
Definition: ipid.h:135
#define IDIDEAL(a)
Definition: ipid.h:133
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
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
poly p_One(const ring r)
Definition: p_polys.cc:1313
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
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:235
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:903
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:848
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1509
static long pTotaldegree(poly p)
Definition: polys.h:282
poly * polyset
Definition: polys.h:259
static BOOLEAN rIsLPRing(const ring r)
Definition: ring.h:411
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define IDELEMS(i)
Definition: simpleideals.h:23

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

122{
123/* not handling: &&, ||, ** */
124 if (s[1]=='\0') return s[0];
125 else if (s[2]!='\0') return 0;
126 switch(s[0])
127 {
128 case '.': if (s[1]=='.') return DOTDOT;
129 else return 0;
130 case ':': if (s[1]==':') return COLONCOLON;
131 else return 0;
132 case '-': if (s[1]=='-') return MINUSMINUS;
133 else return 0;
134 case '+': if (s[1]=='+') return PLUSPLUS;
135 else return 0;
136 case '=': if (s[1]=='=') return EQUAL_EQUAL;
137 else return 0;
138 case '<': if (s[1]=='=') return LE;
139 else if (s[1]=='>') return NOTEQUAL;
140 else return 0;
141 case '>': if (s[1]=='=') return GE;
142 else return 0;
143 case '!': if (s[1]=='=') return NOTEQUAL;
144 else return 0;
145 }
146 return 0;
147}
@ PLUSPLUS
Definition: grammar.cc:274
@ MINUSMINUS
Definition: grammar.cc:271
@ GE
Definition: grammar.cc:269
@ EQUAL_EQUAL
Definition: grammar.cc:268
@ LE
Definition: grammar.cc:270
@ NOTEQUAL
Definition: grammar.cc:273
@ DOTDOT
Definition: grammar.cc:267
@ COLONCOLON
Definition: grammar.cc:275

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1376 of file ipshell.cc.

1377{
1378 if (iiCurrArgs==NULL)
1379 {
1380 if (strcmp(p->name,"#")==0)
1381 return iiDefaultParameter(p);
1382 Werror("not enough arguments for proc %s",VoiceName());
1383 p->CleanUp();
1384 return TRUE;
1385 }
1387 leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1388 BOOLEAN is_default_list=FALSE;
1389 if (strcmp(p->name,"#")==0)
1390 {
1391 is_default_list=TRUE;
1392 rest=NULL;
1393 }
1394 else
1395 {
1396 h->next=NULL;
1397 }
1399 if (is_default_list)
1400 {
1402 }
1403 else
1404 {
1405 iiCurrArgs=rest;
1406 }
1407 h->CleanUp();
1409 return res;
1410}
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1260

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

1038{
1039 int len,reg,typ0;
1040
1041 resolvente r=liFindRes(L,&len,&typ0);
1042
1043 if (r==NULL)
1044 return -2;
1045 intvec *weights=NULL;
1046 int add_row_shift=0;
1047 intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1048 if (ww!=NULL)
1049 {
1050 weights=ivCopy(ww);
1051 add_row_shift = ww->min_in();
1052 (*weights) -= add_row_shift;
1053 }
1054 //Print("attr:%x\n",weights);
1055
1056 intvec *dummy=syBetti(r,len,&reg,weights);
1057 if (weights!=NULL) delete weights;
1058 delete dummy;
1059 omFreeSize((ADDRESS)r,len*sizeof(ideal));
1060 return reg+1+add_row_shift;
1061}
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:132
int min_in()
Definition: intvec.h:121
intvec * ivCopy(const intvec *o)
Definition: intvec.h:145
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770

◆ iiReportTypes()

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

Definition at line 6544 of file ipshell.cc.

6545{
6546 char buf[250];
6547 buf[0]='\0';
6548 if (nr==0)
6549 sprintf(buf,"wrong length of parameters(%d), expected ",t);
6550 else
6551 sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6552 for(int i=1;i<=T[0];i++)
6553 {
6554 strcat(buf,"`");
6555 strcat(buf,Tok2Cmdname(T[i]));
6556 strcat(buf,"`");
6557 if (i<T[0]) strcat(buf,",");
6558 }
6559 WerrorS(buf);
6560}
STATIC_VAR jList * T
Definition: janet.cc:30
int status int void * buf
Definition: si_signals.h:59

◆ iiSetReturn()

void iiSetReturn ( const leftv  source)

Definition at line 6591 of file ipshell.cc.

6592{
6593 if ((source->next==NULL)&&(source->e==NULL))
6594 {
6595 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6596 {
6597 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6598 source->Init();
6599 return;
6600 }
6601 if (source->rtyp==IDHDL)
6602 {
6603 if ((IDLEV((idhdl)source->data)==myynest)
6604 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6605 {
6607 iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6608 iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6609 iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6611 IDATTR((idhdl)source->data)=NULL;
6612 IDDATA((idhdl)source->data)=NULL;
6613 source->name=NULL;
6614 source->attribute=NULL;
6615 return;
6616 }
6617 }
6618 }
6619 iiRETURNEXPR.Copy(source);
6620}
Subexpr e
Definition: subexpr.h:105
#define IDATTR(a)
Definition: ipid.h:123
@ ALIAS_CMD
Definition: tok.h:34

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6443 of file ipshell.cc.

6444{
6445 // assume a: level
6446 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6447 {
6448 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6449 char assume_yylinebuf[80];
6450 strncpy(assume_yylinebuf,my_yylinebuf,79);
6451 int lev=(long)a->Data();
6452 int startlev=0;
6453 idhdl h=ggetid("assumeLevel");
6454 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6455 if(lev <=startlev)
6456 {
6457 BOOLEAN bo=b->Eval();
6458 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6459 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6460 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6461 }
6462 }
6463 b->CleanUp();
6464 a->CleanUp();
6465 return FALSE;
6466}
#define IDINT(a)
Definition: ipid.h:125

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

89{
90 if (t<127)
91 {
92 STATIC_VAR char ch[2];
93 switch (t)
94 {
95 case '&':
96 return "and";
97 case '|':
98 return "or";
99 default:
100 ch[0]=t;
101 ch[1]='\0';
102 return ch;
103 }
104 }
105 switch (t)
106 {
107 case COLONCOLON: return "::";
108 case DOTDOT: return "..";
109 //case PLUSEQUAL: return "+=";
110 //case MINUSEQUAL: return "-=";
111 case MINUSMINUS: return "--";
112 case PLUSPLUS: return "++";
113 case EQUAL_EQUAL: return "==";
114 case LE: return "<=";
115 case GE: return ">=";
116 case NOTEQUAL: return "<>";
117 default: return Tok2Cmdname(t);
118 }
119}
#define STATIC_VAR
Definition: globaldefs.h:7

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 588 of file ipshell.cc.

589{
590 sleftv vf;
591 if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
592 {
593 WerrorS("link expected");
594 return TRUE;
595 }
596 si_link l=(si_link)vf.Data();
597 if (vf.next == NULL)
598 {
599 WerrorS("write: need at least two arguments");
600 return TRUE;
601 }
602
603 BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
604 if (b)
605 {
606 const char *s;
607 if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
608 else s=sNoName_fe;
609 Werror("cannot write to %s",s);
610 }
611 vf.CleanUp();
612 return b;
613}
const char sNoName_fe[]
Definition: fevoices.cc:57
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
@ LINK_CMD
Definition: tok.h:117

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 967 of file ipshell.cc.

968{
969 sleftv tmp;
970 tmp.Init();
971 tmp.rtyp=INT_CMD;
972 tmp.data=(void *)1;
973 if ((u->Typ()==IDEAL_CMD)
974 || (u->Typ()==MODUL_CMD))
975 return jjBETTI2_ID(res,u,&tmp);
976 else
977 return jjBETTI2(res,u,&tmp);
978}
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:980
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:1001

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

1002{
1003 resolvente r;
1004 int len;
1005 int reg,typ0;
1006 lists l=(lists)u->Data();
1007
1008 intvec *weights=NULL;
1009 int add_row_shift=0;
1010 intvec *ww=NULL;
1011 if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
1012 if (ww!=NULL)
1013 {
1014 weights=ivCopy(ww);
1015 add_row_shift = ww->min_in();
1016 (*weights) -= add_row_shift;
1017 }
1018 //Print("attr:%x\n",weights);
1019
1020 r=liFindRes(l,&len,&typ0);
1021 if (r==NULL) return TRUE;
1022 intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
1023 res->data=(void*)res_im;
1024 omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
1025 //Print("rowShift: %d ",add_row_shift);
1026 for(int i=1;i<=res_im->rows();i++)
1027 {
1028 if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
1029 else break;
1030 }
1031 //Print(" %d\n",add_row_shift);
1032 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
1033 if (weights!=NULL) delete weights;
1034 return FALSE;
1035}
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:153
int rows() const
Definition: intvec.h:96
#define IMATELEM(M, I, J)
Definition: intvec.h:85

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

981{
983 l->Init(1);
984 l->m[0].rtyp=u->Typ();
985 l->m[0].data=u->Data();
986 attr *a=u->Attribute();
987 if (a!=NULL)
988 l->m[0].attribute=*a;
989 sleftv tmp2;
990 tmp2.Init();
991 tmp2.rtyp=LIST_CMD;
992 tmp2.data=(void *)l;
994 l->m[0].data=NULL;
995 l->m[0].attribute=NULL;
996 l->m[0].rtyp=DEF_CMD;
997 l->Clean();
998 return r;
999}
attr * Attribute()
Definition: subexpr.cc:1454
CFList tmp2
Definition: facFqBivar.cc:72
@ DEF_CMD
Definition: tok.h:58

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3346 of file ipshell.cc.

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

◆ jjINT_S_TO_ID()

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

Definition at line 6278 of file ipshell.cc.

6279{
6280 if (n==0) n=1;
6281 ideal l=idInit(n,1);
6282 int i;
6283 poly p;
6284 for(i=rVar(currRing);i>0;i--)
6285 {
6286 if (e[i]>0)
6287 {
6288 n--;
6289 p=pOne();
6290 pSetExp(p,i,1);
6291 pSetm(p);
6292 l->m[n]=p;
6293 if (n==0) break;
6294 }
6295 }
6296 res->data=(char*)l;
6298 omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6299}
#define setFlag(A, F)
Definition: ipid.h:113
#define FLAG_STD
Definition: ipid.h:106
#define pSetExp(p, i, v)
Definition: polys.h:42

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

947{
948 int len=0;
949 int typ0;
950 lists L=(lists)v->Data();
951 intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
952 int add_row_shift = 0;
953 if (weights==NULL)
954 weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
955 if (weights!=NULL) add_row_shift=weights->min_in();
956 resolvente rr=liFindRes(L,&len,&typ0);
957 if (rr==NULL) return TRUE;
958 resolvente r=iiCopyRes(rr,len);
959
960 syMinimizeResolvente(r,len,0);
961 omFreeSize((ADDRESS)rr,len*sizeof(ideal));
962 len++;
963 res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
964 return FALSE;
965}
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:936
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355

◆ jjPROC()

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

Definition at line 1621 of file iparith.cc.

1622{
1623 void *d;
1624 Subexpr e;
1625 int typ;
1626 BOOLEAN t=FALSE;
1627 idhdl tmp_proc=NULL;
1628 if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1629 {
1630 tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1631 tmp_proc->id="_auto";
1632 tmp_proc->typ=PROC_CMD;
1633 tmp_proc->data.pinf=(procinfo *)u->Data();
1634 tmp_proc->ref=1;
1635 d=u->data; u->data=(void *)tmp_proc;
1636 e=u->e; u->e=NULL;
1637 t=TRUE;
1638 typ=u->rtyp; u->rtyp=IDHDL;
1639 }
1640 BOOLEAN sl;
1641 if (u->req_packhdl==currPack)
1642 sl = iiMake_proc((idhdl)u->data,NULL,v);
1643 else
1644 sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1645 if (t)
1646 {
1647 u->rtyp=typ;
1648 u->data=d;
1649 u->e=e;
1650 omFreeSize(tmp_proc,sizeof(idrec));
1651 }
1652 if (sl) return TRUE;
1653 memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1655 return FALSE;
1656}
utypes data
Definition: idrec.h:40
short ref
Definition: idrec.h:46
const char * id
Definition: idrec.h:39
package req_packhdl
Definition: subexpr.h:106
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition: iplib.cc:504

◆ jjRESULTANT()

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

Definition at line 3339 of file ipshell.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6308 of file ipshell.cc.

6309{
6310 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6311 ideal I=(ideal)u->Data();
6312 int i;
6313 int n=0;
6314 for(i=I->nrows*I->ncols-1;i>=0;i--)
6315 {
6316 int n0=pGetVariables(I->m[i],e);
6317 if (n0>n) n=n0;
6318 }
6319 jjINT_S_TO_ID(n,e,res);
6320 return FALSE;
6321}
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6278
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6300 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387{
388 BOOLEAN changed=FALSE;
390 ring cr=currRing;
391 if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392 //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393
394 killlocals_rec(&(basePack->idroot),v,currRing);
395
397 {
398 int t=iiRETURNEXPR.Typ();
399 if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
400 {
402 if (((ring)h->data)->idroot!=NULL)
403 killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404 }
405 else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406 {
408 changed |=killlocals_list(v,(lists)h->data);
409 }
410 }
411 if (changed)
412 {
414 if (currRingHdl==NULL)
416 else if(cr!=currRing)
417 rChangeCurrRing(cr);
418 }
419
420 if (myynest<=1) iiNoKeepRing=TRUE;
421 //Print("end killlocals >= %d\n",v);
422 //listall();
423}
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1701
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295
void rChangeCurrRing(ring r)
Definition: polys.cc:15

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

296{
297 idhdl h = *localhdl;
298 while (h!=NULL)
299 {
300 int vv;
301 //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
302 if ((vv=IDLEV(h))>0)
303 {
304 if (vv < v)
305 {
306 if (iiNoKeepRing)
307 {
308 //PrintS(" break\n");
309 return;
310 }
311 h = IDNEXT(h);
312 //PrintLn();
313 }
314 else //if (vv >= v)
315 {
316 idhdl nexth = IDNEXT(h);
317 killhdl2(h,localhdl,r);
318 h = nexth;
319 //PrintS("kill\n");
320 }
321 }
322 else
323 {
324 h = IDNEXT(h);
325 //PrintLn();
326 }
327 }
328}
#define IDNEXT(a)
Definition: ipid.h:118

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 366 of file ipshell.cc.

367{
368 if (L==NULL) return FALSE;
369 BOOLEAN changed=FALSE;
370 int n=L->nr;
371 for(;n>=0;n--)
372 {
373 leftv h=&(L->m[n]);
374 void *d=h->data;
375 if ((h->rtyp==RING_CMD)
376 && (((ring)d)->idroot!=NULL))
377 {
378 if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
379 killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
380 }
381 else if (h->rtyp==LIST_CMD)
382 changed|=killlocals_list(v,(lists)d);
383 }
384 return changed;
385}

◆ killlocals_rec()

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

Definition at line 330 of file ipshell.cc.

331{
332 idhdl h=*root;
333 while (h!=NULL)
334 {
335 if (IDLEV(h)>=v)
336 {
337// Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
338 idhdl n=IDNEXT(h);
339 killhdl2(h,root,r);
340 h=n;
341 }
342 else if (IDTYP(h)==PACKAGE_CMD)
343 {
344 // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345 if (IDPACKAGE(h)!=basePack)
346 killlocals_rec(&(IDRING(h)->idroot),v,r);
347 h=IDNEXT(h);
348 }
349 else if (IDTYP(h)==RING_CMD)
350 {
351 if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
352 // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
353 {
354 // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
355 killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
356 }
357 h=IDNEXT(h);
358 }
359 else
360 {
361// Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
362 h=IDNEXT(h);
363 }
364 }
365}

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3322 of file ipshell.cc.

3323{
3324 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3325 if (res->data==NULL)
3326 res->data=(char *)new intvec(rVar(currRing));
3327 return FALSE;
3328}
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3300 of file ipshell.cc.

3301{
3302 ideal F=(ideal)id->Data();
3303 intvec * iv = new intvec(rVar(currRing));
3304 polyset s;
3305 int sl, n, i;
3306 int *x;
3307
3308 res->data=(char *)iv;
3309 s = F->m;
3310 sl = IDELEMS(F) - 1;
3311 n = rVar(currRing);
3312 double wNsqr = (double)2.0 / (double)n;
3314 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3315 wCall(s, sl, x, wNsqr, currRing);
3316 for (i = n; i!=0; i--)
3317 (*iv)[i-1] = x[i + n + 1];
3318 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3319 return FALSE;
3320}
Variable x
Definition: cfModGcd.cc:4082
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.cc:78

◆ list1()

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

Definition at line 149 of file ipshell.cc.

150{
151 char buffer[22];
152 int l;
153 char buf2[128];
154
155 if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
156 else sprintf(buf2, "%s", IDID(h));
157
158 Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
159 if (h == currRingHdl) PrintS("*");
160 PrintS(Tok2Cmdname((int)IDTYP(h)));
161
162 ipListFlag(h);
163 switch(IDTYP(h))
164 {
165 case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
166 case INT_CMD: Print(" %d",IDINT(h)); break;
167 case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
168 case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
169 break;
170 case POLY_CMD:
171 case VECTOR_CMD:if (c)
172 {
173 PrintS(" ");wrp(IDPOLY(h));
174 if(IDPOLY(h) != NULL)
175 {
176 Print(", %d monomial(s)",pLength(IDPOLY(h)));
177 }
178 }
179 break;
180 case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));// and continue
181 case IDEAL_CMD: Print(", %u generator(s)",
182 IDELEMS(IDIDEAL(h))); break;
183 case MAP_CMD:
184 Print(" from %s",IDMAP(h)->preimage); break;
185 case MATRIX_CMD:Print(" %u x %u"
188 );
189 break;
190 case SMATRIX_CMD:Print(" %u x %u"
191 ,(int)(IDIDEAL(h)->rank)
192 ,IDELEMS(IDIDEAL(h))
193 );
194 break;
195 case PACKAGE_CMD:
197 break;
198 case PROC_CMD: if((IDPROC(h)->libname!=NULL)
199 && (strlen(IDPROC(h)->libname)>0))
200 Print(" from %s",IDPROC(h)->libname);
201 if(IDPROC(h)->language==LANG_C)
202 PrintS(" (C)");
203 if(IDPROC(h)->is_static)
204 PrintS(" (static)");
205 break;
206 case STRING_CMD:
207 {
208 char *s;
209 l=strlen(IDSTRING(h));
210 memset(buffer,0,sizeof(buffer));
211 strncpy(buffer,IDSTRING(h),si_min(l,20));
212 if ((s=strchr(buffer,'\n'))!=NULL)
213 {
214 *s='\0';
215 }
216 PrintS(" ");
217 PrintS(buffer);
218 if((s!=NULL) ||(l>20))
219 {
220 Print("..., %d char(s)",l);
221 }
222 break;
223 }
224 case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
225 break;
226 case RING_CMD:
227 if ((IDRING(h)==currRing) && (currRingHdl!=h))
228 PrintS("(*)"); /* this is an alias to currRing */
229 //Print(" ref:%d",IDRING(h)->ref);
230#ifdef RDEBUG
232 Print(" <%lx>",(long)(IDRING(h)));
233#endif
234 break;
235#ifdef SINGULAR_4_2
236 case CNUMBER_CMD:
237 { number2 n=(number2)IDDATA(h);
238 Print(" (%s)",nCoeffName(n->cf));
239 break;
240 }
241 case CMATRIX_CMD:
243 Print(" %d x %d (%s)",
244 b->rows(),b->cols(),
245 nCoeffName(b->basecoeffs()));
246 break;
247 }
248#endif
249 /*default: break;*/
250 }
251 PrintLn();
252}
static int si_min(const int a, const int b)
Definition: auxiliary.h:125
Matrices of numbers.
Definition: bigintmat.h:51
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:963
CanonicalForm buf2
Definition: facFqBivar.cc:73
@ SMATRIX_CMD
Definition: grammar.cc:291
void ipListFlag(idhdl h)
Definition: ipid.cc:619
#define IDMATRIX(a)
Definition: ipid.h:134
#define IDSTRING(a)
Definition: ipid.h:136
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDPOLY(a)
Definition: ipid.h:130
void paPrint(const char *n, package p)
Definition: ipshell.cc:6323
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
static unsigned pLength(poly a)
Definition: p_polys.h:191
void wrp(poly p)
Definition: polys.h:310
void PrintS(const char *s)
Definition: reporter.cc:284
void PrintLn()
Definition: reporter.cc:310
EXTERN_VAR int traceit
Definition: reporter.h:24
#define TRACE_SHOW_RINGS
Definition: reporter.h:36
@ LANG_C
Definition: subexpr.h:22
@ CMATRIX_CMD
Definition: tok.h:46
@ 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 425 of file ipshell.cc.

426{
427 package savePack=currPack;
428 idhdl h,start;
429 BOOLEAN all = typ<0;
430 BOOLEAN really_all=FALSE;
431
432 if ( typ==0 )
433 {
434 if (strcmp(what,"all")==0)
435 {
436 if (currPack!=basePack)
437 list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
438 really_all=TRUE;
439 h=basePack->idroot;
440 }
441 else
442 {
443 h = ggetid(what);
444 if (h!=NULL)
445 {
446 if (iterate) list1(prefix,h,TRUE,fullname);
447 if (IDTYP(h)==ALIAS_CMD) PrintS("A");
448 if ((IDTYP(h)==RING_CMD)
449 //|| (IDTYP(h)==PACKAGE_CMD)
450 )
451 {
452 h=IDRING(h)->idroot;
453 }
454 else if(IDTYP(h)==PACKAGE_CMD)
455 {
457 //Print("list_cmd:package\n");
458 all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
459 h=IDPACKAGE(h)->idroot;
460 }
461 else
462 {
463 currPack=savePack;
464 return;
465 }
466 }
467 else
468 {
469 Werror("%s is undefined",what);
470 currPack=savePack;
471 return;
472 }
473 }
474 all=TRUE;
475 }
476 else if (RingDependend(typ))
477 {
478 h = currRing->idroot;
479 }
480 else
481 h = IDROOT;
482 start=h;
483 while (h!=NULL)
484 {
485 if ((all
486 && (IDTYP(h)!=PROC_CMD)
487 &&(IDTYP(h)!=PACKAGE_CMD)
488 &&(IDTYP(h)!=CRING_CMD)
489 )
490 || (typ == IDTYP(h))
491 || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
492 )
493 {
494 list1(prefix,h,start==currRingHdl, fullname);
495 if ((IDTYP(h)==RING_CMD)
496 && (really_all || (all && (h==currRingHdl)))
497 && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
498 {
499 list_cmd(0,IDID(h),"// ",FALSE);
500 }
501 if (IDTYP(h)==PACKAGE_CMD && really_all)
502 {
503 package save_p=currPack;
505 list_cmd(0,IDID(h),"// ",FALSE);
506 currPack=save_p;
507 }
508 }
509 h = IDNEXT(h);
510 }
511 currPack=savePack;
512}
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:425
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:149

◆ list_error()

void list_error ( semicState  state)

Definition at line 3467 of file ipshell.cc.

3468{
3469 switch( state )
3470 {
3471 case semicListTooShort:
3472 WerrorS( "the list is too short" );
3473 break;
3474 case semicListTooLong:
3475 WerrorS( "the list is too long" );
3476 break;
3477
3479 WerrorS( "first element of the list should be int" );
3480 break;
3482 WerrorS( "second element of the list should be int" );
3483 break;
3485 WerrorS( "third element of the list should be int" );
3486 break;
3488 WerrorS( "fourth element of the list should be intvec" );
3489 break;
3491 WerrorS( "fifth element of the list should be intvec" );
3492 break;
3494 WerrorS( "sixth element of the list should be intvec" );
3495 break;
3496
3497 case semicListNNegative:
3498 WerrorS( "first element of the list should be positive" );
3499 break;
3501 WerrorS( "wrong number of numerators" );
3502 break;
3504 WerrorS( "wrong number of denominators" );
3505 break;
3507 WerrorS( "wrong number of multiplicities" );
3508 break;
3509
3511 WerrorS( "the Milnor number should be positive" );
3512 break;
3514 WerrorS( "the geometrical genus should be nonnegative" );
3515 break;
3517 WerrorS( "all numerators should be positive" );
3518 break;
3520 WerrorS( "all denominators should be positive" );
3521 break;
3523 WerrorS( "all multiplicities should be positive" );
3524 break;
3525
3527 WerrorS( "it is not symmetric" );
3528 break;
3530 WerrorS( "it is not monotonous" );
3531 break;
3532
3534 WerrorS( "the Milnor number is wrong" );
3535 break;
3536 case semicListPGWrong:
3537 WerrorS( "the geometrical genus is wrong" );
3538 break;
3539
3540 default:
3541 WerrorS( "unspecific error" );
3542 break;
3543 }
3544}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4252 of file ipshell.cc.

4253{
4254 // -------------------
4255 // check list length
4256 // -------------------
4257
4258 if( l->nr < 5 )
4259 {
4260 return semicListTooShort;
4261 }
4262 else if( l->nr > 5 )
4263 {
4264 return semicListTooLong;
4265 }
4266
4267 // -------------
4268 // check types
4269 // -------------
4270
4271 if( l->m[0].rtyp != INT_CMD )
4272 {
4274 }
4275 else if( l->m[1].rtyp != INT_CMD )
4276 {
4278 }
4279 else if( l->m[2].rtyp != INT_CMD )
4280 {
4282 }
4283 else if( l->m[3].rtyp != INTVEC_CMD )
4284 {
4286 }
4287 else if( l->m[4].rtyp != INTVEC_CMD )
4288 {
4290 }
4291 else if( l->m[5].rtyp != INTVEC_CMD )
4292 {
4294 }
4295
4296 // -------------------------
4297 // check number of entries
4298 // -------------------------
4299
4300 int mu = (int)(long)(l->m[0].Data( ));
4301 int pg = (int)(long)(l->m[1].Data( ));
4302 int n = (int)(long)(l->m[2].Data( ));
4303
4304 if( n <= 0 )
4305 {
4306 return semicListNNegative;
4307 }
4308
4309 intvec *num = (intvec*)l->m[3].Data( );
4310 intvec *den = (intvec*)l->m[4].Data( );
4311 intvec *mul = (intvec*)l->m[5].Data( );
4312
4313 if( n != num->length( ) )
4314 {
4316 }
4317 else if( n != den->length( ) )
4318 {
4320 }
4321 else if( n != mul->length( ) )
4322 {
4324 }
4325
4326 // --------
4327 // values
4328 // --------
4329
4330 if( mu <= 0 )
4331 {
4332 return semicListMuNegative;
4333 }
4334 if( pg < 0 )
4335 {
4336 return semicListPgNegative;
4337 }
4338
4339 int i;
4340
4341 for( i=0; i<n; i++ )
4342 {
4343 if( (*num)[i] <= 0 )
4344 {
4345 return semicListNumNegative;
4346 }
4347 if( (*den)[i] <= 0 )
4348 {
4349 return semicListDenNegative;
4350 }
4351 if( (*mul)[i] <= 0 )
4352 {
4353 return semicListMulNegative;
4354 }
4355 }
4356
4357 // ----------------
4358 // check symmetry
4359 // ----------------
4360
4361 int j;
4362
4363 for( i=0, j=n-1; i<=j; i++,j-- )
4364 {
4365 if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4366 (*den)[i] != (*den)[j] ||
4367 (*mul)[i] != (*mul)[j] )
4368 {
4369 return semicListNotSymmetric;
4370 }
4371 }
4372
4373 // ----------------
4374 // check monotony
4375 // ----------------
4376
4377 for( i=0, j=1; i<n/2; i++,j++ )
4378 {
4379 if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4380 {
4382 }
4383 }
4384
4385 // ---------------------
4386 // check Milnor number
4387 // ---------------------
4388
4389 for( mu=0, i=0; i<n; i++ )
4390 {
4391 mu += (*mul)[i];
4392 }
4393
4394 if( mu != (int)(long)(l->m[0].Data( )) )
4395 {
4396 return semicListMilnorWrong;
4397 }
4398
4399 // -------------------------
4400 // check geometrical genus
4401 // -------------------------
4402
4403 for( pg=0, i=0; i<n; i++ )
4404 {
4405 if( (*num)[i]<=(*den)[i] )
4406 {
4407 pg += (*mul)[i];
4408 }
4409 }
4410
4411 if( pg != (int)(long)(l->m[1].Data( )) )
4412 {
4413 return semicListPGWrong;
4414 }
4415
4416 return semicOK;
4417}
void mu(int **points, int sizePoints)

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5078 of file ipshell.cc.

5079{
5080 int i,j;
5081 int count= self->roots[0]->getAnzRoots(); // number of roots
5082 int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5083
5084 lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5085
5086 if ( self->found_roots )
5087 {
5088 listofroots->Init( count );
5089
5090 for (i=0; i < count; i++)
5091 {
5092 lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5093 onepoint->Init(elem);
5094 for ( j= 0; j < elem; j++ )
5095 {
5096 if ( !rField_is_long_C(currRing) )
5097 {
5098 onepoint->m[j].rtyp=STRING_CMD;
5099 onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5100 }
5101 else
5102 {
5103 onepoint->m[j].rtyp=NUMBER_CMD;
5104 onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5105 }
5106 onepoint->m[j].next= NULL;
5107 onepoint->m[j].name= NULL;
5108 }
5109 listofroots->m[i].rtyp=LIST_CMD;
5110 listofroots->m[i].data=(void *)onepoint;
5111 listofroots->m[j].next= NULL;
5112 listofroots->m[j].name= NULL;
5113 }
5114
5115 }
5116 else
5117 {
5118 listofroots->Init( 0 );
5119 }
5120
5121 return listofroots;
5122}
rootContainer ** roots
Definition: mpr_numeric.h:167
bool found_roots
Definition: mpr_numeric.h:172
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
int getAnzRoots()
Definition: mpr_numeric.h:97
int getAnzElems()
Definition: mpr_numeric.h:95
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:704
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:546
int status int void size_t count
Definition: si_signals.h:59

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4562 of file ipshell.cc.

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

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4568 of file ipshell.cc.

4569{
4570 if ( !(rField_is_long_R(currRing)) )
4571 {
4572 WerrorS("Ground field not implemented!");
4573 return TRUE;
4574 }
4575
4576 simplex * LP;
4577 matrix m;
4578
4579 leftv v= args;
4580 if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4581 return TRUE;
4582 else
4583 m= (matrix)(v->CopyD());
4584
4585 LP = new simplex(MATROWS(m),MATCOLS(m));
4586 LP->mapFromMatrix(m);
4587
4588 v= v->next;
4589 if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4590 return TRUE;
4591 else
4592 LP->m= (int)(long)(v->Data());
4593
4594 v= v->next;
4595 if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4596 return TRUE;
4597 else
4598 LP->n= (int)(long)(v->Data());
4599
4600 v= v->next;
4601 if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4602 return TRUE;
4603 else
4604 LP->m1= (int)(long)(v->Data());
4605
4606 v= v->next;
4607 if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4608 return TRUE;
4609 else
4610 LP->m2= (int)(long)(v->Data());
4611
4612 v= v->next;
4613 if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4614 return TRUE;
4615 else
4616 LP->m3= (int)(long)(v->Data());
4617
4618#ifdef mprDEBUG_PROT
4619 Print("m (constraints) %d\n",LP->m);
4620 Print("n (columns) %d\n",LP->n);
4621 Print("m1 (<=) %d\n",LP->m1);
4622 Print("m2 (>=) %d\n",LP->m2);
4623 Print("m3 (==) %d\n",LP->m3);
4624#endif
4625
4626 LP->compute();
4627
4628 lists lres= (lists)omAlloc( sizeof(slists) );
4629 lres->Init( 6 );
4630
4631 lres->m[0].rtyp= MATRIX_CMD; // output matrix
4632 lres->m[0].data=(void*)LP->mapToMatrix(m);
4633
4634 lres->m[1].rtyp= INT_CMD; // found a solution?
4635 lres->m[1].data=(void*)(long)LP->icase;
4636
4637 lres->m[2].rtyp= INTVEC_CMD;
4638 lres->m[2].data=(void*)LP->posvToIV();
4639
4640 lres->m[3].rtyp= INTVEC_CMD;
4641 lres->m[3].data=(void*)LP->zrovToIV();
4642
4643 lres->m[4].rtyp= INT_CMD;
4644 lres->m[4].data=(void*)(long)LP->m;
4645
4646 lres->m[5].rtyp= INT_CMD;
4647 lres->m[5].data=(void*)(long)LP->n;
4648
4649 res->data= (void*)lres;
4650
4651 return FALSE;
4652}
int m
Definition: cfEzgcd.cc:128
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:195
intvec * zrovToIV()
BOOLEAN mapFromMatrix(matrix m)
int icase
Definition: mpr_numeric.h:201
void compute()
matrix mapToMatrix(matrix m)
intvec * posvToIV()
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:543

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3070 of file ipshell.cc.

3071{
3072 int i,j;
3073 matrix result;
3074 ideal id=(ideal)a->Data();
3075
3077 for (i=1; i<=IDELEMS(id); i++)
3078 {
3079 for (j=1; j<=rVar(currRing); j++)
3080 {
3081 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3082 }
3083 }
3084 res->data=(char *)result;
3085 return FALSE;
3086}
return result
Definition: facAbsBiFact.cc:75
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
#define pDiff(a, b)
Definition: polys.h:296

◆ mpKoszul()

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

Definition at line 3092 of file ipshell.cc.

3093{
3094 int n=(int)(long)b->Data();
3095 int d=(int)(long)c->Data();
3096 int k,l,sign,row,col;
3097 matrix result;
3098 ideal temp;
3099 BOOLEAN bo;
3100 poly p;
3101
3102 if ((d>n) || (d<1) || (n<1))
3103 {
3104 res->data=(char *)mpNew(1,1);
3105 return FALSE;
3106 }
3107 int *choise = (int*)omAlloc(d*sizeof(int));
3108 if (id==NULL)
3109 temp=idMaxIdeal(1);
3110 else
3111 temp=(ideal)id->Data();
3112
3113 k = binom(n,d);
3114 l = k*d;
3115 l /= n-d+1;
3116 result =mpNew(l,k);
3117 col = 1;
3118 idInitChoise(d,1,n,&bo,choise);
3119 while (!bo)
3120 {
3121 sign = 1;
3122 for (l=1;l<=d;l++)
3123 {
3124 if (choise[l-1]<=IDELEMS(temp))
3125 {
3126 p = pCopy(temp->m[choise[l-1]-1]);
3127 if (sign == -1) p = pNeg(p);
3128 sign *= -1;
3129 row = idGetNumberOfChoise(l-1,d,1,n,choise);
3130 MATELEM(result,row,col) = p;
3131 }
3132 }
3133 col++;
3134 idGetNextChoise(d,n,&bo,choise);
3135 }
3136 omFreeSize(choise,d*sizeof(int));
3137 if (id==NULL) idDelete(&temp);
3138
3139 res->data=(char *)result;
3140 return FALSE;
3141}
int k
Definition: cfEzgcd.cc:99
int binom(int n, int r)
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
#define pNeg(p)
Definition: polys.h:198
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
static int sign(int x)
Definition: ring.cc:3469

◆ 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 4677 of file ipshell.cc.

4678{
4679 poly gls;
4680 gls= (poly)(arg1->Data());
4681 int howclean= (int)(long)arg3->Data();
4682
4683 if ( gls == NULL || pIsConstant( gls ) )
4684 {
4685 WerrorS("Input polynomial is constant!");
4686 return TRUE;
4687 }
4688
4690 {
4691 int* r=Zp_roots(gls, currRing);
4692 lists rlist;
4693 rlist= (lists)omAlloc( sizeof(slists) );
4694 rlist->Init( r[0] );
4695 for(int i=r[0];i>0;i--)
4696 {
4697 rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4698 rlist->m[i-1].rtyp=NUMBER_CMD;
4699 }
4700 omFree(r);
4701 res->data=rlist;
4702 res->rtyp= LIST_CMD;
4703 return FALSE;
4704 }
4705 if ( !(rField_is_R(currRing) ||
4709 {
4710 WerrorS("Ground field not implemented!");
4711 return TRUE;
4712 }
4713
4716 {
4717 unsigned long int ii = (unsigned long int)arg2->Data();
4718 setGMPFloatDigits( ii, ii );
4719 }
4720
4721 int ldummy;
4722 int deg= currRing->pLDeg( gls, &ldummy, currRing );
4723 int i,vpos=0;
4724 poly piter;
4725 lists elist;
4726
4727 elist= (lists)omAlloc( sizeof(slists) );
4728 elist->Init( 0 );
4729
4730 if ( rVar(currRing) > 1 )
4731 {
4732 piter= gls;
4733 for ( i= 1; i <= rVar(currRing); i++ )
4734 if ( pGetExp( piter, i ) )
4735 {
4736 vpos= i;
4737 break;
4738 }
4739 while ( piter )
4740 {
4741 for ( i= 1; i <= rVar(currRing); i++ )
4742 if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4743 {
4744 WerrorS("The input polynomial must be univariate!");
4745 return TRUE;
4746 }
4747 pIter( piter );
4748 }
4749 }
4750
4751 rootContainer * roots= new rootContainer();
4752 number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4753 piter= gls;
4754 for ( i= deg; i >= 0; i-- )
4755 {
4756 if ( piter && pTotaldegree(piter) == i )
4757 {
4758 pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4759 //nPrint( pcoeffs[i] );PrintS(" ");
4760 pIter( piter );
4761 }
4762 else
4763 {
4764 pcoeffs[i]= nInit(0);
4765 }
4766 }
4767
4768#ifdef mprDEBUG_PROT
4769 for (i=deg; i >= 0; i--)
4770 {
4771 nPrint( pcoeffs[i] );PrintS(" ");
4772 }
4773 PrintLn();
4774#endif
4775
4776 roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4777 roots->solver( howclean );
4778
4779 int elem= roots->getAnzRoots();
4780 char *dummy;
4781 int j;
4782
4783 lists rlist;
4784 rlist= (lists)omAlloc( sizeof(slists) );
4785 rlist->Init( elem );
4786
4788 {
4789 for ( j= 0; j < elem; j++ )
4790 {
4791 rlist->m[j].rtyp=NUMBER_CMD;
4792 rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4793 //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4794 }
4795 }
4796 else
4797 {
4798 for ( j= 0; j < elem; j++ )
4799 {
4800 dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4801 rlist->m[j].rtyp=STRING_CMD;
4802 rlist->m[j].data=(void *)dummy;
4803 }
4804 }
4805
4806 elist->Clean();
4807 //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4808
4809 // this is (via fillContainer) the same data as in root
4810 //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4811 //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4812
4813 delete roots;
4814
4815 res->data= (void*)rlist;
4816
4817 return FALSE;
4818}
int * Zp_roots(poly p, const ring r)
Definition: clapsing.cc:2188
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:66
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:300
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:437
void Clean(ring r=currRing)
Definition: lists.h:26
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:538
#define pIter(p)
Definition: monomials.h:37
EXTERN_VAR size_t gmp_output_digits
Definition: mpr_base.h:115
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
#define nCopy(n)
Definition: numbers.h:15
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:238
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:519
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:501
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:507

◆ 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 4654 of file ipshell.cc.

4655{
4656 ideal gls = (ideal)(arg1->Data());
4657 int imtype= (int)(long)arg2->Data();
4658
4659 uResultant::resMatType mtype= determineMType( imtype );
4660
4661 // check input ideal ( = polynomial system )
4662 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4663 {
4664 return TRUE;
4665 }
4666
4667 uResultant *resMat= new uResultant( gls, mtype, false );
4668 if (resMat!=NULL)
4669 {
4670 res->rtyp = MODUL_CMD;
4671 res->data= (void*)resMat->accessResMat()->getMatrix();
4672 if (!errorreported) delete resMat;
4673 }
4674 return errorreported;
4675}
virtual ideal getMatrix()
Definition: mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ mprOk
Definition: mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
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 4921 of file ipshell.cc.

4922{
4923 leftv v= args;
4924
4925 ideal gls;
4926 int imtype;
4927 int howclean;
4928
4929 // get ideal
4930 if ( v->Typ() != IDEAL_CMD )
4931 return TRUE;
4932 else gls= (ideal)(v->Data());
4933 v= v->next;
4934
4935 // get resultant matrix type to use (0,1)
4936 if ( v->Typ() != INT_CMD )
4937 return TRUE;
4938 else imtype= (int)(long)v->Data();
4939 v= v->next;
4940
4941 if (imtype==0)
4942 {
4943 ideal test_id=idInit(1,1);
4944 int j;
4945 for(j=IDELEMS(gls)-1;j>=0;j--)
4946 {
4947 if (gls->m[j]!=NULL)
4948 {
4949 test_id->m[0]=gls->m[j];
4950 intvec *dummy_w=id_QHomWeight(test_id, currRing);
4951 if (dummy_w!=NULL)
4952 {
4953 WerrorS("Newton polytope not of expected dimension");
4954 delete dummy_w;
4955 return TRUE;
4956 }
4957 }
4958 }
4959 }
4960
4961 // get and set precision in digits ( > 0 )
4962 if ( v->Typ() != INT_CMD )
4963 return TRUE;
4964 else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4966 {
4967 unsigned long int ii=(unsigned long int)v->Data();
4968 setGMPFloatDigits( ii, ii );
4969 }
4970 v= v->next;
4971
4972 // get interpolation steps (0,1,2)
4973 if ( v->Typ() != INT_CMD )
4974 return TRUE;
4975 else howclean= (int)(long)v->Data();
4976
4977 uResultant::resMatType mtype= determineMType( imtype );
4978 int i,count;
4979 lists listofroots= NULL;
4980 number smv= NULL;
4981 BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4982
4983 //emptylist= (lists)omAlloc( sizeof(slists) );
4984 //emptylist->Init( 0 );
4985
4986 //res->rtyp = LIST_CMD;
4987 //res->data= (void *)emptylist;
4988
4989 // check input ideal ( = polynomial system )
4990 if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4991 {
4992 return TRUE;
4993 }
4994
4995 uResultant * ures;
4996 rootContainer ** iproots;
4997 rootContainer ** muiproots;
4998 rootArranger * arranger;
4999
5000 // main task 1: setup of resultant matrix
5001 ures= new uResultant( gls, mtype );
5002 if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5003 {
5004 WerrorS("Error occurred during matrix setup!");
5005 return TRUE;
5006 }
5007
5008 // if dense resultant, check if minor nonsingular
5009 if ( mtype == uResultant::denseResMat )
5010 {
5011 smv= ures->accessResMat()->getSubDet();
5012#ifdef mprDEBUG_PROT
5013 PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5014#endif
5015 if ( nIsZero(smv) )
5016 {
5017 WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5018 return TRUE;
5019 }
5020 }
5021
5022 // main task 2: Interpolate specialized resultant polynomials
5023 if ( interpolate_det )
5024 iproots= ures->interpolateDenseSP( false, smv );
5025 else
5026 iproots= ures->specializeInU( false, smv );
5027
5028 // main task 3: Interpolate specialized resultant polynomials
5029 if ( interpolate_det )
5030 muiproots= ures->interpolateDenseSP( true, smv );
5031 else
5032 muiproots= ures->specializeInU( true, smv );
5033
5034#ifdef mprDEBUG_PROT
5035 int c= iproots[0]->getAnzElems();
5036 for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5037 c= muiproots[0]->getAnzElems();
5038 for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5039#endif
5040
5041 // main task 4: Compute roots of specialized polys and match them up
5042 arranger= new rootArranger( iproots, muiproots, howclean );
5043 arranger->solve_all();
5044
5045 // get list of roots
5046 if ( arranger->success() )
5047 {
5048 arranger->arrange();
5049 listofroots= listOfRoots(arranger, gmp_output_digits );
5050 }
5051 else
5052 {
5053 WerrorS("Solver was unable to find any roots!");
5054 return TRUE;
5055 }
5056
5057 // free everything
5058 count= iproots[0]->getAnzElems();
5059 for (i=0; i < count; i++) delete iproots[i];
5060 omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5061 count= muiproots[0]->getAnzElems();
5062 for (i=0; i < count; i++) delete muiproots[i];
5063 omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5064
5065 delete ures;
5066 delete arranger;
5067 if (smv!=NULL) nDelete( &smv );
5068
5069 res->data= (void *)listofroots;
5070
5071 //emptylist->Clean();
5072 // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5073
5074 return FALSE;
5075}
virtual number getSubDet()
Definition: mpr_base.h:37
virtual IStateType initState() const
Definition: mpr_base.h:41
void solve_all()
Definition: mpr_numeric.cc:858
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:883
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3059
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2921
@ denseResMat
Definition: mpr_base.h:65
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5078
#define nDelete(n)
Definition: numbers.h:16
#define nIsZero(n)
Definition: numbers.h:19
void pWrite(poly p)
Definition: polys.h:308

◆ 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 4820 of file ipshell.cc.

4821{
4822 int i;
4823 ideal p,w;
4824 p= (ideal)arg1->Data();
4825 w= (ideal)arg2->Data();
4826
4827 // w[0] = f(p^0)
4828 // w[1] = f(p^1)
4829 // ...
4830 // p can be a vector of numbers (multivariate polynom)
4831 // or one number (univariate polynom)
4832 // tdg = deg(f)
4833
4834 int n= IDELEMS( p );
4835 int m= IDELEMS( w );
4836 int tdg= (int)(long)arg3->Data();
4837
4838 res->data= (void*)NULL;
4839
4840 // check the input
4841 if ( tdg < 1 )
4842 {
4843 WerrorS("Last input parameter must be > 0!");
4844 return TRUE;
4845 }
4846 if ( n != rVar(currRing) )
4847 {
4848 Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4849 return TRUE;
4850 }
4851 if ( m != (int)pow((double)tdg+1,(double)n) )
4852 {
4853 Werror("Size of second input ideal must be equal to %d!",
4854 (int)pow((double)tdg+1,(double)n));
4855 return TRUE;
4856 }
4857 if ( !(rField_is_Q(currRing) /* ||
4858 rField_is_R() || rField_is_long_R() ||
4859 rField_is_long_C()*/ ) )
4860 {
4861 WerrorS("Ground field not implemented!");
4862 return TRUE;
4863 }
4864
4865 number tmp;
4866 number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4867 for ( i= 0; i < n; i++ )
4868 {
4869 pevpoint[i]=nInit(0);
4870 if ( (p->m)[i] )
4871 {
4872 tmp = pGetCoeff( (p->m)[i] );
4873 if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4874 {
4875 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4876 WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4877 return TRUE;
4878 }
4879 } else tmp= NULL;
4880 if ( !nIsZero(tmp) )
4881 {
4882 if ( !pIsConstant((p->m)[i]))
4883 {
4884 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4885 WerrorS("Elements of first input ideal must be numbers!");
4886 return TRUE;
4887 }
4888 pevpoint[i]= nCopy( tmp );
4889 }
4890 }
4891
4892 number *wresults= (number *)omAlloc( m * sizeof( number ) );
4893 for ( i= 0; i < m; i++ )
4894 {
4895 wresults[i]= nInit(0);
4896 if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4897 {
4898 if ( !pIsConstant((w->m)[i]))
4899 {
4900 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4901 omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4902 WerrorS("Elements of second input ideal must be numbers!");
4903 return TRUE;
4904 }
4905 wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4906 }
4907 }
4908
4909 vandermonde vm( m, n, tdg, pevpoint, FALSE );
4910 number *ncpoly= vm.interpolateDense( wresults );
4911 // do not free ncpoly[]!!
4912 poly rpoly= vm.numvec2poly( ncpoly );
4913
4914 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4915 omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4916
4917 res->data= (void*)rpoly;
4918 return FALSE;
4919}
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:411
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:29
#define nIsMOne(n)
Definition: numbers.h:26
#define nIsOne(n)
Definition: numbers.h:25

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6323 of file ipshell.cc.

6324{
6325 Print(" %s (",n);
6326 switch (p->language)
6327 {
6328 case LANG_SINGULAR: PrintS("S"); break;
6329 case LANG_C: PrintS("C"); break;
6330 case LANG_TOP: PrintS("T"); break;
6331 case LANG_MAX: PrintS("M"); break;
6332 case LANG_NONE: PrintS("N"); break;
6333 default: PrintS("U");
6334 }
6335 if(p->libname!=NULL)
6336 Print(",%s", p->libname);
6337 PrintS(")");
6338}
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_SINGULAR
Definition: subexpr.h:22
@ 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 2783 of file ipshell.cc.

2784{
2785 if ((L->nr!=3)
2786#ifdef HAVE_PLURAL
2787 &&(L->nr!=5)
2788#endif
2789 )
2790 return NULL;
2791 int is_gf_char=0;
2792 // 0: char/ cf - ring
2793 // 1: list (var)
2794 // 2: list (ord)
2795 // 3: qideal
2796 // possibly:
2797 // 4: C
2798 // 5: D
2799
2800 ring R = (ring) omAlloc0Bin(sip_sring_bin);
2801
2802 // ------------------------------------------------------------------
2803 // 0: char:
2804 if (L->m[0].Typ()==CRING_CMD)
2805 {
2806 R->cf=(coeffs)L->m[0].Data();
2807 R->cf->ref++;
2808 }
2809 else if (L->m[0].Typ()==INT_CMD)
2810 {
2811 int ch = (int)(long)L->m[0].Data();
2812 assume( ch >= 0 );
2813
2814 if (ch == 0) // Q?
2815 R->cf = nInitChar(n_Q, NULL);
2816 else
2817 {
2818 int l = IsPrime(ch); // Zp?
2819 if( l != ch )
2820 {
2821 Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2822 ch = l;
2823 }
2824 #ifndef TEST_ZN_AS_ZP
2825 R->cf = nInitChar(n_Zp, (void*)(long)ch);
2826 #else
2827 mpz_t modBase;
2828 mpz_init_set_ui(modBase,(long) ch);
2829 ZnmInfo info;
2830 info.base= modBase;
2831 info.exp= 1;
2832 R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2833 R->cf->is_field=1;
2834 R->cf->is_domain=1;
2835 R->cf->has_simple_Inverse=1;
2836 #endif
2837 }
2838 }
2839 else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2840 {
2841 lists LL=(lists)L->m[0].Data();
2842
2843#ifdef HAVE_RINGS
2844 if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2845 {
2846 rComposeRing(LL, R); // Ring!?
2847 }
2848 else
2849#endif
2850 if (LL->nr < 3)
2851 rComposeC(LL,R); // R, long_R, long_C
2852 else
2853 {
2854 if (LL->m[0].Typ()==INT_CMD)
2855 {
2856 int ch = (int)(long)LL->m[0].Data();
2857 while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2858 if (fftable[is_gf_char]==0) is_gf_char=-1;
2859
2860 if(is_gf_char!= -1)
2861 {
2862 GFInfo param;
2863
2864 param.GFChar = ch;
2865 param.GFDegree = 1;
2866 param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2867
2868 // nfInitChar should be able to handle the case when ch is in fftables!
2869 R->cf = nInitChar(n_GF, (void*)&param);
2870 }
2871 }
2872
2873 if( R->cf == NULL )
2874 {
2875 ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2876
2877 if (extRing==NULL)
2878 {
2879 WerrorS("could not create the specified coefficient field");
2880 goto rCompose_err;
2881 }
2882
2883 if( extRing->qideal != NULL ) // Algebraic extension
2884 {
2885 AlgExtInfo extParam;
2886
2887 extParam.r = extRing;
2888
2889 R->cf = nInitChar(n_algExt, (void*)&extParam);
2890 }
2891 else // Transcendental extension
2892 {
2893 TransExtInfo extParam;
2894 extParam.r = extRing;
2895 assume( extRing->qideal == NULL );
2896
2897 R->cf = nInitChar(n_transExt, &extParam);
2898 }
2899 }
2900 }
2901 }
2902 else
2903 {
2904 WerrorS("coefficient field must be described by `int` or `list`");
2905 goto rCompose_err;
2906 }
2907
2908 if( R->cf == NULL )
2909 {
2910 WerrorS("could not create coefficient field described by the input!");
2911 goto rCompose_err;
2912 }
2913
2914 // ------------------------- VARS ---------------------------
2915 if (rComposeVar(L,R)) goto rCompose_err;
2916 // ------------------------ ORDER ------------------------------
2917 if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2918
2919 // ------------------------ ??????? --------------------
2920
2921 if (!isLetterplace) rRenameVars(R);
2922 #ifdef HAVE_SHIFTBBA
2923 else
2924 {
2925 R->isLPring=isLetterplace;
2926 R->ShortOut=FALSE;
2927 R->CanShortOut=FALSE;
2928 }
2929 #endif
2930 if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2931 rComplete(R);
2932
2933 // ------------------------ Q-IDEAL ------------------------
2934
2935 if (L->m[3].Typ()==IDEAL_CMD)
2936 {
2937 ideal q=(ideal)L->m[3].Data();
2938 if (q->m[0]!=NULL)
2939 {
2940 if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2941 {
2942 #if 0
2943 WerrorS("coefficient fields must be equal if q-ideal !=0");
2944 goto rCompose_err;
2945 #else
2946 ring orig_ring=currRing;
2948 int *perm=NULL;
2949 int *par_perm=NULL;
2950 int par_perm_size=0;
2951 nMapFunc nMap;
2952
2953 if ((nMap=nSetMap(orig_ring->cf))==NULL)
2954 {
2955 if (rEqual(orig_ring,currRing))
2956 {
2957 nMap=n_SetMap(currRing->cf, currRing->cf);
2958 }
2959 else
2960 // Allow imap/fetch to be make an exception only for:
2961 if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2965 ||
2966 (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2967 (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2968 rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2969 {
2970 par_perm_size=rPar(orig_ring);
2971
2972// if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2973// naSetChar(rInternalChar(orig_ring),orig_ring);
2974// else ntSetChar(rInternalChar(orig_ring),orig_ring);
2975
2976 nSetChar(currRing->cf);
2977 }
2978 else
2979 {
2980 WerrorS("coefficient fields must be equal if q-ideal !=0");
2981 goto rCompose_err;
2982 }
2983 }
2984 perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2985 if (par_perm_size!=0)
2986 par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2987 int i;
2988 #if 0
2989 // use imap:
2990 maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2991 currRing->names,currRing->N,currRing->parameter, currRing->P,
2992 perm,par_perm, currRing->ch);
2993 #else
2994 // use fetch
2995 if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2996 {
2997 for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2998 }
2999 else if (par_perm_size!=0)
3000 for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3001 for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3002 #endif
3003 ideal dest_id=idInit(IDELEMS(q),1);
3004 for(i=IDELEMS(q)-1; i>=0; i--)
3005 {
3006 dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3007 par_perm,par_perm_size);
3008 // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3009 pTest(dest_id->m[i]);
3010 }
3011 R->qideal=dest_id;
3012 if (perm!=NULL)
3013 omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3014 if (par_perm!=NULL)
3015 omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3016 rChangeCurrRing(orig_ring);
3017 #endif
3018 }
3019 else
3020 R->qideal=idrCopyR(q,currRing,R);
3021 }
3022 }
3023 else
3024 {
3025 WerrorS("q-ideal must be given as `ideal`");
3026 goto rCompose_err;
3027 }
3028
3029
3030 // ---------------------------------------------------------------
3031 #ifdef HAVE_PLURAL
3032 if (L->nr==5)
3033 {
3034 if (nc_CallPlural((matrix)L->m[4].Data(),
3035 (matrix)L->m[5].Data(),
3036 NULL,NULL,
3037 R,
3038 true, // !!!
3039 true, false,
3040 currRing, FALSE)) goto rCompose_err;
3041 // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3042 }
3043 #endif
3044 return R;
3045
3046rCompose_err:
3047 if (R->N>0)
3048 {
3049 int i;
3050 if (R->names!=NULL)
3051 {
3052 i=R->N-1;
3053 while (i>=0) { omfree(R->names[i]); i--; }
3054 omFree(R->names);
3055 }
3056 }
3057 omfree(R->order);
3058 omfree(R->block0);
3059 omfree(R->block1);
3060 omfree(R->wvhdl);
3061 omFree(R);
3062 return NULL;
3063}
ring r
Definition: algext.h:37
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
int GFDegree
Definition: coeffs.h:95
@ n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
@ n_Q
rational (GMP) numbers
Definition: coeffs.h:30
@ 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
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
@ n_Zp
\F{p < 2^31}
Definition: coeffs.h:29
@ n_transExt
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:392
const unsigned short fftable[]
Definition: ffields.cc:31
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
const char * GFPar_name
Definition: coeffs.h:96
int GFChar
Definition: coeffs.h:94
Creation data needed for finite fields.
Definition: coeffs.h:93
const ExtensionInfo & info
< [in] sqrfree poly
static void rRenameVars(ring R)
Definition: ipshell.cc:2405
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2260
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2491
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2783
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2312
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2446
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:2682
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:163
#define assume(x)
Definition: mod2.h:389
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nSetMap(R)
Definition: numbers.h:43
#define omfree(addr)
Definition: omAllocDecl.h:237
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:4246
#define pTest(p)
Definition: polys.h:415
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:192
int IsPrime(int p)
Definition: prime.cc:61
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:3492
VAR omBin sip_sring_bin
Definition: ring.cc:43
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1746
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:530
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:513
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:600
static int rInternalChar(const ring r)
Definition: ring.h:690
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:540
#define R
Definition: sirandom.c:27
struct for passing initialization parameters to naInitChar
Definition: transext.h:88

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2260 of file ipshell.cc.

2262{
2263 // ----------------------------------------
2264 // 0: char/ cf - ring
2265 if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2266 {
2267 WerrorS("invalid coeff. field description, expecting 0");
2268 return;
2269 }
2270// R->cf->ch=0;
2271 // ----------------------------------------
2272 // 0, (r1,r2) [, "i" ]
2273 if (L->m[1].rtyp!=LIST_CMD)
2274 {
2275 WerrorS("invalid coeff. field description, expecting precision list");
2276 return;
2277 }
2278 lists LL=(lists)L->m[1].data;
2279 if ((LL->nr!=1)
2280 || (LL->m[0].rtyp!=INT_CMD)
2281 || (LL->m[1].rtyp!=INT_CMD))
2282 {
2283 WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2284 return;
2285 }
2286 int r1=(int)(long)LL->m[0].data;
2287 int r2=(int)(long)LL->m[1].data;
2288 r1=si_min(r1,32767);
2289 r2=si_min(r2,32767);
2290 LongComplexInfo par; memset(&par, 0, sizeof(par));
2291 par.float_len=r1;
2292 par.float_len2=r2;
2293 if (L->nr==2) // complex
2294 {
2295 if (L->m[2].rtyp!=STRING_CMD)
2296 {
2297 WerrorS("invalid coeff. field description, expecting parameter name");
2298 return;
2299 }
2300 par.par_name=(char*)L->m[2].data;
2301 R->cf = nInitChar(n_long_C, &par);
2302 }
2303 else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2304 R->cf = nInitChar(n_R, NULL);
2305 else /* && L->nr==1*/
2306 {
2307 R->cf = nInitChar(n_long_R, &par);
2308 }
2309}
@ n_R
single prescision (6,6) real numbers
Definition: coeffs.h:31
@ n_long_R
real floating point (GMP) numbers
Definition: coeffs.h:33
@ n_long_C
complex floating point (GMP) numbers
Definition: coeffs.h:41
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
const char * par_name
parameter name
Definition: coeffs.h:103
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
#define SHORT_REAL_LENGTH
Definition: numbers.h:57

◆ rComposeOrder()

static BOOLEAN rComposeOrder ( const lists  L,
const BOOLEAN  check_comp,
ring  R 
)
inlinestatic

Definition at line 2491 of file ipshell.cc.

2492{
2493 assume(R!=NULL);
2494 long bitmask=0L;
2495 if (L->m[2].Typ()==LIST_CMD)
2496 {
2497 lists v=(lists)L->m[2].Data();
2498 int n= v->nr+2;
2499 int j_in_R,j_in_L;
2500 // do we have an entry "L",... ?: set bitmask
2501 for (int j=0; j < n-1; j++)
2502 {
2503 if (v->m[j].Typ()==LIST_CMD)
2504 {
2505 lists vv=(lists)v->m[j].Data();
2506 if ((vv->nr==1)
2507 &&(vv->m[0].Typ()==STRING_CMD)
2508 &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2509 {
2510 number nn=(number)vv->m[1].Data();
2511 if (vv->m[1].Typ()==BIGINT_CMD)
2512 bitmask=n_Int(nn,coeffs_BIGINT);
2513 else if (vv->m[1].Typ()==INT_CMD)
2514 bitmask=(long)nn;
2515 else
2516 {
2517 Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2518 return TRUE;
2519 }
2520 break;
2521 }
2522 }
2523 }
2524 if (bitmask!=0) n--;
2525
2526 // initialize fields of R
2527 R->order=(rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
2528 R->block0=(int *)omAlloc0((n+1)*sizeof(int));
2529 R->block1=(int *)omAlloc0((n+1)*sizeof(int));
2530 R->wvhdl=(int**)omAlloc0((n+1)*sizeof(int_ptr));
2531 // init order, so that rBlocks works correctly
2532 for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2533 R->order[j_in_R] = ringorder_unspec;
2534 // orderings
2535 for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2536 {
2537 // todo: a(..), M
2538 if (v->m[j_in_L].Typ()!=LIST_CMD)
2539 {
2540 WerrorS("ordering must be list of lists");
2541 return TRUE;
2542 }
2543 lists vv=(lists)v->m[j_in_L].Data();
2544 if ((vv->nr==1)
2545 && (vv->m[0].Typ()==STRING_CMD))
2546 {
2547 if (strcmp((char*)vv->m[0].Data(),"L")==0)
2548 {
2549 j_in_R--;
2550 continue;
2551 }
2552 if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)
2553 && (vv->m[1].Typ()!=INTMAT_CMD))
2554 {
2555 PrintS(lString(vv));
2556 Werror("ordering name must be a (string,intvec), not (string,%s)",Tok2Cmdname(vv->m[1].Typ()));
2557 return TRUE;
2558 }
2559 R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2560
2561 if (j_in_R==0) R->block0[0]=1;
2562 else
2563 {
2564 int jj=j_in_R-1;
2565 while((jj>=0)
2566 && ((R->order[jj]== ringorder_a)
2567 || (R->order[jj]== ringorder_aa)
2568 || (R->order[jj]== ringorder_am)
2569 || (R->order[jj]== ringorder_c)
2570 || (R->order[jj]== ringorder_C)
2571 || (R->order[jj]== ringorder_s)
2572 || (R->order[jj]== ringorder_S)
2573 ))
2574 {
2575 //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2576 jj--;
2577 }
2578 if (jj<0) R->block0[j_in_R]=1;
2579 else R->block0[j_in_R]=R->block1[jj]+1;
2580 }
2581 intvec *iv;
2582 if (vv->m[1].Typ()==INT_CMD)
2583 {
2584 int l=si_max(1,(int)(long)vv->m[1].Data());
2585 iv=new intvec(l);
2586 for(int i=0;i<l;i++) (*iv)[i]=1;
2587 }
2588 else
2589 iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC/INTMAT
2590 int iv_len=iv->length();
2591 if (iv_len==0)
2592 {
2593 Werror("empty intvec for ordering %d (%s)",j_in_R+1,rSimpleOrdStr(R->order[j_in_R]));
2594 return TRUE;
2595 }
2596 if (R->order[j_in_R]==ringorder_M)
2597 {
2598 if (vv->m[1].rtyp==INTMAT_CMD) iv->makeVector();
2599 iv_len=iv->length();
2600 }
2601 if ((R->order[j_in_R]!=ringorder_s)
2602 &&(R->order[j_in_R]!=ringorder_c)
2603 &&(R->order[j_in_R]!=ringorder_C))
2604 {
2605 R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2606 if (R->block1[j_in_R]>R->N)
2607 {
2608 if (R->block0[j_in_R]>R->N)
2609 {
2610 Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
2611 return TRUE;
2612 }
2613 R->block1[j_in_R]=R->N;
2614 iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2615 }
2616 //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2617 }
2618 int i;
2619 switch (R->order[j_in_R])
2620 {
2621 case ringorder_ws:
2622 case ringorder_Ws:
2623 R->OrdSgn=-1; // and continue
2624 case ringorder_aa:
2625 case ringorder_a:
2626 case ringorder_wp:
2627 case ringorder_Wp:
2628 R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2629 for (i=0; i<iv_len;i++)
2630 {
2631 R->wvhdl[j_in_R][i]=(*iv)[i];
2632 }
2633 break;
2634 case ringorder_am:
2635 R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2636 for (i=0; i<iv_len;i++)
2637 {
2638 R->wvhdl[j_in_R][i]=(*iv)[i];
2639 }
2640 R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2641 //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2642 for (; i<iv->length(); i++)
2643 {
2644 R->wvhdl[j_in_R][i+1]=(*iv)[i];
2645 }
2646 break;
2647 case ringorder_M:
2648 R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2649 for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2650 R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length())));
2651 if (R->block1[j_in_R]>R->N)
2652 {
2653 R->block1[j_in_R]=R->N;
2654 }
2655 break;
2656 case ringorder_ls:
2657 case ringorder_ds:
2658 case ringorder_Ds:
2659 case ringorder_rs:
2660 R->OrdSgn=-1;
2661 case ringorder_lp:
2662 case ringorder_dp:
2663 case ringorder_Dp:
2664 case ringorder_rp:
2665 #if 0
2666 for (i=0; i<iv_len;i++)
2667 {
2668 if (((*iv)[i]!=1)&&(iv_len!=1))
2669 {
2670 iv->show(1);
2671 Warn("ignore weight %d for ord %d (%s) at pos %d\n>>%s<<",
2672 (*iv)[i],j_in_R+1,rSimpleOrdStr(R->order[j_in_R]),i+1,my_yylinebuf);
2673 break;
2674 }
2675 }
2676 #endif // break absfact.tst
2677 break;
2678 case ringorder_S:
2679 break;
2680 case ringorder_c:
2681 case ringorder_C:
2682 R->block1[j_in_R]=R->block0[j_in_R]=0;
2683 break;
2684
2685 case ringorder_s:
2686 R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2687 rSetSyzComp(R->block0[j_in_R],R);
2688 break;
2689
2690 case ringorder_IS:
2691 {
2692 R->block1[j_in_R] = R->block0[j_in_R] = 0;
2693 if( iv->length() > 0 )
2694 {
2695 const int s = (*iv)[0];
2696 assume( -2 < s && s < 2 );
2697 R->block1[j_in_R] = R->block0[j_in_R] = s;
2698 }
2699 break;
2700 }
2701 case 0:
2702 case ringorder_unspec:
2703 break;
2704 case ringorder_L: /* cannot happen */
2705 case ringorder_a64: /*not implemented */
2706 WerrorS("ring order not implemented");
2707 return TRUE;
2708 }
2709 delete iv;
2710 }
2711 else
2712 {
2713 PrintS(lString(vv));
2714 WerrorS("ordering name must be a (string,intvec)");
2715 return TRUE;
2716 }
2717 }
2718 // sanity check
2719 j_in_R=n-2;
2720 if ((R->order[j_in_R]==ringorder_c)
2721 || (R->order[j_in_R]==ringorder_C)
2722 || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2723 if (R->block1[j_in_R] != R->N)
2724 {
2725 if (((R->order[j_in_R]==ringorder_dp) ||
2726 (R->order[j_in_R]==ringorder_ds) ||
2727 (R->order[j_in_R]==ringorder_Dp) ||
2728 (R->order[j_in_R]==ringorder_Ds) ||
2729 (R->order[j_in_R]==ringorder_rp) ||
2730 (R->order[j_in_R]==ringorder_rs) ||
2731 (R->order[j_in_R]==ringorder_lp) ||
2732 (R->order[j_in_R]==ringorder_ls))
2733 &&
2734 R->block0[j_in_R] <= R->N)
2735 {
2736 R->block1[j_in_R] = R->N;
2737 }
2738 else
2739 {
2740 Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2741 return TRUE;
2742 }
2743 }
2744 if (R->block0[j_in_R]>R->N)
2745 {
2746 Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2747 for(int ii=0;ii<=j_in_R;ii++)
2748 Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2749 return TRUE;
2750 }
2751 if (check_comp)
2752 {
2753 BOOLEAN comp_order=FALSE;
2754 int jj;
2755 for(jj=0;jj<n;jj++)
2756 {
2757 if ((R->order[jj]==ringorder_c) ||
2758 (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2759 }
2760 if (!comp_order)
2761 {
2762 R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2763 R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2764 R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2765 R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2766 R->order[n-1]=ringorder_C;
2767 R->block0[n-1]=0;
2768 R->block1[n-1]=0;
2769 R->wvhdl[n-1]=NULL;
2770 n++;
2771 }
2772 }
2773 }
2774 else
2775 {
2776 WerrorS("ordering must be given as `list`");
2777 return TRUE;
2778 }
2779 if (bitmask!=0) { R->bitmask=bitmask; R->wanted_maxExp=bitmask; }
2780 return FALSE;
2781}
static int si_max(const int a, const int b)
Definition: auxiliary.h:124
void makeVector()
Definition: intvec.h:102
void show(int mat=0, int spaces=0) const
Definition: intvec.cc:149
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:547
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:380
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:327
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
rRingOrder_t rOrderName(char *ordername)
Definition: ring.cc:507
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5166
rRingOrder_t
order stuff
Definition: ring.h:68
@ ringorder_lp
Definition: ring.h:77
@ ringorder_a
Definition: ring.h:70
@ ringorder_am
Definition: ring.h:88
@ ringorder_a64
for int64 weights
Definition: ring.h:71
@ ringorder_rs
opposite of ls
Definition: ring.h:92
@ ringorder_C
Definition: ring.h:73
@ ringorder_S
S?
Definition: ring.h:75
@ ringorder_ds
Definition: ring.h:84
@ ringorder_Dp
Definition: ring.h:80
@ ringorder_unspec
Definition: ring.h:94
@ ringorder_L
Definition: ring.h:89
@ ringorder_Ds
Definition: ring.h:85
@ ringorder_dp
Definition: ring.h:78
@ ringorder_c
Definition: ring.h:72
@ ringorder_rp
Definition: ring.h:79
@ ringorder_aa
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:91
@ ringorder_Wp
Definition: ring.h:82
@ ringorder_ws
Definition: ring.h:86
@ ringorder_Ws
Definition: ring.h:87
@ ringorder_IS
Induced (Schreyer) ordering.
Definition: ring.h:93
@ ringorder_ls
Definition: ring.h:83
@ ringorder_s
s?
Definition: ring.h:76
@ ringorder_wp
Definition: ring.h:81
@ ringorder_M
Definition: ring.h:74
int * int_ptr
Definition: structs.h:54
@ BIGINT_CMD
Definition: tok.h:38

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2312 of file ipshell.cc.

2314{
2315 // ----------------------------------------
2316 // 0: string: integer
2317 // no further entries --> Z
2318 mpz_t modBase;
2319 unsigned int modExponent = 1;
2320
2321 if (L->nr == 0)
2322 {
2323 mpz_init_set_ui(modBase,0);
2324 modExponent = 1;
2325 }
2326 // ----------------------------------------
2327 // 1:
2328 else
2329 {
2330 if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2331 lists LL=(lists)L->m[1].data;
2332 if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2333 {
2334 number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2335 // assume that tmp is integer, not rational
2336 mpz_init(modBase);
2337 n_MPZ (modBase, tmp, coeffs_BIGINT);
2338 }
2339 else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2340 {
2341 mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2342 }
2343 else
2344 {
2345 mpz_init_set_ui(modBase,0);
2346 }
2347 if (LL->nr >= 1)
2348 {
2349 modExponent = (unsigned long) LL->m[1].data;
2350 }
2351 else
2352 {
2353 modExponent = 1;
2354 }
2355 }
2356 // ----------------------------------------
2357 if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
2358 {
2359 WerrorS("Wrong ground ring specification (module is 1)");
2360 return;
2361 }
2362 if (modExponent < 1)
2363 {
2364 WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2365 return;
2366 }
2367 // module is 0 ---> integers
2368 if (mpz_sgn1(modBase) == 0)
2369 {
2370 R->cf=nInitChar(n_Z,NULL);
2371 }
2372 // we have an exponent
2373 else if (modExponent > 1)
2374 {
2375 //R->cf->ch = R->cf->modExponent;
2376 if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2377 {
2378 /* this branch should be active for modExponent = 2..32 resp. 2..64,
2379 depending on the size of a long on the respective platform */
2380 R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2381 }
2382 else
2383 {
2384 //ringtype 3
2385 ZnmInfo info;
2386 info.base= modBase;
2387 info.exp= modExponent;
2388 R->cf=nInitChar(n_Znm,(void*) &info);
2389 }
2390 }
2391 // just a module m > 1
2392 else
2393 {
2394 //ringtype = 2;
2395 //const int ch = mpz_get_ui(modBase);
2396 ZnmInfo info;
2397 info.base= modBase;
2398 info.exp= modExponent;
2399 R->cf=nInitChar(n_Zn,(void*) &info);
2400 }
2401 mpz_clear(modBase);
2402}
@ n_Znm
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
@ n_Z2m
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
@ n_Z
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
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:551
#define mpz_sgn1(A)
Definition: si_gmp.h:18

◆ rComposeVar()

static BOOLEAN rComposeVar ( const lists  L,
ring  R 
)
inlinestatic

Definition at line 2446 of file ipshell.cc.

2447{
2448 assume(R!=NULL);
2449 if (L->m[1].Typ()==LIST_CMD)
2450 {
2451 lists v=(lists)L->m[1].Data();
2452 R->N = v->nr+1;
2453 if (R->N<=0)
2454 {
2455 WerrorS("no ring variables");
2456 return TRUE;
2457 }
2458 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2459 int i;
2460 for(i=0;i<R->N;i++)
2461 {
2462 if (v->m[i].Typ()==STRING_CMD)
2463 R->names[i]=omStrDup((char *)v->m[i].Data());
2464 else if (v->m[i].Typ()==POLY_CMD)
2465 {
2466 poly p=(poly)v->m[i].Data();
2467 int nr=pIsPurePower(p);
2468 if (nr>0)
2469 R->names[i]=omStrDup(currRing->names[nr-1]);
2470 else
2471 {
2472 Werror("var name %d must be a string or a ring variable",i+1);
2473 return TRUE;
2474 }
2475 }
2476 else
2477 {
2478 Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
2479 return TRUE;
2480 }
2481 }
2482 }
2483 else
2484 {
2485 WerrorS("variable must be given as `list`");
2486 return TRUE;
2487 }
2488 return FALSE;
2489}
#define pIsPurePower(p)
Definition: polys.h:248
char * char_ptr
Definition: structs.h:53

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2161 of file ipshell.cc.

2162{
2163 assume( r != NULL );
2164 const coeffs C = r->cf;
2165 assume( C != NULL );
2166
2167 // sanity check: require currRing==r for rings with polynomial data
2168 if ( (r!=currRing) && (
2169 (nCoeff_is_algExt(C) && (C != currRing->cf))
2170 || (r->qideal != NULL)
2171#ifdef HAVE_PLURAL
2172 || (rIsPluralRing(r))
2173#endif
2174 )
2175 )
2176 {
2177 WerrorS("ring with polynomial data must be the base ring or compatible");
2178 return NULL;
2179 }
2180 // 0: char/ cf - ring
2181 // 1: list (var)
2182 // 2: list (ord)
2183 // 3: qideal
2184 // possibly:
2185 // 4: C
2186 // 5: D
2188 if (rIsPluralRing(r))
2189 L->Init(6);
2190 else
2191 L->Init(4);
2192 // ----------------------------------------
2193 // 0: char/ cf - ring
2194 if (rField_is_numeric(r))
2195 {
2196 rDecomposeC(&(L->m[0]),r);
2197 }
2198 else if (rField_is_Ring(r))
2199 {
2200 rDecomposeRing(&(L->m[0]),r);
2201 }
2202 else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2203 {
2204 rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2205 }
2206 else if(rField_is_GF(r))
2207 {
2209 Lc->Init(4);
2210 // char:
2211 Lc->m[0].rtyp=INT_CMD;
2212 Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2213 // var:
2215 Lv->Init(1);
2216 Lv->m[0].rtyp=STRING_CMD;
2217 Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2218 Lc->m[1].rtyp=LIST_CMD;
2219 Lc->m[1].data=(void*)Lv;
2220 // ord:
2222 Lo->Init(1);
2224 Loo->Init(2);
2225 Loo->m[0].rtyp=STRING_CMD;
2226 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2227
2228 intvec *iv=new intvec(1); (*iv)[0]=1;
2229 Loo->m[1].rtyp=INTVEC_CMD;
2230 Loo->m[1].data=(void *)iv;
2231
2232 Lo->m[0].rtyp=LIST_CMD;
2233 Lo->m[0].data=(void*)Loo;
2234
2235 Lc->m[2].rtyp=LIST_CMD;
2236 Lc->m[2].data=(void*)Lo;
2237 // q-ideal:
2238 Lc->m[3].rtyp=IDEAL_CMD;
2239 Lc->m[3].data=(void *)idInit(1,1);
2240 // ----------------------
2241 L->m[0].rtyp=LIST_CMD;
2242 L->m[0].data=(void*)Lc;
2243 }
2244 else if (rField_is_Zp(r) || rField_is_Q(r))
2245 {
2246 L->m[0].rtyp=INT_CMD;
2247 L->m[0].data=(void *)(long)r->cf->ch;
2248 }
2249 else
2250 {
2251 L->m[0].rtyp=CRING_CMD;
2252 L->m[0].data=(void *)r->cf;
2253 r->cf->ref++;
2254 }
2255 // ----------------------------------------
2256 rDecompose_23456(r,L);
2257 return L;
2258}
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:910
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1853
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1729
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1917
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2021
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:400
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:626
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:516
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:522
#define rField_is_Ring(R)
Definition: ring.h:486

◆ rDecompose_23456()

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

Definition at line 2021 of file ipshell.cc.

2022{
2023 // ----------------------------------------
2024 // 1: list (var)
2026 LL->Init(r->N);
2027 int i;
2028 for(i=0; i<r->N; i++)
2029 {
2030 LL->m[i].rtyp=STRING_CMD;
2031 LL->m[i].data=(void *)omStrDup(r->names[i]);
2032 }
2033 L->m[1].rtyp=LIST_CMD;
2034 L->m[1].data=(void *)LL;
2035 // ----------------------------------------
2036 // 2: list (ord)
2038 i=rBlocks(r)-1;
2039 LL->Init(i);
2040 i--;
2041 lists LLL;
2042 for(; i>=0; i--)
2043 {
2044 intvec *iv;
2045 int j;
2046 LL->m[i].rtyp=LIST_CMD;
2048 LLL->Init(2);
2049 LLL->m[0].rtyp=STRING_CMD;
2050 LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2051
2052 if((r->order[i] == ringorder_IS)
2053 || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2054 {
2055 assume( r->block0[i] == r->block1[i] );
2056 const int s = r->block0[i];
2057 assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2058
2059 iv=new intvec(1);
2060 (*iv)[0] = s;
2061 }
2062 else if (r->block1[i]-r->block0[i] >=0 )
2063 {
2064 int bl=j=r->block1[i]-r->block0[i];
2065 if (r->order[i]==ringorder_M)
2066 {
2067 j=(j+1)*(j+1)-1;
2068 bl=j+1;
2069 }
2070 else if (r->order[i]==ringorder_am)
2071 {
2072 j+=r->wvhdl[i][bl+1];
2073 }
2074 iv=new intvec(j+1);
2075 if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2076 {
2077 for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2078 }
2079 else switch (r->order[i])
2080 {
2081 case ringorder_dp:
2082 case ringorder_Dp:
2083 case ringorder_ds:
2084 case ringorder_Ds:
2085 case ringorder_lp:
2086 case ringorder_ls:
2087 case ringorder_rp:
2088 for(;j>=0; j--) (*iv)[j]=1;
2089 break;
2090 default: /* do nothing */;
2091 }
2092 }
2093 else
2094 {
2095 iv=new intvec(1);
2096 }
2097 LLL->m[1].rtyp=INTVEC_CMD;
2098 LLL->m[1].data=(void *)iv;
2099 LL->m[i].data=(void *)LLL;
2100 }
2101 L->m[2].rtyp=LIST_CMD;
2102 L->m[2].data=(void *)LL;
2103 // ----------------------------------------
2104 // 3: qideal
2105 L->m[3].rtyp=IDEAL_CMD;
2106 if (r->qideal==NULL)
2107 L->m[3].data=(void *)idInit(1,1);
2108 else
2109 L->m[3].data=(void *)idCopy(r->qideal);
2110 // ----------------------------------------
2111#ifdef HAVE_PLURAL // NC! in rDecompose
2112 if (rIsPluralRing(r))
2113 {
2114 L->m[4].rtyp=MATRIX_CMD;
2115 L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2116 L->m[5].rtyp=MATRIX_CMD;
2117 L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2118 }
2119#endif
2120}
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
static int rBlocks(const ring r)
Definition: ring.h:569

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1949 of file ipshell.cc.

1950{
1951 assume( C != NULL );
1952
1953 // sanity check: require currRing==r for rings with polynomial data
1954 if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1955 {
1956 WerrorS("ring with polynomial data must be the base ring or compatible");
1957 return TRUE;
1958 }
1959 if (nCoeff_is_numeric(C))
1960 {
1962 }
1963#ifdef HAVE_RINGS
1964 else if (nCoeff_is_Ring(C))
1965 {
1967 }
1968#endif
1969 else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1970 {
1971 rDecomposeCF(res, C->extRing, currRing);
1972 }
1973 else if(nCoeff_is_GF(C))
1974 {
1976 Lc->Init(4);
1977 // char:
1978 Lc->m[0].rtyp=INT_CMD;
1979 Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1980 // var:
1982 Lv->Init(1);
1983 Lv->m[0].rtyp=STRING_CMD;
1984 Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1985 Lc->m[1].rtyp=LIST_CMD;
1986 Lc->m[1].data=(void*)Lv;
1987 // ord:
1989 Lo->Init(1);
1991 Loo->Init(2);
1992 Loo->m[0].rtyp=STRING_CMD;
1993 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1994
1995 intvec *iv=new intvec(1); (*iv)[0]=1;
1996 Loo->m[1].rtyp=INTVEC_CMD;
1997 Loo->m[1].data=(void *)iv;
1998
1999 Lo->m[0].rtyp=LIST_CMD;
2000 Lo->m[0].data=(void*)Loo;
2001
2002 Lc->m[2].rtyp=LIST_CMD;
2003 Lc->m[2].data=(void*)Lo;
2004 // q-ideal:
2005 Lc->m[3].rtyp=IDEAL_CMD;
2006 Lc->m[3].data=(void *)idInit(1,1);
2007 // ----------------------
2008 res->rtyp=LIST_CMD;
2009 res->data=(void*)Lc;
2010 }
2011 else
2012 {
2013 res->rtyp=INT_CMD;
2014 res->data=(void *)(long)C->ch;
2015 }
2016 // ----------------------------------------
2017 return FALSE;
2018}
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:839
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:832
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:778
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:730
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1819
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1889

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2122 of file ipshell.cc.

2123{
2124 assume( r != NULL );
2125 const coeffs C = r->cf;
2126 assume( C != NULL );
2127
2128 // sanity check: require currRing==r for rings with polynomial data
2129 if ( (r!=currRing) && (
2130 (r->qideal != NULL)
2131#ifdef HAVE_PLURAL
2132 || (rIsPluralRing(r))
2133#endif
2134 )
2135 )
2136 {
2137 WerrorS("ring with polynomial data must be the base ring or compatible");
2138 return NULL;
2139 }
2140 // 0: char/ cf - ring
2141 // 1: list (var)
2142 // 2: list (ord)
2143 // 3: qideal
2144 // possibly:
2145 // 4: C
2146 // 5: D
2148 if (rIsPluralRing(r))
2149 L->Init(6);
2150 else
2151 L->Init(4);
2152 // ----------------------------------------
2153 // 0: char/ cf - ring
2154 L->m[0].rtyp=CRING_CMD;
2155 L->m[0].data=(char*)r->cf; r->cf->ref++;
2156 // ----------------------------------------
2157 rDecompose_23456(r,L);
2158 return L;
2159}

◆ rDecomposeC()

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

Definition at line 1853 of file ipshell.cc.

1855{
1857 if (rField_is_long_C(R)) L->Init(3);
1858 else L->Init(2);
1859 h->rtyp=LIST_CMD;
1860 h->data=(void *)L;
1861 // 0: char/ cf - ring
1862 // 1: list (var)
1863 // 2: list (ord)
1864 // ----------------------------------------
1865 // 0: char/ cf - ring
1866 L->m[0].rtyp=INT_CMD;
1867 L->m[0].data=(void *)0;
1868 // ----------------------------------------
1869 // 1:
1871 LL->Init(2);
1872 LL->m[0].rtyp=INT_CMD;
1873 LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1874 LL->m[1].rtyp=INT_CMD;
1875 LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1876 L->m[1].rtyp=LIST_CMD;
1877 L->m[1].data=(void *)LL;
1878 // ----------------------------------------
1879 // 2: list (par)
1880 if (rField_is_long_C(R))
1881 {
1882 L->m[2].rtyp=STRING_CMD;
1883 L->m[2].data=(void *)omStrDup(*rParameter(R));
1884 }
1885 // ----------------------------------------
1886}

◆ rDecomposeC_41()

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

Definition at line 1819 of file ipshell.cc.

1821{
1823 if (nCoeff_is_long_C(C)) L->Init(3);
1824 else L->Init(2);
1825 h->rtyp=LIST_CMD;
1826 h->data=(void *)L;
1827 // 0: char/ cf - ring
1828 // 1: list (var)
1829 // 2: list (ord)
1830 // ----------------------------------------
1831 // 0: char/ cf - ring
1832 L->m[0].rtyp=INT_CMD;
1833 L->m[0].data=(void *)0;
1834 // ----------------------------------------
1835 // 1:
1837 LL->Init(2);
1838 LL->m[0].rtyp=INT_CMD;
1839 LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1840 LL->m[1].rtyp=INT_CMD;
1841 LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1842 L->m[1].rtyp=LIST_CMD;
1843 L->m[1].data=(void *)LL;
1844 // ----------------------------------------
1845 // 2: list (par)
1846 if (nCoeff_is_long_C(C))
1847 {
1848 L->m[2].rtyp=STRING_CMD;
1849 L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1850 }
1851 // ----------------------------------------
1852}
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:894

◆ rDecomposeCF()

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

Definition at line 1729 of file ipshell.cc.

1730{
1732 L->Init(4);
1733 h->rtyp=LIST_CMD;
1734 h->data=(void *)L;
1735 // 0: char/ cf - ring
1736 // 1: list (var)
1737 // 2: list (ord)
1738 // 3: qideal
1739 // ----------------------------------------
1740 // 0: char/ cf - ring
1741 L->m[0].rtyp=INT_CMD;
1742 L->m[0].data=(void *)(long)r->cf->ch;
1743 // ----------------------------------------
1744 // 1: list (var)
1746 LL->Init(r->N);
1747 int i;
1748 for(i=0; i<r->N; i++)
1749 {
1750 LL->m[i].rtyp=STRING_CMD;
1751 LL->m[i].data=(void *)omStrDup(r->names[i]);
1752 }
1753 L->m[1].rtyp=LIST_CMD;
1754 L->m[1].data=(void *)LL;
1755 // ----------------------------------------
1756 // 2: list (ord)
1758 i=rBlocks(r)-1;
1759 LL->Init(i);
1760 i--;
1761 lists LLL;
1762 for(; i>=0; i--)
1763 {
1764 intvec *iv;
1765 int j;
1766 LL->m[i].rtyp=LIST_CMD;
1768 LLL->Init(2);
1769 LLL->m[0].rtyp=STRING_CMD;
1770 LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1771 if (r->block1[i]-r->block0[i] >=0 )
1772 {
1773 j=r->block1[i]-r->block0[i];
1774 if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1775 iv=new intvec(j+1);
1776 if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1777 {
1778 for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1779 }
1780 else switch (r->order[i])
1781 {
1782 case ringorder_dp:
1783 case ringorder_Dp:
1784 case ringorder_ds:
1785 case ringorder_Ds:
1786 case ringorder_lp:
1787 case ringorder_rp:
1788 case ringorder_ls:
1789 for(;j>=0; j--) (*iv)[j]=1;
1790 break;
1791 default: /* do nothing */;
1792 }
1793 }
1794 else
1795 {
1796 iv=new intvec(1);
1797 }
1798 LLL->m[1].rtyp=INTVEC_CMD;
1799 LLL->m[1].data=(void *)iv;
1800 LL->m[i].data=(void *)LLL;
1801 }
1802 L->m[2].rtyp=LIST_CMD;
1803 L->m[2].data=(void *)LL;
1804 // ----------------------------------------
1805 // 3: qideal
1806 L->m[3].rtyp=IDEAL_CMD;
1807 if (nCoeff_is_transExt(R->cf))
1808 L->m[3].data=(void *)idInit(1,1);
1809 else
1810 {
1811 ideal q=idInit(IDELEMS(r->qideal));
1812 q->m[0]=p_Init(R);
1813 pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1814 L->m[3].data=(void *)q;
1815// I->m[0] = pNSet(R->minpoly);
1816 }
1817 // ----------------------------------------
1818}
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:918
#define pSetCoeff0(p, n)
Definition: monomials.h:59
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1322

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1917 of file ipshell.cc.

1919{
1920#ifdef HAVE_RINGS
1922 if (rField_is_Z(R)) L->Init(1);
1923 else L->Init(2);
1924 h->rtyp=LIST_CMD;
1925 h->data=(void *)L;
1926 // 0: char/ cf - ring
1927 // 1: list (module)
1928 // ----------------------------------------
1929 // 0: char/ cf - ring
1930 L->m[0].rtyp=STRING_CMD;
1931 L->m[0].data=(void *)omStrDup("integer");
1932 // ----------------------------------------
1933 // 1: module
1934 if (rField_is_Z(R)) return;
1936 LL->Init(2);
1937 LL->m[0].rtyp=BIGINT_CMD;
1938 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1939 LL->m[1].rtyp=INT_CMD;
1940 LL->m[1].data=(void *) R->cf->modExponent;
1941 L->m[1].rtyp=LIST_CMD;
1942 L->m[1].data=(void *)LL;
1943#else
1944 WerrorS("rDecomposeRing");
1945#endif
1946}
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:542
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:510

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1889 of file ipshell.cc.

1891{
1893 if (nCoeff_is_Ring(C)) L->Init(1);
1894 else L->Init(2);
1895 h->rtyp=LIST_CMD;
1896 h->data=(void *)L;
1897 // 0: char/ cf - ring
1898 // 1: list (module)
1899 // ----------------------------------------
1900 // 0: char/ cf - ring
1901 L->m[0].rtyp=STRING_CMD;
1902 L->m[0].data=(void *)omStrDup("integer");
1903 // ----------------------------------------
1904 // 1: modulo
1905 if (nCoeff_is_Z(C)) return;
1907 LL->Init(2);
1908 LL->m[0].rtyp=BIGINT_CMD;
1909 LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1910 LL->m[1].rtyp=INT_CMD;
1911 LL->m[1].data=(void *) C->modExponent;
1912 L->m[1].rtyp=LIST_CMD;
1913 L->m[1].data=(void *)LL;
1914}
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:816

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1644 of file ipshell.cc.

1645{
1646 idhdl tmp=NULL;
1647
1648 if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1649 if (tmp==NULL) return NULL;
1650
1651// if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1653 {
1655 }
1656
1657 ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1658
1659 #ifndef TEST_ZN_AS_ZP
1660 r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1661 #else
1662 mpz_t modBase;
1663 mpz_init_set_ui(modBase, (long)32003);
1664 ZnmInfo info;
1665 info.base= modBase;
1666 info.exp= 1;
1667 r->cf=nInitChar(n_Zn,(void*) &info);
1668 r->cf->is_field=1;
1669 r->cf->is_domain=1;
1670 r->cf->has_simple_Inverse=1;
1671 #endif
1672 r->N = 3;
1673 /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1674 /*names*/
1675 r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1676 r->names[0] = omStrDup("x");
1677 r->names[1] = omStrDup("y");
1678 r->names[2] = omStrDup("z");
1679 /*weights: entries for 3 blocks: NULL*/
1680 r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1681 /*order: dp,C,0*/
1682 r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1683 r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1684 r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1685 /* ringorder dp for the first block: var 1..3 */
1686 r->order[0] = ringorder_dp;
1687 r->block0[0] = 1;
1688 r->block1[0] = 3;
1689 /* ringorder C for the second block: no vars */
1690 r->order[1] = ringorder_C;
1691 /* the last block: everything is 0 */
1692 r->order[2] = (rRingOrder_t)0;
1693
1694 /* complete ring intializations */
1695 rComplete(r);
1696 rSetHdl(tmp);
1697 return currRingHdl;
1698}
BOOLEAN RingDependend()
Definition: subexpr.cc:418

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1701 of file ipshell.cc.

1702{
1703 if ((r==NULL)||(r->VarOffset==NULL))
1704 return NULL;
1706 if (h!=NULL) return h;
1707 if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1708 if (h!=NULL) return h;
1710 while(p!=NULL)
1711 {
1712 if ((p->cPack!=basePack)
1713 && (p->cPack!=currPack))
1714 h=rSimpleFindHdl(r,p->cPack->idroot,n);
1715 if (h!=NULL) return h;
1716 p=p->next;
1717 }
1718 idhdl tmp=basePack->idroot;
1719 while (tmp!=NULL)
1720 {
1721 if (IDTYP(tmp)==PACKAGE_CMD)
1722 h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1723 if (h!=NULL) return h;
1724 tmp=IDNEXT(tmp);
1725 }
1726 return NULL;
1727}
Definition: ipid.h:56
VAR proclevel * procstack
Definition: ipid.cc:52
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6259

◆ rInit()

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

Definition at line 5624 of file ipshell.cc.

5625{
5626 int float_len=0;
5627 int float_len2=0;
5628 ring R = NULL;
5629 //BOOLEAN ffChar=FALSE;
5630
5631 /* ch -------------------------------------------------------*/
5632 // get ch of ground field
5633
5634 // allocated ring
5635 R = (ring) omAlloc0Bin(sip_sring_bin);
5636
5637 coeffs cf = NULL;
5638
5639 assume( pn != NULL );
5640 const int P = pn->listLength();
5641
5642 if (pn->Typ()==CRING_CMD)
5643 {
5644 cf=(coeffs)pn->CopyD();
5645 leftv pnn=pn;
5646 if(P>1) /*parameter*/
5647 {
5648 pnn = pnn->next;
5649 const int pars = pnn->listLength();
5650 assume( pars > 0 );
5651 char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5652
5653 if (rSleftvList2StringArray(pnn, names))
5654 {
5655 WerrorS("parameter expected");
5656 goto rInitError;
5657 }
5658
5659 TransExtInfo extParam;
5660
5661 extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5662 for(int i=pars-1; i>=0;i--)
5663 {
5664 omFree(names[i]);
5665 }
5666 omFree(names);
5667
5668 cf = nInitChar(n_transExt, &extParam);
5669 }
5670 assume( cf != NULL );
5671 }
5672 else if (pn->Typ()==INT_CMD)
5673 {
5674 int ch = (int)(long)pn->Data();
5675 leftv pnn=pn;
5676
5677 /* parameter? -------------------------------------------------------*/
5678 pnn = pnn->next;
5679
5680 if (pnn == NULL) // no params!?
5681 {
5682 if (ch!=0)
5683 {
5684 int ch2=IsPrime(ch);
5685 if ((ch<2)||(ch!=ch2))
5686 {
5687 Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5688 ch=32003;
5689 }
5690 #ifndef TEST_ZN_AS_ZP
5691 cf = nInitChar(n_Zp, (void*)(long)ch);
5692 #else
5693 mpz_t modBase;
5694 mpz_init_set_ui(modBase, (long)ch);
5695 ZnmInfo info;
5696 info.base= modBase;
5697 info.exp= 1;
5698 cf=nInitChar(n_Zn,(void*) &info);
5699 cf->is_field=1;
5700 cf->is_domain=1;
5701 cf->has_simple_Inverse=1;
5702 #endif
5703 }
5704 else
5705 cf = nInitChar(n_Q, (void*)(long)ch);
5706 }
5707 else
5708 {
5709 const int pars = pnn->listLength();
5710
5711 assume( pars > 0 );
5712
5713 // predefined finite field: (p^k, a)
5714 if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5715 {
5716 GFInfo param;
5717
5718 param.GFChar = ch;
5719 param.GFDegree = 1;
5720 param.GFPar_name = pnn->name;
5721
5722 cf = nInitChar(n_GF, &param);
5723 }
5724 else // (0/p, a, b, ..., z)
5725 {
5726 if ((ch!=0) && (ch!=IsPrime(ch)))
5727 {
5728 WerrorS("too many parameters");
5729 goto rInitError;
5730 }
5731
5732 char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5733
5734 if (rSleftvList2StringArray(pnn, names))
5735 {
5736 WerrorS("parameter expected");
5737 goto rInitError;
5738 }
5739
5740 TransExtInfo extParam;
5741
5742 extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5743 for(int i=pars-1; i>=0;i--)
5744 {
5745 omFree(names[i]);
5746 }
5747 omFree(names);
5748
5749 cf = nInitChar(n_transExt, &extParam);
5750 }
5751 }
5752
5753 //if (cf==NULL) ->Error: Invalid ground field specification
5754 }
5755 else if ((pn->name != NULL)
5756 && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5757 {
5758 leftv pnn=pn->next;
5759 BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5760 if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5761 {
5762 float_len=(int)(long)pnn->Data();
5763 float_len2=float_len;
5764 pnn=pnn->next;
5765 if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5766 {
5767 float_len2=(int)(long)pnn->Data();
5768 pnn=pnn->next;
5769 }
5770 }
5771
5772 if (!complex_flag)
5773 complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5774 if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5775 cf=nInitChar(n_R, NULL);
5776 else // longR or longC?
5777 {
5778 LongComplexInfo param;
5779
5780 param.float_len = si_min (float_len, 32767);
5781 param.float_len2 = si_min (float_len2, 32767);
5782
5783 // set the parameter name
5784 if (complex_flag)
5785 {
5786 if (param.float_len < SHORT_REAL_LENGTH)
5787 {
5790 }
5791 if ((pnn == NULL) || (pnn->name == NULL))
5792 param.par_name=(const char*)"i"; //default to i
5793 else
5794 param.par_name = (const char*)pnn->name;
5795 }
5796
5797 cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5798 }
5799 assume( cf != NULL );
5800 }
5801#ifdef HAVE_RINGS
5802 else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5803 {
5804 // TODO: change to use coeffs_BIGINT!?
5805 mpz_t modBase;
5806 unsigned int modExponent = 1;
5807 mpz_init_set_si(modBase, 0);
5808 if (pn->next!=NULL)
5809 {
5810 leftv pnn=pn;
5811 if (pnn->next->Typ()==INT_CMD)
5812 {
5813 pnn=pnn->next;
5814 mpz_set_ui(modBase, (long) pnn->Data());
5815 if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5816 {
5817 pnn=pnn->next;
5818 modExponent = (long) pnn->Data();
5819 }
5820 while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5821 {
5822 pnn=pnn->next;
5823 mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5824 }
5825 }
5826 else if (pnn->next->Typ()==BIGINT_CMD)
5827 {
5828 number p=(number)pnn->next->CopyD();
5829 n_MPZ(modBase,p,coeffs_BIGINT);
5831 }
5832 }
5833 else
5835
5836 if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5837 {
5838 WerrorS("Wrong ground ring specification (module is 1)");
5839 goto rInitError;
5840 }
5841 if (modExponent < 1)
5842 {
5843 WerrorS("Wrong ground ring specification (exponent smaller than 1");
5844 goto rInitError;
5845 }
5846 // module is 0 ---> integers ringtype = 4;
5847 // we have an exponent
5848 if (modExponent > 1 && cf == NULL)
5849 {
5850 if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5851 {
5852 /* this branch should be active for modExponent = 2..32 resp. 2..64,
5853 depending on the size of a long on the respective platform */
5854 //ringtype = 1; // Use Z/2^ch
5855 cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5856 }
5857 else
5858 {
5859 if (mpz_sgn1(modBase)==0)
5860 {
5861 WerrorS("modulus must not be 0 or parameter not allowed");
5862 goto rInitError;
5863 }
5864 //ringtype = 3;
5865 ZnmInfo info;
5866 info.base= modBase;
5867 info.exp= modExponent;
5868 cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5869 }
5870 }
5871 // just a module m > 1
5872 else if (cf == NULL)
5873 {
5874 if (mpz_sgn1(modBase)==0)
5875 {
5876 WerrorS("modulus must not be 0 or parameter not allowed");
5877 goto rInitError;
5878 }
5879 //ringtype = 2;
5880 ZnmInfo info;
5881 info.base= modBase;
5882 info.exp= modExponent;
5883 cf=nInitChar(n_Zn,(void*) &info);
5884 }
5885 assume( cf != NULL );
5886 mpz_clear(modBase);
5887 }
5888#endif
5889 // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5890 else if ((pn->Typ()==RING_CMD) && (P == 1))
5891 {
5892 TransExtInfo extParam;
5893 extParam.r = (ring)pn->Data();
5894 extParam.r->ref++;
5895 cf = nInitChar(n_transExt, &extParam);
5896 }
5897 //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5898 //{
5899 // AlgExtInfo extParam;
5900 // extParam.r = (ring)pn->Data();
5901
5902 // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5903 //}
5904 else
5905 {
5906 WerrorS("Wrong or unknown ground field specification");
5907#if 0
5908// debug stuff for unknown cf descriptions:
5909 sleftv* p = pn;
5910 while (p != NULL)
5911 {
5912 Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5913 PrintLn();
5914 p = p->next;
5915 }
5916#endif
5917 goto rInitError;
5918 }
5919
5920 /*every entry in the new ring is initialized to 0*/
5921
5922 /* characteristic -----------------------------------------------*/
5923 /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5924 * 0 1 : Q(a,...) *names FALSE
5925 * 0 -1 : R NULL FALSE 0
5926 * 0 -1 : R NULL FALSE prec. >6
5927 * 0 -1 : C *names FALSE prec. 0..?
5928 * p p : Fp NULL FALSE
5929 * p -p : Fp(a) *names FALSE
5930 * q q : GF(q=p^n) *names TRUE
5931 */
5932 if (cf==NULL)
5933 {
5934 WerrorS("Invalid ground field specification");
5935 goto rInitError;
5936// const int ch=32003;
5937// cf=nInitChar(n_Zp, (void*)(long)ch);
5938 }
5939
5940 assume( R != NULL );
5941
5942 R->cf = cf;
5943
5944 /* names and number of variables-------------------------------------*/
5945 {
5946 int l=rv->listLength();
5947
5948 if (l>MAX_SHORT)
5949 {
5950 Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5951 goto rInitError;
5952 }
5953 R->N = l; /*rv->listLength();*/
5954 }
5955 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5956 if (rSleftvList2StringArray(rv, R->names))
5957 {
5958 WerrorS("name of ring variable expected");
5959 goto rInitError;
5960 }
5961
5962 /* check names and parameters for conflicts ------------------------- */
5963 rRenameVars(R); // conflicting variables will be renamed
5964 /* ordering -------------------------------------------------------------*/
5965 if (rSleftvOrdering2Ordering(ord, R))
5966 goto rInitError;
5967
5968 // Complete the initialization
5969 if (rComplete(R,1))
5970 goto rInitError;
5971
5972/*#ifdef HAVE_RINGS
5973// currently, coefficients which are ring elements require a global ordering:
5974 if (rField_is_Ring(R) && (R->OrdSgn==-1))
5975 {
5976 WerrorS("global ordering required for these coefficients");
5977 goto rInitError;
5978 }
5979#endif*/
5980
5981 rTest(R);
5982
5983 // try to enter the ring into the name list
5984 // need to clean up sleftv here, before this ring can be set to
5985 // new currRing or currRing can be killed beacuse new ring has
5986 // same name
5987 pn->CleanUp();
5988 rv->CleanUp();
5989 ord->CleanUp();
5990 //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5991 // goto rInitError;
5992
5993 //memcpy(IDRING(tmp),R,sizeof(*R));
5994 // set current ring
5995 //omFreeBin(R, ip_sring_bin);
5996 //return tmp;
5997 return R;
5998
5999 // error case:
6000 rInitError:
6001 if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6002 pn->CleanUp();
6003 rv->CleanUp();
6004 ord->CleanUp();
6005 return NULL;
6006}
CanonicalForm cf
Definition: cfModGcd.cc:4083
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
const short MAX_SHORT
Definition: ipshell.cc:5612
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5304
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5576
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:450
#define rTest(r)
Definition: ring.h:786

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6216 of file ipshell.cc.

6217{
6218 ring r = IDRING(h);
6219 int ref=0;
6220 if (r!=NULL)
6221 {
6222 // avoid, that sLastPrinted is the last reference to the base ring:
6223 // clean up before killing the last "named" refrence:
6225 && (sLastPrinted.data==(void*)r))
6226 {
6228 }
6229 ref=r->ref;
6230 if ((ref<=0)&&(r==currRing))
6231 {
6232 // cleanup DENOMINATOR_LIST
6234 {
6236 if (TEST_V_ALLWARN)
6237 Warn("deleting denom_list for ring change from %s",IDID(h));
6238 do
6239 {
6240 n_Delete(&(dd->n),currRing->cf);
6241 dd=dd->next;
6244 } while(DENOMINATOR_LIST!=NULL);
6245 }
6246 }
6247 rKill(r);
6248 }
6249 if (h==currRingHdl)
6250 {
6251 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6252 else
6253 {
6255 }
6256 }
6257}
void rKill(ring r)
Definition: ipshell.cc:6170
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6170 of file ipshell.cc.

6171{
6172 if ((r->ref<=0)&&(r->order!=NULL))
6173 {
6174#ifdef RDEBUG
6175 if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6176#endif
6177 int j;
6178 for (j=0;j<myynest;j++)
6179 {
6180 if (iiLocalRing[j]==r)
6181 {
6182 if (j==0) WarnS("killing the basering for level 0");
6184 }
6185 }
6186// any variables depending on r ?
6187 while (r->idroot!=NULL)
6188 {
6189 r->idroot->lev=myynest; // avoid warning about kill global objects
6190 killhdl2(r->idroot,&(r->idroot),r);
6191 }
6192 if (r==currRing)
6193 {
6194 // all dependend stuff is done, clean global vars:
6195 if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6197 {
6199 }
6200 //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6201 //{
6202 // WerrorS("return value depends on local ring variable (export missing ?)");
6203 // iiRETURNEXPR.CleanUp();
6204 //}
6205 currRing=NULL;
6207 }
6208
6209 /* nKillChar(r); will be called from inside of rDelete */
6210 rDelete(r);
6211 return;
6212 }
6213 rDecRefCnt(r);
6214}
#define pDelete(p_ptr)
Definition: polys.h:186

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5185 of file ipshell.cc.

5186{
5187 // change some bad orderings/combination into better ones
5188 leftv h=ord;
5189 while(h!=NULL)
5190 {
5191 BOOLEAN change=FALSE;
5192 intvec *iv = (intvec *)(h->data);
5193 // ws(-i) -> wp(i)
5194 if ((*iv)[1]==ringorder_ws)
5195 {
5196 BOOLEAN neg=TRUE;
5197 for(int i=2;i<iv->length();i++)
5198 if((*iv)[i]>=0) { neg=FALSE; break; }
5199 if (neg)
5200 {
5201 (*iv)[1]=ringorder_wp;
5202 for(int i=2;i<iv->length();i++)
5203 (*iv)[i]= - (*iv)[i];
5204 change=TRUE;
5205 }
5206 }
5207 // Ws(-i) -> Wp(i)
5208 if ((*iv)[1]==ringorder_Ws)
5209 {
5210 BOOLEAN neg=TRUE;
5211 for(int i=2;i<iv->length();i++)
5212 if((*iv)[i]>=0) { neg=FALSE; break; }
5213 if (neg)
5214 {
5215 (*iv)[1]=ringorder_Wp;
5216 for(int i=2;i<iv->length();i++)
5217 (*iv)[i]= -(*iv)[i];
5218 change=TRUE;
5219 }
5220 }
5221 // wp(1) -> dp
5222 if ((*iv)[1]==ringorder_wp)
5223 {
5224 BOOLEAN all_one=TRUE;
5225 for(int i=2;i<iv->length();i++)
5226 if((*iv)[i]!=1) { all_one=FALSE; break; }
5227 if (all_one)
5228 {
5229 intvec *iv2=new intvec(3);
5230 (*iv2)[0]=1;
5231 (*iv2)[1]=ringorder_dp;
5232 (*iv2)[2]=iv->length()-2;
5233 delete iv;
5234 iv=iv2;
5235 h->data=iv2;
5236 change=TRUE;
5237 }
5238 }
5239 // Wp(1) -> Dp
5240 if ((*iv)[1]==ringorder_Wp)
5241 {
5242 BOOLEAN all_one=TRUE;
5243 for(int i=2;i<iv->length();i++)
5244 if((*iv)[i]!=1) { all_one=FALSE; break; }
5245 if (all_one)
5246 {
5247 intvec *iv2=new intvec(3);
5248 (*iv2)[0]=1;
5249 (*iv2)[1]=ringorder_Dp;
5250 (*iv2)[2]=iv->length()-2;
5251 delete iv;
5252 iv=iv2;
5253 h->data=iv2;
5254 change=TRUE;
5255 }
5256 }
5257 // dp(1)/Dp(1)/rp(1) -> lp(1)
5258 if (((*iv)[1]==ringorder_dp)
5259 || ((*iv)[1]==ringorder_Dp)
5260 || ((*iv)[1]==ringorder_rp))
5261 {
5262 if (iv->length()==3)
5263 {
5264 if ((*iv)[2]==1)
5265 {
5266 if(h->next!=NULL)
5267 {
5268 intvec *iv2 = (intvec *)(h->next->data);
5269 if ((*iv2)[1]==ringorder_lp)
5270 {
5271 (*iv)[1]=ringorder_lp;
5272 change=TRUE;
5273 }
5274 }
5275 }
5276 }
5277 }
5278 // lp(i),lp(j) -> lp(i+j)
5279 if(((*iv)[1]==ringorder_lp)
5280 && (h->next!=NULL))
5281 {
5282 intvec *iv2 = (intvec *)(h->next->data);
5283 if ((*iv2)[1]==ringorder_lp)
5284 {
5285 leftv hh=h->next;
5286 h->next=hh->next;
5287 hh->next=NULL;
5288 if ((*iv2)[0]==1)
5289 (*iv)[2] += 1; // last block unspecified, at least 1
5290 else
5291 (*iv)[2] += (*iv2)[2];
5292 hh->CleanUp();
5294 change=TRUE;
5295 }
5296 }
5297 // -------------------
5298 if (!change) h=h->next;
5299 }
5300 return ord;
5301}

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2405 of file ipshell.cc.

2406{
2407 int i,j;
2408 BOOLEAN ch;
2409 do
2410 {
2411 ch=0;
2412 for(i=0;i<R->N-1;i++)
2413 {
2414 for(j=i+1;j<R->N;j++)
2415 {
2416 if (strcmp(R->names[i],R->names[j])==0)
2417 {
2418 ch=TRUE;
2419 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);
2420 omFree(R->names[j]);
2421 R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2422 sprintf(R->names[j],"@%s",R->names[i]);
2423 }
2424 }
2425 }
2426 }
2427 while (ch);
2428 for(i=0;i<rPar(R); i++)
2429 {
2430 for(j=0;j<R->N;j++)
2431 {
2432 if (strcmp(rParameter(R)[i],R->names[j])==0)
2433 {
2434 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);
2435// omFree(rParameter(R)[i]);
2436// rParameter(R)[i]=(char *)omAlloc(10);
2437// sprintf(rParameter(R)[i],"@@(%d)",i+1);
2438 omFree(R->names[j]);
2439 R->names[j]=(char *)omAlloc(10);
2440 sprintf(R->names[j],"@@(%d)",i+1);
2441 }
2442 }
2443 }
2444}

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5125 of file ipshell.cc.

5126{
5127 ring rg = NULL;
5128 if (h!=NULL)
5129 {
5130// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5131 rg = IDRING(h);
5132 if (rg==NULL) return; //id <>NULL, ring==NULL
5133 omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5134 if (IDID(h)) // OB: ????
5136 rTest(rg);
5137 }
5138 else return;
5139
5140 // clean up history
5141 if (currRing!=NULL)
5142 {
5144 {
5146 }
5147
5148 if (rg!=currRing)/*&&(currRing!=NULL)*/
5149 {
5150 if (rg->cf!=currRing->cf)
5151 {
5154 {
5155 if (TEST_V_ALLWARN)
5156 Warn("deleting denom_list for ring change to %s",IDID(h));
5157 do
5158 {
5159 n_Delete(&(dd->n),currRing->cf);
5160 dd=dd->next;
5163 } while(DENOMINATOR_LIST!=NULL);
5164 }
5165 }
5166 }
5167 }
5168
5169 // test for valid "currRing":
5170 if ((rg!=NULL) && (rg->idroot==NULL))
5171 {
5172 ring old=rg;
5173 rg=rAssure_HasComp(rg);
5174 if (old!=rg)
5175 {
5176 rKill(old);
5177 IDRING(h)=rg;
5178 }
5179 }
5180 /*------------ change the global ring -----------------------*/
5181 rChangeCurrRing(rg);
5182 currRingHdl = h;
5183}
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4705

◆ rSimpleFindHdl()

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

Definition at line 6259 of file ipshell.cc.

6260{
6261 idhdl h=root;
6262 while (h!=NULL)
6263 {
6264 if ((IDTYP(h)==RING_CMD)
6265 && (h!=n)
6266 && (IDRING(h)==r)
6267 )
6268 {
6269 return h;
6270 }
6271 h=IDNEXT(h);
6272 }
6273 return NULL;
6274}

◆ rSleftvList2StringArray()

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

Definition at line 5576 of file ipshell.cc.

5577{
5578
5579 while(sl!=NULL)
5580 {
5581 if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5582 {
5583 *p = omStrDup(sl->Name());
5584 }
5585 else if (sl->name!=NULL)
5586 {
5587 *p = (char*)sl->name;
5588 sl->name=NULL;
5589 }
5590 else if (sl->rtyp==POLY_CMD)
5591 {
5592 sleftv s_sl;
5593 iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5594 if (s_sl.name != NULL)
5595 {
5596 *p = (char*)s_sl.name; s_sl.name=NULL;
5597 }
5598 else
5599 *p = NULL;
5600 sl->next = s_sl.next;
5601 s_sl.next = NULL;
5602 s_sl.CleanUp();
5603 if (*p == NULL) return TRUE;
5604 }
5605 else return TRUE;
5606 p++;
5607 sl=sl->next;
5608 }
5609 return FALSE;
5610}

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5304 of file ipshell.cc.

5305{
5306 int last = 0, o=0, n = 1, i=0, typ = 1, j;
5307 ord=rOptimizeOrdAsSleftv(ord);
5308 sleftv *sl = ord;
5309
5310 // determine nBlocks
5311 while (sl!=NULL)
5312 {
5313 intvec *iv = (intvec *)(sl->data);
5314 if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5315 i++;
5316 else if ((*iv)[1]==ringorder_L)
5317 {
5318 R->wanted_maxExp=(*iv)[2]*2+1;
5319 n--;
5320 }
5321 else if (((*iv)[1]!=ringorder_a)
5322 && ((*iv)[1]!=ringorder_a64)
5323 && ((*iv)[1]!=ringorder_am))
5324 o++;
5325 n++;
5326 sl=sl->next;
5327 }
5328 // check whether at least one real ordering
5329 if (o==0)
5330 {
5331 WerrorS("invalid combination of orderings");
5332 return TRUE;
5333 }
5334 // if no c/C ordering is given, increment n
5335 if (i==0) n++;
5336 else if (i != 1)
5337 {
5338 // throw error if more than one is given
5339 WerrorS("more than one ordering c/C specified");
5340 return TRUE;
5341 }
5342
5343 // initialize fields of R
5344 R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5345 R->block0=(int *)omAlloc0(n*sizeof(int));
5346 R->block1=(int *)omAlloc0(n*sizeof(int));
5347 R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5348
5349 int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5350
5351 // init order, so that rBlocks works correctly
5352 for (j=0; j < n-1; j++)
5353 R->order[j] = ringorder_unspec;
5354 // set last _C order, if no c/C order was given
5355 if (i == 0) R->order[n-2] = ringorder_C;
5356
5357 /* init orders */
5358 sl=ord;
5359 n=-1;
5360 while (sl!=NULL)
5361 {
5362 intvec *iv;
5363 iv = (intvec *)(sl->data);
5364 if ((*iv)[1]!=ringorder_L)
5365 {
5366 n++;
5367
5368 /* the format of an ordering:
5369 * iv[0]: factor
5370 * iv[1]: ordering
5371 * iv[2..end]: weights
5372 */
5373 R->order[n] = (rRingOrder_t)((*iv)[1]);
5374 typ=1;
5375 switch ((*iv)[1])
5376 {
5377 case ringorder_ws:
5378 case ringorder_Ws:
5379 typ=-1; // and continue
5380 case ringorder_wp:
5381 case ringorder_Wp:
5382 R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5383 R->block0[n] = last+1;
5384 for (i=2; i<iv->length(); i++)
5385 {
5386 R->wvhdl[n][i-2] = (*iv)[i];
5387 last++;
5388 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5389 }
5390 R->block1[n] = si_min(last,R->N);
5391 break;
5392 case ringorder_ls:
5393 case ringorder_ds:
5394 case ringorder_Ds:
5395 case ringorder_rs:
5396 typ=-1; // and continue
5397 case ringorder_lp:
5398 case ringorder_dp:
5399 case ringorder_Dp:
5400 case ringorder_rp:
5401 R->block0[n] = last+1;
5402 if (iv->length() == 3) last+=(*iv)[2];
5403 else last += (*iv)[0];
5404 R->block1[n] = si_min(last,R->N);
5405 if (rCheckIV(iv)) return TRUE;
5406 for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5407 {
5408 if (weights[i]==0) weights[i]=typ;
5409 }
5410 break;
5411
5412 case ringorder_s: // no 'rank' params!
5413 {
5414
5415 if(iv->length() > 3)
5416 return TRUE;
5417
5418 if(iv->length() == 3)
5419 {
5420 const int s = (*iv)[2];
5421 R->block0[n] = s;
5422 R->block1[n] = s;
5423 }
5424 break;
5425 }
5426 case ringorder_IS:
5427 {
5428 if(iv->length() != 3) return TRUE;
5429
5430 const int s = (*iv)[2];
5431
5432 if( 1 < s || s < -1 ) return TRUE;
5433
5434 R->block0[n] = s;
5435 R->block1[n] = s;
5436 break;
5437 }
5438 case ringorder_S:
5439 case ringorder_c:
5440 case ringorder_C:
5441 {
5442 if (rCheckIV(iv)) return TRUE;
5443 break;
5444 }
5445 case ringorder_aa:
5446 case ringorder_a:
5447 {
5448 R->block0[n] = last+1;
5449 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5450 R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5451 for (i=2; i<iv->length(); i++)
5452 {
5453 R->wvhdl[n][i-2]=(*iv)[i];
5454 last++;
5455 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5456 }
5457 last=R->block0[n]-1;
5458 break;
5459 }
5460 case ringorder_am:
5461 {
5462 R->block0[n] = last+1;
5463 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5464 R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5465 if (R->block1[n]- R->block0[n]+2>=iv->length())
5466 WarnS("missing module weights");
5467 for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5468 {
5469 R->wvhdl[n][i-2]=(*iv)[i];
5470 last++;
5471 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5472 }
5473 R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5474 for (; i<iv->length(); i++)
5475 {
5476 R->wvhdl[n][i-1]=(*iv)[i];
5477 }
5478 last=R->block0[n]-1;
5479 break;
5480 }
5481 case ringorder_a64:
5482 {
5483 R->block0[n] = last+1;
5484 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5485 R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5486 int64 *w=(int64 *)R->wvhdl[n];
5487 for (i=2; i<iv->length(); i++)
5488 {
5489 w[i-2]=(*iv)[i];
5490 last++;
5491 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5492 }
5493 last=R->block0[n]-1;
5494 break;
5495 }
5496 case ringorder_M:
5497 {
5498 int Mtyp=rTypeOfMatrixOrder(iv);
5499 if (Mtyp==0) return TRUE;
5500 if (Mtyp==-1) typ = -1;
5501
5502 R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5503 for (i=2; i<iv->length();i++)
5504 R->wvhdl[n][i-2]=(*iv)[i];
5505
5506 R->block0[n] = last+1;
5507 last += (int)sqrt((double)(iv->length()-2));
5508 R->block1[n] = si_min(last,R->N);
5509 for(i=R->block1[n];i>=R->block0[n];i--)
5510 {
5511 if (weights[i]==0) weights[i]=typ;
5512 }
5513 break;
5514 }
5515
5516 case ringorder_no:
5517 R->order[n] = ringorder_unspec;
5518 return TRUE;
5519
5520 default:
5521 Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5522 R->order[n] = ringorder_unspec;
5523 return TRUE;
5524 }
5525 }
5526 if (last>R->N)
5527 {
5528 Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5529 R->N,last);
5530 return TRUE;
5531 }
5532 sl=sl->next;
5533 }
5534 // find OrdSgn:
5535 R->OrdSgn = 1;
5536 for(i=1;i<=R->N;i++)
5537 { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5538 omFree(weights);
5539
5540 // check for complete coverage
5541 while ( n >= 0 && (
5542 (R->order[n]==ringorder_c)
5543 || (R->order[n]==ringorder_C)
5544 || (R->order[n]==ringorder_s)
5545 || (R->order[n]==ringorder_S)
5546 || (R->order[n]==ringorder_IS)
5547 )) n--;
5548
5549 assume( n >= 0 );
5550
5551 if (R->block1[n] != R->N)
5552 {
5553 if (((R->order[n]==ringorder_dp) ||
5554 (R->order[n]==ringorder_ds) ||
5555 (R->order[n]==ringorder_Dp) ||
5556 (R->order[n]==ringorder_Ds) ||
5557 (R->order[n]==ringorder_rp) ||
5558 (R->order[n]==ringorder_rs) ||
5559 (R->order[n]==ringorder_lp) ||
5560 (R->order[n]==ringorder_ls))
5561 &&
5562 R->block0[n] <= R->N)
5563 {
5564 R->block1[n] = R->N;
5565 }
5566 else
5567 {
5568 Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5569 R->N,R->block1[n]);
5570 return TRUE;
5571 }
5572 }
5573 return FALSE;
5574}
long int64
Definition: auxiliary.h:68
for(int i=0;i<=n;i++) degsf[i]
Definition: cfEzgcd.cc:72
STATIC_VAR poly last
Definition: hdegree.cc:1173
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5185
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:185
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:175
@ ringorder_no
Definition: ring.h:69

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 6008 of file ipshell.cc.

6009{
6010 ring R = rCopy0(org_ring);
6011 int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
6012 int n = rBlocks(org_ring), i=0, j;
6013
6014 /* names and number of variables-------------------------------------*/
6015 {
6016 int l=rv->listLength();
6017 if (l>MAX_SHORT)
6018 {
6019 Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6020 goto rInitError;
6021 }
6022 R->N = l; /*rv->listLength();*/
6023 }
6024 omFree(R->names);
6025 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6026 if (rSleftvList2StringArray(rv, R->names))
6027 {
6028 WerrorS("name of ring variable expected");
6029 goto rInitError;
6030 }
6031
6032 /* check names for subring in org_ring ------------------------- */
6033 {
6034 i=0;
6035
6036 for(j=0;j<R->N;j++)
6037 {
6038 for(;i<org_ring->N;i++)
6039 {
6040 if (strcmp(org_ring->names[i],R->names[j])==0)
6041 {
6042 perm[i+1]=j+1;
6043 break;
6044 }
6045 }
6046 if (i>org_ring->N)
6047 {
6048 Werror("variable %d (%s) not in basering",j+1,R->names[j]);
6049 break;
6050 }
6051 }
6052 }
6053 //Print("perm=");
6054 //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6055 /* ordering -------------------------------------------------------------*/
6056
6057 for(i=0;i<n;i++)
6058 {
6059 int min_var=-1;
6060 int max_var=-1;
6061 for(j=R->block0[i];j<=R->block1[i];j++)
6062 {
6063 if (perm[j]>0)
6064 {
6065 if (min_var==-1) min_var=perm[j];
6066 max_var=perm[j];
6067 }
6068 }
6069 if (min_var!=-1)
6070 {
6071 //Print("block %d: old %d..%d, now:%d..%d\n",
6072 // i,R->block0[i],R->block1[i],min_var,max_var);
6073 R->block0[i]=min_var;
6074 R->block1[i]=max_var;
6075 if (R->wvhdl[i]!=NULL)
6076 {
6077 omFree(R->wvhdl[i]);
6078 R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6079 for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6080 {
6081 if (perm[j]>0)
6082 {
6083 R->wvhdl[i][perm[j]-R->block0[i]]=
6084 org_ring->wvhdl[i][j-org_ring->block0[i]];
6085 //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6086 }
6087 }
6088 }
6089 }
6090 else
6091 {
6092 if(R->block0[i]>0)
6093 {
6094 //Print("skip block %d\n",i);
6095 R->order[i]=ringorder_unspec;
6096 if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6097 R->wvhdl[i]=NULL;
6098 }
6099 //else Print("keep block %d\n",i);
6100 }
6101 }
6102 i=n-1;
6103 while(i>0)
6104 {
6105 // removed unneded blocks
6106 if(R->order[i-1]==ringorder_unspec)
6107 {
6108 for(j=i;j<=n;j++)
6109 {
6110 R->order[j-1]=R->order[j];
6111 R->block0[j-1]=R->block0[j];
6112 R->block1[j-1]=R->block1[j];
6113 if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6114 R->wvhdl[j-1]=R->wvhdl[j];
6115 }
6116 R->order[n]=ringorder_unspec;
6117 n--;
6118 }
6119 i--;
6120 }
6121 n=rBlocks(org_ring)-1;
6122 while (R->order[n]==0) n--;
6123 while (R->order[n]==ringorder_unspec) n--;
6124 if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6125 if (R->block1[n] != R->N)
6126 {
6127 if (((R->order[n]==ringorder_dp) ||
6128 (R->order[n]==ringorder_ds) ||
6129 (R->order[n]==ringorder_Dp) ||
6130 (R->order[n]==ringorder_Ds) ||
6131 (R->order[n]==ringorder_rp) ||
6132 (R->order[n]==ringorder_rs) ||
6133 (R->order[n]==ringorder_lp) ||
6134 (R->order[n]==ringorder_ls))
6135 &&
6136 R->block0[n] <= R->N)
6137 {
6138 R->block1[n] = R->N;
6139 }
6140 else
6141 {
6142 Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6143 R->N,R->block1[n],n);
6144 return NULL;
6145 }
6146 }
6147 omFree(perm);
6148 // find OrdSgn:
6149 R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6150 //for(i=1;i<=R->N;i++)
6151 //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6152 //omFree(weights);
6153 // Complete the initialization
6154 if (rComplete(R,1))
6155 goto rInitError;
6156
6157 rTest(R);
6158
6159 if (rv != NULL) rv->CleanUp();
6160
6161 return R;
6162
6163 // error case:
6164 rInitError:
6165 if (R != NULL) rDelete(R);
6166 if (rv != NULL) rv->CleanUp();
6167 return NULL;
6168}
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1421

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

1105{
1106 int i;
1107 indset save;
1109
1110 hexist = hInit(S, Q, &hNexist);
1111 if (hNexist == 0)
1112 {
1113 intvec *iv=new intvec(rVar(currRing));
1114 for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1115 res->Init(1);
1116 res->m[0].rtyp=INTVEC_CMD;
1117 res->m[0].data=(intvec*)iv;
1118 return res;
1119 }
1121 hMu = 0;
1122 hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1123 hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1124 hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1125 hrad = hexist;
1126 hNrad = hNexist;
1127 radmem = hCreate(rVar(currRing) - 1);
1128 hCo = rVar(currRing) + 1;
1129 hNvar = rVar(currRing);
1131 hSupp(hrad, hNrad, hvar, &hNvar);
1132 if (hNvar)
1133 {
1134 hCo = hNvar;
1135 hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1138 }
1139 if (hCo && (hCo < rVar(currRing)))
1140 {
1142 }
1143 if (hMu!=0)
1144 {
1145 ISet = save;
1146 hMu2 = 0;
1147 if (all && (hCo+1 < rVar(currRing)))
1148 {
1151 i=hMu+hMu2;
1152 res->Init(i);
1153 if (hMu2 == 0)
1154 {
1156 }
1157 }
1158 else
1159 {
1160 res->Init(hMu);
1161 }
1162 for (i=0;i<hMu;i++)
1163 {
1164 res->m[i].data = (void *)save->set;
1165 res->m[i].rtyp = INTVEC_CMD;
1166 ISet = save;
1167 save = save->nx;
1169 }
1171 if (hMu2 != 0)
1172 {
1173 save = JSet;
1174 for (i=hMu;i<hMu+hMu2;i++)
1175 {
1176 res->m[i].data = (void *)save->set;
1177 res->m[i].rtyp = INTVEC_CMD;
1178 JSet = save;
1179 save = save->nx;
1181 }
1183 }
1184 }
1185 else
1186 {
1187 res->Init(0);
1189 }
1190 hKill(radmem, rVar(currRing) - 1);
1191 omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1192 omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1193 omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1195 return res;
1196}
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:384
VAR omBin indlist_bin
Definition: hdegree.cc:29
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:353
VAR long hMu
Definition: hdegree.cc:28
VAR indset JSet
Definition: hdegree.cc:353
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:35
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:564
monf hCreate(int Nvar)
Definition: hutil.cc:996
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1010
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:140
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:621
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:174
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:565
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
scfmon hInit(ideal S, ideal Q, int *Nexist)
Definition: hutil.cc:31
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:411
VAR int hNvar
Definition: hutil.cc:19
scmon * scfmon
Definition: hutil.h:15
indlist * indset
Definition: hutil.h:28
int * varset
Definition: hutil.h:16
int * scmon
Definition: hutil.h:14
STATIC_VAR jList * Q
Definition: janet.cc:30

◆ semicProc()

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

Definition at line 4550 of file ipshell.cc.

4551{
4552 sleftv tmp;
4553 tmp.Init();
4554 tmp.rtyp=INT_CMD;
4555 /* tmp.data = (void *)0; -- done by Init */
4556
4557 return semicProc3(res,u,v,&tmp);
4558}
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4510

◆ semicProc3()

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

Definition at line 4510 of file ipshell.cc.

4511{
4512 semicState state;
4513 BOOLEAN qh=(((int)(long)w->Data())==1);
4514
4515 // -----------------
4516 // check arguments
4517 // -----------------
4518
4519 lists l1 = (lists)u->Data( );
4520 lists l2 = (lists)v->Data( );
4521
4522 if( (state=list_is_spectrum( l1 ))!=semicOK )
4523 {
4524 WerrorS( "first argument is not a spectrum" );
4525 list_error( state );
4526 }
4527 else if( (state=list_is_spectrum( l2 ))!=semicOK )
4528 {
4529 WerrorS( "second argument is not a spectrum" );
4530 list_error( state );
4531 }
4532 else
4533 {
4534 spectrum s1= spectrumFromList( l1 );
4535 spectrum s2= spectrumFromList( l2 );
4536
4537 res->rtyp = INT_CMD;
4538 if (qh)
4539 res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4540 else
4541 res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4542 }
4543
4544 // -----------------
4545 // check status
4546 // -----------------
4547
4548 return (state!=semicOK);
4549}
Definition: semic.h:64
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
void list_error(semicState state)
Definition: ipshell.cc:3467
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3383
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4252

◆ spaddProc()

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

Definition at line 4427 of file ipshell.cc.

4428{
4429 semicState state;
4430
4431 // -----------------
4432 // check arguments
4433 // -----------------
4434
4435 lists l1 = (lists)first->Data( );
4436 lists l2 = (lists)second->Data( );
4437
4438 if( (state=list_is_spectrum( l1 )) != semicOK )
4439 {
4440 WerrorS( "first argument is not a spectrum:" );
4441 list_error( state );
4442 }
4443 else if( (state=list_is_spectrum( l2 )) != semicOK )
4444 {
4445 WerrorS( "second argument is not a spectrum:" );
4446 list_error( state );
4447 }
4448 else
4449 {
4450 spectrum s1= spectrumFromList ( l1 );
4451 spectrum s2= spectrumFromList ( l2 );
4452 spectrum sum( s1+s2 );
4453
4454 result->rtyp = LIST_CMD;
4455 result->data = (char*)(getList(sum));
4456 }
4457
4458 return (state!=semicOK);
4459}
lists getList(spectrum &spec)
Definition: ipshell.cc:3395

◆ spectrumCompute()

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

Definition at line 3809 of file ipshell.cc.

3810{
3811 int i;
3812
3813 #ifdef SPECTRUM_DEBUG
3814 #ifdef SPECTRUM_PRINT
3815 #ifdef SPECTRUM_IOSTREAM
3816 cout << "spectrumCompute\n";
3817 if( fast==0 ) cout << " no optimization" << endl;
3818 if( fast==1 ) cout << " weight optimization" << endl;
3819 if( fast==2 ) cout << " symmetry optimization" << endl;
3820 #else
3821 fputs( "spectrumCompute\n",stdout );
3822 if( fast==0 ) fputs( " no optimization\n", stdout );
3823 if( fast==1 ) fputs( " weight optimization\n", stdout );
3824 if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3825 #endif
3826 #endif
3827 #endif
3828
3829 // ----------------------
3830 // check if h is zero
3831 // ----------------------
3832
3833 if( h==(poly)NULL )
3834 {
3835 return spectrumZero;
3836 }
3837
3838 // ----------------------------------
3839 // check if h has a constant term
3840 // ----------------------------------
3841
3842 if( hasConstTerm( h, currRing ) )
3843 {
3844 return spectrumBadPoly;
3845 }
3846
3847 // --------------------------------
3848 // check if h has a linear term
3849 // --------------------------------
3850
3851 if( hasLinearTerm( h, currRing ) )
3852 {
3853 *L = (lists)omAllocBin( slists_bin);
3854 (*L)->Init( 1 );
3855 (*L)->m[0].rtyp = INT_CMD; // milnor number
3856 /* (*L)->m[0].data = (void*)0;a -- done by Init */
3857
3858 return spectrumNoSingularity;
3859 }
3860
3861 // ----------------------------------
3862 // compute the jacobi ideal of (h)
3863 // ----------------------------------
3864
3865 ideal J = NULL;
3866 J = idInit( rVar(currRing),1 );
3867
3868 #ifdef SPECTRUM_DEBUG
3869 #ifdef SPECTRUM_PRINT
3870 #ifdef SPECTRUM_IOSTREAM
3871 cout << "\n computing the Jacobi ideal...\n";
3872 #else
3873 fputs( "\n computing the Jacobi ideal...\n",stdout );
3874 #endif
3875 #endif
3876 #endif
3877
3878 for( i=0; i<rVar(currRing); i++ )
3879 {
3880 J->m[i] = pDiff( h,i+1); //j );
3881
3882 #ifdef SPECTRUM_DEBUG
3883 #ifdef SPECTRUM_PRINT
3884 #ifdef SPECTRUM_IOSTREAM
3885 cout << " ";
3886 #else
3887 fputs(" ", stdout );
3888 #endif
3889 pWrite( J->m[i] );
3890 #endif
3891 #endif
3892 }
3893
3894 // --------------------------------------------
3895 // compute a standard basis stdJ of jac(h)
3896 // --------------------------------------------
3897
3898 #ifdef SPECTRUM_DEBUG
3899 #ifdef SPECTRUM_PRINT
3900 #ifdef SPECTRUM_IOSTREAM
3901 cout << endl;
3902 cout << " computing a standard basis..." << endl;
3903 #else
3904 fputs( "\n", stdout );
3905 fputs( " computing a standard basis...\n", stdout );
3906 #endif
3907 #endif
3908 #endif
3909
3910 ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3911 idSkipZeroes( stdJ );
3912
3913 #ifdef SPECTRUM_DEBUG
3914 #ifdef SPECTRUM_PRINT
3915 for( i=0; i<IDELEMS(stdJ); i++ )
3916 {
3917 #ifdef SPECTRUM_IOSTREAM
3918 cout << " ";
3919 #else
3920 fputs( " ",stdout );
3921 #endif
3922
3923 pWrite( stdJ->m[i] );
3924 }
3925 #endif
3926 #endif
3927
3928 idDelete( &J );
3929
3930 // ------------------------------------------
3931 // check if the h has a singularity
3932 // ------------------------------------------
3933
3934 if( hasOne( stdJ, currRing ) )
3935 {
3936 // -------------------------------
3937 // h is smooth in the origin
3938 // return only the Milnor number
3939 // -------------------------------
3940
3941 *L = (lists)omAllocBin( slists_bin);
3942 (*L)->Init( 1 );
3943 (*L)->m[0].rtyp = INT_CMD; // milnor number
3944 /* (*L)->m[0].data = (void*)0;a -- done by Init */
3945
3946 return spectrumNoSingularity;
3947 }
3948
3949 // ------------------------------------------
3950 // check if the singularity h is isolated
3951 // ------------------------------------------
3952
3953 for( i=rVar(currRing); i>0; i-- )
3954 {
3955 if( hasAxis( stdJ,i, currRing )==FALSE )
3956 {
3957 return spectrumNotIsolated;
3958 }
3959 }
3960
3961 // ------------------------------------------
3962 // compute the highest corner hc of stdJ
3963 // ------------------------------------------
3964
3965 #ifdef SPECTRUM_DEBUG
3966 #ifdef SPECTRUM_PRINT
3967 #ifdef SPECTRUM_IOSTREAM
3968 cout << "\n computing the highest corner...\n";
3969 #else
3970 fputs( "\n computing the highest corner...\n", stdout );
3971 #endif
3972 #endif
3973 #endif
3974
3975 poly hc = (poly)NULL;
3976
3977 scComputeHC( stdJ,currRing->qideal, 0,hc );
3978
3979 if( hc!=(poly)NULL )
3980 {
3981 pGetCoeff(hc) = nInit(1);
3982
3983 for( i=rVar(currRing); i>0; i-- )
3984 {
3985 if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3986 }
3987 pSetm( hc );
3988 }
3989 else
3990 {
3991 return spectrumNoHC;
3992 }
3993
3994 #ifdef SPECTRUM_DEBUG
3995 #ifdef SPECTRUM_PRINT
3996 #ifdef SPECTRUM_IOSTREAM
3997 cout << " ";
3998 #else
3999 fputs( " ", stdout );
4000 #endif
4001 pWrite( hc );
4002 #endif
4003 #endif
4004
4005 // ----------------------------------------
4006 // compute the Newton polygon nph of h
4007 // ----------------------------------------
4008
4009 #ifdef SPECTRUM_DEBUG
4010 #ifdef SPECTRUM_PRINT
4011 #ifdef SPECTRUM_IOSTREAM
4012 cout << "\n computing the newton polygon...\n";
4013 #else
4014 fputs( "\n computing the newton polygon...\n", stdout );
4015 #endif
4016 #endif
4017 #endif
4018
4019 newtonPolygon nph( h, currRing );
4020
4021 #ifdef SPECTRUM_DEBUG
4022 #ifdef SPECTRUM_PRINT
4023 cout << nph;
4024 #endif
4025 #endif
4026
4027 // -----------------------------------------------
4028 // compute the weight corner wc of (stdj,nph)
4029 // -----------------------------------------------
4030
4031 #ifdef SPECTRUM_DEBUG
4032 #ifdef SPECTRUM_PRINT
4033 #ifdef SPECTRUM_IOSTREAM
4034 cout << "\n computing the weight corner...\n";
4035 #else
4036 fputs( "\n computing the weight corner...\n", stdout );
4037 #endif
4038 #endif
4039 #endif
4040
4041 poly wc = ( fast==0 ? pCopy( hc ) :
4042 ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4043 /* fast==2 */computeWC( nph,
4044 ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4045
4046 #ifdef SPECTRUM_DEBUG
4047 #ifdef SPECTRUM_PRINT
4048 #ifdef SPECTRUM_IOSTREAM
4049 cout << " ";
4050 #else
4051 fputs( " ", stdout );
4052 #endif
4053 pWrite( wc );
4054 #endif
4055 #endif
4056
4057 // -------------
4058 // compute NF
4059 // -------------
4060
4061 #ifdef SPECTRUM_DEBUG
4062 #ifdef SPECTRUM_PRINT
4063 #ifdef SPECTRUM_IOSTREAM
4064 cout << "\n computing NF...\n" << endl;
4065 #else
4066 fputs( "\n computing NF...\n", stdout );
4067 #endif
4068 #endif
4069 #endif
4070
4071 spectrumPolyList NF( &nph );
4072
4073 computeNF( stdJ,hc,wc,&NF, currRing );
4074
4075 #ifdef SPECTRUM_DEBUG
4076 #ifdef SPECTRUM_PRINT
4077 cout << NF;
4078 #ifdef SPECTRUM_IOSTREAM
4079 cout << endl;
4080 #else
4081 fputs( "\n", stdout );
4082 #endif
4083 #endif
4084 #endif
4085
4086 // ----------------------------
4087 // compute the spectrum of h
4088 // ----------------------------
4089// spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4090
4091 return spectrumStateFromList(NF, L, fast );
4092}
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3568
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2433
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
@ isNotHomog
Definition: structs.h:36

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4183 of file ipshell.cc.

4184{
4185 spectrumState state = spectrumOK;
4186
4187 // -------------------
4188 // check consistency
4189 // -------------------
4190
4191 // check for a local polynomial ring
4192
4193 if( currRing->OrdSgn != -1 )
4194 // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4195 // or should we use:
4196 //if( !ringIsLocal( ) )
4197 {
4198 WerrorS( "only works for local orderings" );
4199 state = spectrumWrongRing;
4200 }
4201 else if( currRing->qideal != NULL )
4202 {
4203 WerrorS( "does not work in quotient rings" );
4204 state = spectrumWrongRing;
4205 }
4206 else
4207 {
4208 lists L = (lists)NULL;
4209 int flag = 2; // symmetric optimization
4210
4211 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4212
4213 if( state==spectrumOK )
4214 {
4215 result->rtyp = LIST_CMD;
4216 result->data = (char*)L;
4217 }
4218 else
4219 {
4220 spectrumPrintError(state);
4221 }
4222 }
4223
4224 return (state!=spectrumOK);
4225}
spectrumState
Definition: ipshell.cc:3550
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3809
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4101

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3383 of file ipshell.cc.

3384{
3386 copy_deep( result, l );
3387 return result;
3388}
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3359

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4101 of file ipshell.cc.

4102{
4103 switch( state )
4104 {
4105 case spectrumZero:
4106 WerrorS( "polynomial is zero" );
4107 break;
4108 case spectrumBadPoly:
4109 WerrorS( "polynomial has constant term" );
4110 break;
4112 WerrorS( "not a singularity" );
4113 break;
4115 WerrorS( "the singularity is not isolated" );
4116 break;
4117 case spectrumNoHC:
4118 WerrorS( "highest corner cannot be computed" );
4119 break;
4120 case spectrumDegenerate:
4121 WerrorS( "principal part is degenerate" );
4122 break;
4123 case spectrumOK:
4124 break;
4125
4126 default:
4127 WerrorS( "unknown error occurred" );
4128 break;
4129 }
4130}

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4132 of file ipshell.cc.

4133{
4134 spectrumState state = spectrumOK;
4135
4136 // -------------------
4137 // check consistency
4138 // -------------------
4139
4140 // check for a local ring
4141
4142 if( !ringIsLocal(currRing ) )
4143 {
4144 WerrorS( "only works for local orderings" );
4145 state = spectrumWrongRing;
4146 }
4147
4148 // no quotient rings are allowed
4149
4150 else if( currRing->qideal != NULL )
4151 {
4152 WerrorS( "does not work in quotient rings" );
4153 state = spectrumWrongRing;
4154 }
4155 else
4156 {
4157 lists L = (lists)NULL;
4158 int flag = 1; // weight corner optimization is safe
4159
4160 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4161
4162 if( state==spectrumOK )
4163 {
4164 result->rtyp = LIST_CMD;
4165 result->data = (char*)L;
4166 }
4167 else
4168 {
4169 spectrumPrintError(state);
4170 }
4171 }
4172
4173 return (state!=spectrumOK);
4174}
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spectrumStateFromList()

spectrumState spectrumStateFromList ( spectrumPolyList speclist,
lists L,
int  fast 
)

Definition at line 3568 of file ipshell.cc.

3569{
3570 spectrumPolyNode **node = &speclist.root;
3572
3573 poly f,tmp;
3574 int found,cmp;
3575
3576 Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3577 ( fast==2 ? 2 : 1 ) );
3578
3579 Rational weight_prev( 0,1 );
3580
3581 int mu = 0; // the milnor number
3582 int pg = 0; // the geometrical genus
3583 int n = 0; // number of different spectral numbers
3584 int z = 0; // number of spectral number equal to smax
3585
3586 while( (*node)!=(spectrumPolyNode*)NULL &&
3587 ( fast==0 || (*node)->weight<=smax ) )
3588 {
3589 // ---------------------------------------
3590 // determine the first normal form which
3591 // contains the monomial node->mon
3592 // ---------------------------------------
3593
3594 found = FALSE;
3595 search = *node;
3596
3597 while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3598 {
3599 if( search->nf!=(poly)NULL )
3600 {
3601 f = search->nf;
3602
3603 do
3604 {
3605 // --------------------------------
3606 // look for (*node)->mon in f
3607 // --------------------------------
3608
3609 cmp = pCmp( (*node)->mon,f );
3610
3611 if( cmp<0 )
3612 {
3613 f = pNext( f );
3614 }
3615 else if( cmp==0 )
3616 {
3617 // -----------------------------
3618 // we have found a normal form
3619 // -----------------------------
3620
3621 found = TRUE;
3622
3623 // normalize coefficient
3624
3625 number inv = nInvers( pGetCoeff( f ) );
3626 search->nf=__p_Mult_nn( search->nf,inv,currRing );
3627 nDelete( &inv );
3628
3629 // exchange normal forms
3630
3631 tmp = (*node)->nf;
3632 (*node)->nf = search->nf;
3633 search->nf = tmp;
3634 }
3635 }
3636 while( cmp<0 && f!=(poly)NULL );
3637 }
3638 search = search->next;
3639 }
3640
3641 if( found==FALSE )
3642 {
3643 // ------------------------------------------------
3644 // the weight of node->mon is a spectrum number
3645 // ------------------------------------------------
3646
3647 mu++;
3648
3649 if( (*node)->weight<=(Rational)1 ) pg++;
3650 if( (*node)->weight==smax ) z++;
3651 if( (*node)->weight>weight_prev ) n++;
3652
3653 weight_prev = (*node)->weight;
3654 node = &((*node)->next);
3655 }
3656 else
3657 {
3658 // -----------------------------------------------
3659 // determine all other normal form which contain
3660 // the monomial node->mon
3661 // replace for node->mon its normal form
3662 // -----------------------------------------------
3663
3664 while( search!=(spectrumPolyNode*)NULL )
3665 {
3666 if( search->nf!=(poly)NULL )
3667 {
3668 f = search->nf;
3669
3670 do
3671 {
3672 // --------------------------------
3673 // look for (*node)->mon in f
3674 // --------------------------------
3675
3676 cmp = pCmp( (*node)->mon,f );
3677
3678 if( cmp<0 )
3679 {
3680 f = pNext( f );
3681 }
3682 else if( cmp==0 )
3683 {
3684 search->nf = pSub( search->nf,
3685 __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3686 pNorm( search->nf );
3687 }
3688 }
3689 while( cmp<0 && f!=(poly)NULL );
3690 }
3691 search = search->next;
3692 }
3693 speclist.delete_node( node );
3694 }
3695
3696 }
3697
3698 // --------------------------------------------------------
3699 // fast computation exploits the symmetry of the spectrum
3700 // --------------------------------------------------------
3701
3702 if( fast==2 )
3703 {
3704 mu = 2*mu - z;
3705 n = ( z > 0 ? 2*n - 1 : 2*n );
3706 }
3707
3708 // --------------------------------------------------------
3709 // compute the spectrum numbers with their multiplicities
3710 // --------------------------------------------------------
3711
3712 intvec *nom = new intvec( n );
3713 intvec *den = new intvec( n );
3714 intvec *mult = new intvec( n );
3715
3716 int count = 0;
3717 int multiplicity = 1;
3718
3719 for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3720 ( fast==0 || search->weight<=smax );
3721 search=search->next )
3722 {
3723 if( search->next==(spectrumPolyNode*)NULL ||
3724 search->weight<search->next->weight )
3725 {
3726 (*nom) [count] = search->weight.get_num_si( );
3727 (*den) [count] = search->weight.get_den_si( );
3728 (*mult)[count] = multiplicity;
3729
3730 multiplicity=1;
3731 count++;
3732 }
3733 else
3734 {
3735 multiplicity++;
3736 }
3737 }
3738
3739 // --------------------------------------------------------
3740 // fast computation exploits the symmetry of the spectrum
3741 // --------------------------------------------------------
3742
3743 if( fast==2 )
3744 {
3745 int n1,n2;
3746 for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3747 {
3748 (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3749 (*den) [n2] = (*den)[n1];
3750 (*mult)[n2] = (*mult)[n1];
3751 }
3752 }
3753
3754 // -----------------------------------
3755 // test if the spectrum is symmetric
3756 // -----------------------------------
3757
3758 if( fast==0 || fast==1 )
3759 {
3760 int symmetric=TRUE;
3761
3762 for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3763 {
3764 if( (*mult)[n1]!=(*mult)[n2] ||
3765 (*den) [n1]!= (*den)[n2] ||
3766 (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3767 {
3768 symmetric = FALSE;
3769 }
3770 }
3771
3772 if( symmetric==FALSE )
3773 {
3774 // ---------------------------------------------
3775 // the spectrum is not symmetric => degenerate
3776 // principal part
3777 // ---------------------------------------------
3778
3779 *L = (lists)omAllocBin( slists_bin);
3780 (*L)->Init( 1 );
3781 (*L)->m[0].rtyp = INT_CMD; // milnor number
3782 (*L)->m[0].data = (void*)(long)mu;
3783
3784 return spectrumDegenerate;
3785 }
3786 }
3787
3788 *L = (lists)omAllocBin( slists_bin);
3789
3790 (*L)->Init( 6 );
3791
3792 (*L)->m[0].rtyp = INT_CMD; // milnor number
3793 (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3794 (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3795 (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3796 (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3797 (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3798
3799 (*L)->m[0].data = (void*)(long)mu;
3800 (*L)->m[1].data = (void*)(long)pg;
3801 (*L)->m[2].data = (void*)(long)n;
3802 (*L)->m[3].data = (void*)nom;
3803 (*L)->m[4].data = (void*)den;
3804 (*L)->m[5].data = (void*)mult;
3805
3806 return spectrumOK;
3807}
FILE * f
Definition: checklibs.c:9
spectrumPolyNode * root
Definition: splist.h:60
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256
bool found
Definition: facFactorize.cc:55
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
STATIC_VAR int * multiplicity
#define pNext(p)
Definition: monomials.h:36
#define nInvers(a)
Definition: numbers.h:33
#define __pp_Mult_nn(p, n, r)
Definition: p_polys.h:1004
#define __p_Mult_nn(p, n, r)
Definition: p_polys.h:973
void pNorm(poly p)
Definition: polys.h:363
#define pSub(a, b)
Definition: polys.h:287
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition: polys.h:115

◆ spmulProc()

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

Definition at line 4469 of file ipshell.cc.

4470{
4471 semicState state;
4472
4473 // -----------------
4474 // check arguments
4475 // -----------------
4476
4477 lists l = (lists)first->Data( );
4478 int k = (int)(long)second->Data( );
4479
4480 if( (state=list_is_spectrum( l ))!=semicOK )
4481 {
4482 WerrorS( "first argument is not a spectrum" );
4483 list_error( state );
4484 }
4485 else if( k < 0 )
4486 {
4487 WerrorS( "second argument should be positive" );
4488 state = semicMulNegative;
4489 }
4490 else
4491 {
4493 spectrum product( k*s );
4494
4495 result->rtyp = LIST_CMD;
4496 result->data = (char*)getList(product);
4497 }
4498
4499 return (state!=semicOK);
4500}

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3171 of file ipshell.cc.

3172{
3173 sleftv tmp;
3174 tmp.Init();
3175 tmp.rtyp=INT_CMD;
3176 tmp.data=(void *)1;
3177 return syBetti2(res,u,&tmp);
3178}
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3148

◆ syBetti2()

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

Definition at line 3148 of file ipshell.cc.

3149{
3150 syStrategy syzstr=(syStrategy)u->Data();
3151
3152 BOOLEAN minim=(int)(long)w->Data();
3153 int row_shift=0;
3154 int add_row_shift=0;
3155 intvec *weights=NULL;
3156 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3157 if (ww!=NULL)
3158 {
3159 weights=ivCopy(ww);
3160 add_row_shift = ww->min_in();
3161 (*weights) -= add_row_shift;
3162 }
3163
3164 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3165 //row_shift += add_row_shift;
3166 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3167 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3168
3169 return FALSE;
3170}
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1755
ssyStrategy * syStrategy
Definition: syz.h:36

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3255 of file ipshell.cc.

3256{
3257 int typ0;
3259
3260 resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3261 if (fr != NULL)
3262 {
3263
3264 result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3265 for (int i=result->length-1;i>=0;i--)
3266 {
3267 if (fr[i]!=NULL)
3268 result->fullres[i] = idCopy(fr[i]);
3269 }
3270 result->list_length=result->length;
3271 omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3272 }
3273 else
3274 {
3275 omFreeSize(result, sizeof(ssyStrategy));
3276 result = NULL;
3277 }
3278 return result;
3279}

◆ syConvRes()

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

Definition at line 3183 of file ipshell.cc.

3184{
3185 resolvente fullres = syzstr->fullres;
3186 resolvente minres = syzstr->minres;
3187
3188 const int length = syzstr->length;
3189
3190 if ((fullres==NULL) && (minres==NULL))
3191 {
3192 if (syzstr->hilb_coeffs==NULL)
3193 { // La Scala
3194 fullres = syReorder(syzstr->res, length, syzstr);
3195 }
3196 else
3197 { // HRES
3198 minres = syReorder(syzstr->orderedRes, length, syzstr);
3199 syKillEmptyEntres(minres, length);
3200 }
3201 }
3202
3203 resolvente tr;
3204 int typ0=IDEAL_CMD;
3205
3206 if (minres!=NULL)
3207 tr = minres;
3208 else
3209 tr = fullres;
3210
3211 resolvente trueres=NULL;
3212 intvec ** w=NULL;
3213
3214 if (length>0)
3215 {
3216 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3217 for (int i=length-1;i>=0;i--)
3218 {
3219 if (tr[i]!=NULL)
3220 {
3221 trueres[i] = idCopy(tr[i]);
3222 }
3223 }
3224 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3225 typ0 = MODUL_CMD;
3226 if (syzstr->weights!=NULL)
3227 {
3228 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3229 for (int i=length-1;i>=0;i--)
3230 {
3231 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3232 }
3233 }
3234 }
3235
3236 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3237 w, add_row_shift);
3238
3239 if (toDel)
3240 syKillComputation(syzstr);
3241 else
3242 {
3243 if( fullres != NULL && syzstr->fullres == NULL )
3244 syzstr->fullres = fullres;
3245
3246 if( minres != NULL && syzstr->minres == NULL )
3247 syzstr->minres = minres;
3248 }
3249 return li;
3250}
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1641
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3284 of file ipshell.cc.

3285{
3286 int typ0;
3288
3289 resolvente fr = liFindRes(li,&(result->length),&typ0);
3290 result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3291 for (int i=result->length-1;i>=0;i--)
3292 {
3293 if (fr[i]!=NULL)
3294 result->minres[i] = idCopy(fr[i]);
3295 }
3296 omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3297 return result;
3298}

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

515{
516 int ii;
517
518 if (i<0)
519 {
520 ii= -i;
521 if (ii < 32)
522 {
523 si_opt_1 &= ~Sy_bit(ii);
524 }
525 else if (ii < 64)
526 {
527 si_opt_2 &= ~Sy_bit(ii-32);
528 }
529 else
530 WerrorS("out of bounds\n");
531 }
532 else if (i<32)
533 {
534 ii=i;
535 if (Sy_bit(ii) & kOptions)
536 {
537 WarnS("Gerhard, use the option command");
538 si_opt_1 |= Sy_bit(ii);
539 }
540 else if (Sy_bit(ii) & validOpts)
541 si_opt_1 |= Sy_bit(ii);
542 }
543 else if (i<64)
544 {
545 ii=i-32;
546 si_opt_2 |= Sy_bit(ii);
547 }
548 else
549 WerrorS("out of bounds\n");
550}
VAR BITSET validOpts
Definition: kstd1.cc:60
VAR BITSET kOptions
Definition: kstd1.cc:45

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

255{
256 BOOLEAN oldShortOut = FALSE;
257
258 if (currRing != NULL)
259 {
260 oldShortOut = currRing->ShortOut;
261 currRing->ShortOut = 1;
262 }
263 int t=v->Typ();
264 Print("// %s %s ",v->Name(),Tok2Cmdname(t));
265 switch (t)
266 {
267 case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
268 case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
269 ((intvec*)(v->Data()))->cols()); break;
270 case MATRIX_CMD:Print(" %u x %u\n" ,
271 MATROWS((matrix)(v->Data())),
272 MATCOLS((matrix)(v->Data())));break;
273 case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
274 case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
275
276 case PROC_CMD:
277 case RING_CMD:
278 case IDEAL_CMD: PrintLn(); break;
279
280 //case INT_CMD:
281 //case STRING_CMD:
282 //case INTVEC_CMD:
283 //case POLY_CMD:
284 //case VECTOR_CMD:
285 //case PACKAGE_CMD:
286
287 default:
288 break;
289 }
290 v->Print();
291 if (currRing != NULL)
292 currRing->ShortOut = oldShortOut;
293}
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:504

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1063 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5612 of file ipshell.cc.