My Project
Loading...
Searching...
No Matches
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)
 
static void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
static void rDecompose_23456 (const ring r, lists L)
 
lists rDecompose_list_cf (const ring r)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
static BOOLEAN rComposeVar (const lists L, ring R)
 
static BOOLEAN rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
 
ring rCompose (const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
 
syStrategy syConvList (lists li)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void copy_deep (spectrum &spec, lists l)
 
spectrum spectrumFromList (lists l)
 
lists getList (spectrum &spec)
 
void list_error (semicState state)
 
spectrumState spectrumStateFromList (spectrumPolyList &speclist, lists *L, int fast)
 
spectrumState spectrumCompute (poly h, lists *L, int fast)
 
void spectrumPrintError (spectrumState state)
 
BOOLEAN spectrumProc (leftv result, leftv first)
 
BOOLEAN spectrumfProc (leftv result, leftv first)
 
semicState list_is_spectrum (lists l)
 
BOOLEAN spaddProc (leftv result, leftv first, leftv second)
 
BOOLEAN spmulProc (leftv result, leftv first, leftv second)
 
BOOLEAN semicProc3 (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN semicProc (leftv res, leftv u, leftv v)
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials 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 3434 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3550 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3360 of file ipshell.cc.

3361{
3362 spec.mu = (int)(long)(l->m[0].Data( ));
3363 spec.pg = (int)(long)(l->m[1].Data( ));
3364 spec.n = (int)(long)(l->m[2].Data( ));
3365
3366 spec.copy_new( spec.n );
3367
3368 intvec *num = (intvec*)l->m[3].Data( );
3369 intvec *den = (intvec*)l->m[4].Data( );
3370 intvec *mul = (intvec*)l->m[5].Data( );
3371
3372 for( int i=0; i<spec.n; i++ )
3373 {
3374 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3375 spec.w[i] = (*mul)[i];
3376 }
3377}
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: variable.h:52
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 3396 of file ipshell.cc.

3397{
3399
3400 L->Init( 6 );
3401
3402 intvec *num = new intvec( spec.n );
3403 intvec *den = new intvec( spec.n );
3404 intvec *mult = new intvec( spec.n );
3405
3406 for( int i=0; i<spec.n; i++ )
3407 {
3408 (*num) [i] = spec.s[i].get_num_si( );
3409 (*den) [i] = spec.s[i].get_den_si( );
3410 (*mult)[i] = spec.w[i];
3411 }
3412
3413 L->m[0].rtyp = INT_CMD; // milnor number
3414 L->m[1].rtyp = INT_CMD; // geometrical genus
3415 L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3416 L->m[3].rtyp = INTVEC_CMD; // numerators
3417 L->m[4].rtyp = INTVEC_CMD; // denomiantors
3418 L->m[5].rtyp = INTVEC_CMD; // multiplicities
3419
3420 L->m[0].data = (void*)(long)spec.mu;
3421 L->m[1].data = (void*)(long)spec.pg;
3422 L->m[2].data = (void*)(long)spec.n;
3423 L->m[3].data = (void*)num;
3424 L->m[4].data = (void*)den;
3425 L->m[5].data = (void*)mult;
3426
3427 return L;
3428}
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 6431 of file ipshell.cc.

6432{
6433 res->Init();
6434 res->rtyp=a->Typ();
6435 switch (res->rtyp /*a->Typ()*/)
6436 {
6437 case INTVEC_CMD:
6438 case INTMAT_CMD:
6439 return iiApplyINTVEC(res,a,op,proc);
6440 case BIGINTMAT_CMD:
6441 return iiApplyBIGINTMAT(res,a,op,proc);
6442 case IDEAL_CMD:
6443 case MODUL_CMD:
6444 case MATRIX_CMD:
6445 return iiApplyIDEAL(res,a,op,proc);
6446 case LIST_CMD:
6447 return iiApplyLIST(res,a,op,proc);
6448 }
6449 WerrorS("first argument to `apply` must allow an index");
6450 return TRUE;
6451}
#define TRUE
Definition: auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
int Typ()
Definition: subexpr.cc:1019
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:6350
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6392
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6387
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6382

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6382 of file ipshell.cc.

6383{
6384 WerrorS("not implemented");
6385 return TRUE;
6386}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6387 of file ipshell.cc.

6388{
6389 WerrorS("not implemented");
6390 return TRUE;
6391}

◆ iiApplyINTVEC()

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

Definition at line 6350 of file ipshell.cc.

6351{
6352 intvec *aa=(intvec*)a->Data();
6353 sleftv tmp_out;
6354 sleftv tmp_in;
6355 leftv curr=res;
6356 BOOLEAN bo=FALSE;
6357 for(int i=0;i<aa->length(); i++)
6358 {
6359 tmp_in.Init();
6360 tmp_in.rtyp=INT_CMD;
6361 tmp_in.data=(void*)(long)(*aa)[i];
6362 if (proc==NULL)
6363 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6364 else
6365 bo=jjPROC(&tmp_out,proc,&tmp_in);
6366 if (bo)
6367 {
6368 res->CleanUp(currRing);
6369 Werror("apply fails at index %d",i+1);
6370 return TRUE;
6371 }
6372 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6373 else
6374 {
6376 curr=curr->next;
6377 memcpy(curr,&tmp_out,sizeof(tmp_out));
6378 }
6379 }
6380 return FALSE;
6381}
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:1162
void Init()
Definition: subexpr.h:107
leftv next
Definition: subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9113
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1617
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 6392 of file ipshell.cc.

6393{
6394 lists aa=(lists)a->Data();
6395 if (aa->nr==-1) /* empty list*/
6396 {
6398 l->Init();
6399 res->data=(void *)l;
6400 return FALSE;
6401 }
6402 sleftv tmp_out;
6403 sleftv tmp_in;
6404 leftv curr=res;
6405 BOOLEAN bo=FALSE;
6406 for(int i=0;i<=aa->nr; i++)
6407 {
6408 tmp_in.Init();
6409 tmp_in.Copy(&(aa->m[i]));
6410 if (proc==NULL)
6411 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6412 else
6413 bo=jjPROC(&tmp_out,proc,&tmp_in);
6414 tmp_in.CleanUp();
6415 if (bo)
6416 {
6417 res->CleanUp(currRing);
6418 Werror("apply fails at index %d",i+1);
6419 return TRUE;
6420 }
6421 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6422 else
6423 {
6425 curr=curr->next;
6426 memcpy(curr,&tmp_out,sizeof(tmp_out));
6427 }
6428 }
6429 return FALSE;
6430}
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 6480 of file ipshell.cc.

6481{
6482 char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6483 // find end of s:
6484 int end_s=strlen(s);
6485 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6486 s[end_s+1]='\0';
6487 char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6488 sprintf(name,"%s->%s",a,s);
6489 // find start of last expression
6490 int start_s=end_s-1;
6491 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6492 if (start_s<0) // ';' not found
6493 {
6494 sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6495 }
6496 else // s[start_s] is ';'
6497 {
6498 s[start_s]='\0';
6499 sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6500 }
6501 r->Init();
6502 // now produce procinfo for PROC_CMD:
6503 r->data = (void *)omAlloc0Bin(procinfo_bin);
6504 ((procinfo *)(r->data))->language=LANG_NONE;
6506 ((procinfo *)r->data)->data.s.body=ss;
6507 omFree(name);
6508 r->rtyp=PROC_CMD;
6509 //r->rtyp=STRING_CMD;
6510 //r->data=ss;
6511 return FALSE;
6512}
const CanonicalForm int s
Definition: facAbsFact.cc:51
@ 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
int name
New type name for int.
Definition: templateForC.h:21

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6514 of file ipshell.cc.

6515{
6516 char* ring_name=omStrDup((char*)r->Name());
6517 int t=arg->Typ();
6518 if (t==RING_CMD)
6519 {
6520 sleftv tmp;
6521 tmp.Init();
6522 tmp.rtyp=IDHDL;
6523 idhdl h=rDefault(ring_name);
6524 tmp.data=(char*)h;
6525 if (h!=NULL)
6526 {
6527 tmp.name=h->id;
6528 BOOLEAN b=iiAssign(&tmp,arg);
6529 if (b) return TRUE;
6530 rSetHdl(ggetid(ring_name));
6531 omFree(ring_name);
6532 return FALSE;
6533 }
6534 else
6535 return TRUE;
6536 }
6537 else if (t==CRING_CMD)
6538 {
6539 sleftv tmp;
6540 sleftv n;
6541 n.Init();
6542 n.name=ring_name;
6543 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6544 if (iiAssign(&tmp,arg)) return TRUE;
6545 //Print("create %s\n",r->Name());
6546 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6547 return FALSE;
6548 }
6549 //Print("create %s\n",r->Name());
6550 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6551 return TRUE;// not handled -> error for now
6552}
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:5126
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:9523
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:6572
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}
static int RingDependend(int t)
Definition: gentable.cc:28
VAR BOOLEAN siq
Definition: subexpr.cc:48

◆ iiCheckTypes()

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

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

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

Definition at line 6572 of file ipshell.cc.

6573{
6574 int l=0;
6575 if (args==NULL)
6576 {
6577 if (type_list[0]==0) return TRUE;
6578 }
6579 else l=args->listLength();
6580 if (l!=(int)type_list[0])
6581 {
6582 if (report) iiReportTypes(0,l,type_list);
6583 return FALSE;
6584 }
6585 for(int i=1;i<=l;i++,args=args->next)
6586 {
6587 short t=type_list[i];
6588 if (t!=ANY_TYPE)
6589 {
6590 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6591 || (t!=args->Typ()))
6592 {
6593 if (report) iiReportTypes(i,args->Typ(),type_list);
6594 return FALSE;
6595 }
6596 }
6597 }
6598 return TRUE;
6599}
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6554
#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:2137
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:592
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:760

◆ 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:837
static void rDecRefCnt(ring r)
Definition: ring.h:838

◆ 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:222

◆ 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:239
#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:697
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:486
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:231
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:899
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:844
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1505
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:338
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 6554 of file ipshell.cc.

6555{
6556 char buf[250];
6557 buf[0]='\0';
6558 if (nr==0)
6559 sprintf(buf,"wrong length of parameters(%d), expected ",t);
6560 else
6561 sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6562 for(int i=1;i<=T[0];i++)
6563 {
6564 strcat(buf,"`");
6565 strcat(buf,Tok2Cmdname(T[i]));
6566 strcat(buf,"`");
6567 if (i<T[0]) strcat(buf,",");
6568 }
6569 WerrorS(buf);
6570}
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 6601 of file ipshell.cc.

6602{
6603 if ((source->next==NULL)&&(source->e==NULL))
6604 {
6605 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6606 {
6607 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6608 source->Init();
6609 return;
6610 }
6611 if (source->rtyp==IDHDL)
6612 {
6613 if ((IDLEV((idhdl)source->data)==myynest)
6614 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6615 {
6617 iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6618 iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6619 iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6621 IDATTR((idhdl)source->data)=NULL;
6622 IDDATA((idhdl)source->data)=NULL;
6623 source->name=NULL;
6624 source->attribute=NULL;
6625 return;
6626 }
6627 }
6628 }
6629 iiRETURNEXPR.Copy(source);
6630}
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 6453 of file ipshell.cc.

6454{
6455 // assume a: level
6456 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6457 {
6458 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6459 char assume_yylinebuf[80];
6460 strncpy(assume_yylinebuf,my_yylinebuf,79);
6461 int lev=(long)a->Data();
6462 int startlev=0;
6463 idhdl h=ggetid("assumeLevel");
6464 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6465 if(lev <=startlev)
6466 {
6467 BOOLEAN bo=b->Eval();
6468 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6469 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6470 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6471 }
6472 }
6473 b->CleanUp();
6474 a->CleanUp();
6475 return FALSE;
6476}
#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:1462
CFList tmp2
Definition: facFqBivar.cc:72
@ DEF_CMD
Definition: tok.h:58

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3347 of file ipshell.cc.

3348{
3349 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3350 return (res->data==NULL);
3351}
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 6288 of file ipshell.cc.

6289{
6290 if (n==0) n=1;
6291 ideal l=idInit(n,1);
6292 int i;
6293 poly p;
6294 for(i=rVar(currRing);i>0;i--)
6295 {
6296 if (e[i]>0)
6297 {
6298 n--;
6299 p=pOne();
6300 pSetExp(p,i,1);
6301 pSetm(p);
6302 l->m[n]=p;
6303 if (n==0) break;
6304 }
6305 }
6306 res->data=(char*)l;
6308 omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6309}
#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 1617 of file iparith.cc.

1618{
1619 void *d;
1620 Subexpr e;
1621 int typ;
1622 BOOLEAN t=FALSE;
1623 idhdl tmp_proc=NULL;
1624 if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1625 {
1626 tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1627 tmp_proc->id="_auto";
1628 tmp_proc->typ=PROC_CMD;
1629 tmp_proc->data.pinf=(procinfo *)u->Data();
1630 tmp_proc->ref=1;
1631 d=u->data; u->data=(void *)tmp_proc;
1632 e=u->e; u->e=NULL;
1633 t=TRUE;
1634 typ=u->rtyp; u->rtyp=IDHDL;
1635 }
1636 BOOLEAN sl;
1637 if (u->req_packhdl==currPack)
1638 sl = iiMake_proc((idhdl)u->data,NULL,v);
1639 else
1640 sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1641 if (t)
1642 {
1643 u->rtyp=typ;
1644 u->data=d;
1645 u->e=e;
1646 omFreeSize(tmp_proc,sizeof(idrec));
1647 }
1648 if (sl) return TRUE;
1649 memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1651 return FALSE;
1652}
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 3340 of file ipshell.cc.

3341{
3342 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3343 (poly)w->CopyD(), currRing);
3344 return errorreported;
3345}
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 6318 of file ipshell.cc.

6319{
6320 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6321 ideal I=(ideal)u->Data();
6322 int i;
6323 int n=0;
6324 for(i=I->nrows*I->ncols-1;i>=0;i--)
6325 {
6326 int n0=pGetVariables(I->m[i],e);
6327 if (n0>n) n=n0;
6328 }
6329 jjINT_S_TO_ID(n,e,res);
6330 return FALSE;
6331}
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6288
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6310 of file ipshell.cc.

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

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

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3301 of file ipshell.cc.

3302{
3303 ideal F=(ideal)id->Data();
3304 intvec * iv = new intvec(rVar(currRing));
3305 polyset s;
3306 int sl, n, i;
3307 int *x;
3308
3309 res->data=(char *)iv;
3310 s = F->m;
3311 sl = IDELEMS(F) - 1;
3312 n = rVar(currRing);
3313 double wNsqr = (double)2.0 / (double)n;
3315 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3316 wCall(s, sl, x, wNsqr, currRing);
3317 for (i = n; i!=0; i--)
3318 (*iv)[i-1] = x[i + n + 1];
3319 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3320 return FALSE;
3321}
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:960
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:6333
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
static int pLength(poly a)
Definition: p_polys.h:188
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 3468 of file ipshell.cc.

3469{
3470 switch( state )
3471 {
3472 case semicListTooShort:
3473 WerrorS( "the list is too short" );
3474 break;
3475 case semicListTooLong:
3476 WerrorS( "the list is too long" );
3477 break;
3478
3480 WerrorS( "first element of the list should be int" );
3481 break;
3483 WerrorS( "second element of the list should be int" );
3484 break;
3486 WerrorS( "third element of the list should be int" );
3487 break;
3489 WerrorS( "fourth element of the list should be intvec" );
3490 break;
3492 WerrorS( "fifth element of the list should be intvec" );
3493 break;
3495 WerrorS( "sixth element of the list should be intvec" );
3496 break;
3497
3498 case semicListNNegative:
3499 WerrorS( "first element of the list should be positive" );
3500 break;
3502 WerrorS( "wrong number of numerators" );
3503 break;
3505 WerrorS( "wrong number of denominators" );
3506 break;
3508 WerrorS( "wrong number of multiplicities" );
3509 break;
3510
3512 WerrorS( "the Milnor number should be positive" );
3513 break;
3515 WerrorS( "the geometrical genus should be nonnegative" );
3516 break;
3518 WerrorS( "all numerators should be positive" );
3519 break;
3521 WerrorS( "all denominators should be positive" );
3522 break;
3524 WerrorS( "all multiplicities should be positive" );
3525 break;
3526
3528 WerrorS( "it is not symmetric" );
3529 break;
3531 WerrorS( "it is not monotonous" );
3532 break;
3533
3535 WerrorS( "the Milnor number is wrong" );
3536 break;
3537 case semicListPGWrong:
3538 WerrorS( "the geometrical genus is wrong" );
3539 break;
3540
3541 default:
3542 WerrorS( "unspecific error" );
3543 break;
3544 }
3545}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4253 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5079 of file ipshell.cc.

5080{
5081 int i,j;
5082 int count= self->roots[0]->getAnzRoots(); // number of roots
5083 int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5084
5085 lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5086
5087 if ( self->found_roots )
5088 {
5089 listofroots->Init( count );
5090
5091 for (i=0; i < count; i++)
5092 {
5093 lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5094 onepoint->Init(elem);
5095 for ( j= 0; j < elem; j++ )
5096 {
5097 if ( !rField_is_long_C(currRing) )
5098 {
5099 onepoint->m[j].rtyp=STRING_CMD;
5100 onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5101 }
5102 else
5103 {
5104 onepoint->m[j].rtyp=NUMBER_CMD;
5105 onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5106 }
5107 onepoint->m[j].next= NULL;
5108 onepoint->m[j].name= NULL;
5109 }
5110 listofroots->m[i].rtyp=LIST_CMD;
5111 listofroots->m[i].data=(void *)onepoint;
5112 listofroots->m[j].next= NULL;
5113 listofroots->m[j].name= NULL;
5114 }
5115
5116 }
5117 else
5118 {
5119 listofroots->Init( 0 );
5120 }
5121
5122 return listofroots;
5123}
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:448
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:545
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 4563 of file ipshell.cc.

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

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4569 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3069 of file ipshell.cc.

3070{
3071 int i,j;
3072 matrix result;
3073 ideal id=(ideal)a->Data();
3074
3076 for (i=1; i<=IDELEMS(id); i++)
3077 {
3078 for (j=1; j<=rVar(currRing); j++)
3079 {
3080 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3081 }
3082 }
3083 res->data=(char *)result;
3084 return FALSE;
3085}
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 3091 of file ipshell.cc.

3092{
3093 int n=(int)(long)b->Data();
3094 int d=(int)(long)c->Data();
3095 int k,l,sign,row,col;
3096 matrix result;
3097 ideal temp;
3098 BOOLEAN bo;
3099 poly p;
3100
3101 if ((d>n) || (d<1) || (n<1))
3102 {
3103 res->data=(char *)mpNew(1,1);
3104 return FALSE;
3105 }
3106 int *choise = (int*)omAlloc(d*sizeof(int));
3107 if (id==NULL)
3108 temp=idMaxIdeal(1);
3109 else
3110 temp=(ideal)id->Data();
3111
3112 k = binom(n,d);
3113 l = k*d;
3114 l /= n-d+1;
3115 result =mpNew(l,k);
3116 col = 1;
3117 idInitChoise(d,1,n,&bo,choise);
3118 while (!bo)
3119 {
3120 sign = 1;
3121 for (l=1;l<=d;l++)
3122 {
3123 if (choise[l-1]<=IDELEMS(temp))
3124 {
3125 p = pCopy(temp->m[choise[l-1]-1]);
3126 if (sign == -1) p = pNeg(p);
3127 sign *= -1;
3128 row = idGetNumberOfChoise(l-1,d,1,n,choise);
3129 MATELEM(result,row,col) = p;
3130 }
3131 }
3132 col++;
3133 idGetNextChoise(d,n,&bo,choise);
3134 }
3135 omFreeSize(choise,d*sizeof(int));
3136 if (id==NULL) idDelete(&temp);
3137
3138 res->data=(char *)result;
3139 return FALSE;
3140}
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:3427

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

4679{
4680 poly gls;
4681 gls= (poly)(arg1->Data());
4682 int howclean= (int)(long)arg3->Data();
4683
4684 if ( gls == NULL || pIsConstant( gls ) )
4685 {
4686 WerrorS("Input polynomial is constant!");
4687 return TRUE;
4688 }
4689
4691 {
4692 int* r=Zp_roots(gls, currRing);
4693 lists rlist;
4694 rlist= (lists)omAlloc( sizeof(slists) );
4695 rlist->Init( r[0] );
4696 for(int i=r[0];i>0;i--)
4697 {
4698 rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4699 rlist->m[i-1].rtyp=NUMBER_CMD;
4700 }
4701 omFree(r);
4702 res->data=rlist;
4703 res->rtyp= LIST_CMD;
4704 return FALSE;
4705 }
4706 if ( !(rField_is_R(currRing) ||
4710 {
4711 WerrorS("Ground field not implemented!");
4712 return TRUE;
4713 }
4714
4717 {
4718 unsigned long int ii = (unsigned long int)arg2->Data();
4719 setGMPFloatDigits( ii, ii );
4720 }
4721
4722 int ldummy;
4723 int deg= currRing->pLDeg( gls, &ldummy, currRing );
4724 int i,vpos=0;
4725 poly piter;
4726 lists elist;
4727
4728 elist= (lists)omAlloc( sizeof(slists) );
4729 elist->Init( 0 );
4730
4731 if ( rVar(currRing) > 1 )
4732 {
4733 piter= gls;
4734 for ( i= 1; i <= rVar(currRing); i++ )
4735 if ( pGetExp( piter, i ) )
4736 {
4737 vpos= i;
4738 break;
4739 }
4740 while ( piter )
4741 {
4742 for ( i= 1; i <= rVar(currRing); i++ )
4743 if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4744 {
4745 WerrorS("The input polynomial must be univariate!");
4746 return TRUE;
4747 }
4748 pIter( piter );
4749 }
4750 }
4751
4752 rootContainer * roots= new rootContainer();
4753 number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4754 piter= gls;
4755 for ( i= deg; i >= 0; i-- )
4756 {
4757 if ( piter && pTotaldegree(piter) == i )
4758 {
4759 pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4760 //nPrint( pcoeffs[i] );PrintS(" ");
4761 pIter( piter );
4762 }
4763 else
4764 {
4765 pcoeffs[i]= nInit(0);
4766 }
4767 }
4768
4769#ifdef mprDEBUG_PROT
4770 for (i=deg; i >= 0; i--)
4771 {
4772 nPrint( pcoeffs[i] );PrintS(" ");
4773 }
4774 PrintLn();
4775#endif
4776
4777 roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4778 roots->solver( howclean );
4779
4780 int elem= roots->getAnzRoots();
4781 char *dummy;
4782 int j;
4783
4784 lists rlist;
4785 rlist= (lists)omAlloc( sizeof(slists) );
4786 rlist->Init( elem );
4787
4789 {
4790 for ( j= 0; j < elem; j++ )
4791 {
4792 rlist->m[j].rtyp=NUMBER_CMD;
4793 rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4794 //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4795 }
4796 }
4797 else
4798 {
4799 for ( j= 0; j < elem; j++ )
4800 {
4801 dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4802 rlist->m[j].rtyp=STRING_CMD;
4803 rlist->m[j].data=(void *)dummy;
4804 }
4805 }
4806
4807 elist->Clean();
4808 //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4809
4810 // this is (via fillContainer) the same data as in root
4811 //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4812 //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4813
4814 delete roots;
4815
4816 res->data= (void*)rlist;
4817
4818 return FALSE;
4819}
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:535
#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:518
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:500
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:506

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

4656{
4657 ideal gls = (ideal)(arg1->Data());
4658 int imtype= (int)(long)arg2->Data();
4659
4660 uResultant::resMatType mtype= determineMType( imtype );
4661
4662 // check input ideal ( = polynomial system )
4663 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4664 {
4665 return TRUE;
4666 }
4667
4668 uResultant *resMat= new uResultant( gls, mtype, false );
4669 if (resMat!=NULL)
4670 {
4671 res->rtyp = MODUL_CMD;
4672 res->data= (void*)resMat->accessResMat()->getMatrix();
4673 if (!errorreported) delete resMat;
4674 }
4675 return errorreported;
4676}
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 4922 of file ipshell.cc.

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

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

6334{
6335 Print(" %s (",n);
6336 switch (p->language)
6337 {
6338 case LANG_SINGULAR: PrintS("S"); break;
6339 case LANG_C: PrintS("C"); break;
6340 case LANG_TOP: PrintS("T"); break;
6341 case LANG_MAX: PrintS("M"); break;
6342 case LANG_NONE: PrintS("N"); break;
6343 default: PrintS("U");
6344 }
6345 if(p->libname!=NULL)
6346 Print(",%s", p->libname);
6347 PrintS(")");
6348}
@ 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
2896 R->cf = nInitChar(n_transExt, &extParam);
2897 }
2898 }
2899 }
2900 }
2901 else
2902 {
2903 WerrorS("coefficient field must be described by `int` or `list`");
2904 goto rCompose_err;
2905 }
2906
2907 if( R->cf == NULL )
2908 {
2909 WerrorS("could not create coefficient field described by the input!");
2910 goto rCompose_err;
2911 }
2912
2913 // ------------------------- VARS ---------------------------
2914 if (rComposeVar(L,R)) goto rCompose_err;
2915 // ------------------------ ORDER ------------------------------
2916 if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2917
2918 // ------------------------ ??????? --------------------
2919
2920 if (!isLetterplace) rRenameVars(R);
2921 #ifdef HAVE_SHIFTBBA
2922 else
2923 {
2924 R->isLPring=isLetterplace;
2925 R->ShortOut=FALSE;
2926 R->CanShortOut=FALSE;
2927 }
2928 #endif
2929 if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2930 rComplete(R);
2931
2932 // ------------------------ Q-IDEAL ------------------------
2933
2934 if (L->m[3].Typ()==IDEAL_CMD)
2935 {
2936 ideal q=(ideal)L->m[3].Data();
2937 if (q->m[0]!=NULL)
2938 {
2939 if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2940 {
2941 #if 0
2942 WerrorS("coefficient fields must be equal if q-ideal !=0");
2943 goto rCompose_err;
2944 #else
2945 ring orig_ring=currRing;
2947 int *perm=NULL;
2948 int *par_perm=NULL;
2949 int par_perm_size=0;
2950 nMapFunc nMap;
2951
2952 if ((nMap=nSetMap(orig_ring->cf))==NULL)
2953 {
2954 if (rEqual(orig_ring,currRing))
2955 {
2956 nMap=n_SetMap(currRing->cf, currRing->cf);
2957 }
2958 else
2959 // Allow imap/fetch to be make an exception only for:
2960 if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2964 ||
2965 (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2966 (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2967 rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2968 {
2969 par_perm_size=rPar(orig_ring);
2970
2971// if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2972// naSetChar(rInternalChar(orig_ring),orig_ring);
2973// else ntSetChar(rInternalChar(orig_ring),orig_ring);
2974
2975 nSetChar(currRing->cf);
2976 }
2977 else
2978 {
2979 WerrorS("coefficient fields must be equal if q-ideal !=0");
2980 goto rCompose_err;
2981 }
2982 }
2983 perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2984 if (par_perm_size!=0)
2985 par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2986 int i;
2987 #if 0
2988 // use imap:
2989 maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2990 currRing->names,currRing->N,currRing->parameter, currRing->P,
2991 perm,par_perm, currRing->ch);
2992 #else
2993 // use fetch
2994 if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2995 {
2996 for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2997 }
2998 else if (par_perm_size!=0)
2999 for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3000 for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3001 #endif
3002 ideal dest_id=idInit(IDELEMS(q),1);
3003 for(i=IDELEMS(q)-1; i>=0; i--)
3004 {
3005 dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3006 par_perm,par_perm_size);
3007 // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3008 pTest(dest_id->m[i]);
3009 }
3010 R->qideal=dest_id;
3011 if (perm!=NULL)
3012 omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3013 if (par_perm!=NULL)
3014 omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3015 rChangeCurrRing(orig_ring);
3016 #endif
3017 }
3018 else
3019 R->qideal=idrCopyR(q,currRing,R);
3020 }
3021 }
3022 else
3023 {
3024 WerrorS("q-ideal must be given as `ideal`");
3025 goto rCompose_err;
3026 }
3027
3028
3029 // ---------------------------------------------------------------
3030 #ifdef HAVE_PLURAL
3031 if (L->nr==5)
3032 {
3033 if (nc_CallPlural((matrix)L->m[4].Data(),
3034 (matrix)L->m[5].Data(),
3035 NULL,NULL,
3036 R,
3037 true, // !!!
3038 true, false,
3039 currRing, FALSE)) goto rCompose_err;
3040 // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3041 }
3042 #endif
3043 return R;
3044
3045rCompose_err:
3046 if (R->N>0)
3047 {
3048 int i;
3049 if (R->names!=NULL)
3050 {
3051 i=R->N-1;
3052 while (i>=0) { omfree(R->names[i]); i--; }
3053 omFree(R->names);
3054 }
3055 }
3056 omfree(R->order);
3057 omfree(R->block0);
3058 omfree(R->block1);
3059 omfree(R->wvhdl);
3060 omFree(R);
3061 return NULL;
3062}
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:413
const unsigned short fftable[]
Definition: ffields.cc:27
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:437
const char * GFPar_name
Definition: coeffs.h:96
int GFChar
Definition: coeffs.h:94
Creation data needed for finite fields.
Definition: coeffs.h:93
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
#define info
Definition: libparse.cc:1256
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:2690
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:4130
#define pTest(p)
Definition: polys.h:414
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:3450
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:529
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:512
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:599
static int rInternalChar(const ring r)
Definition: ring.h:689
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:539
#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:544
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:403
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:5086
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:548
#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:907
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:625
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:515
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:521
#define rField_is_Ring(R)
Definition: ring.h:485

◆ 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:57
static int rBlocks(const ring r)
Definition: ring.h:568

◆ 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:836
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:829
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:775
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:727
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1819
static 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:891

◆ 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],n_Copy((number)(r->qideal->m[0]),R->cf));
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:915
#define pSetCoeff0(p, n)
Definition: monomials.h:59
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1318

◆ 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:539
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:509

◆ rDecomposeRing_41()

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

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:813

◆ 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:6269

◆ rInit()

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

Definition at line 5625 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6226 of file ipshell.cc.

6227{
6228 ring r = IDRING(h);
6229 int ref=0;
6230 if (r!=NULL)
6231 {
6232 // avoid, that sLastPrinted is the last reference to the base ring:
6233 // clean up before killing the last "named" refrence:
6235 && (sLastPrinted.data==(void*)r))
6236 {
6238 }
6239 ref=r->ref;
6240 if ((ref<=0)&&(r==currRing))
6241 {
6242 // cleanup DENOMINATOR_LIST
6244 {
6246 if (TEST_V_ALLWARN)
6247 Warn("deleting denom_list for ring change from %s",IDID(h));
6248 do
6249 {
6250 n_Delete(&(dd->n),currRing->cf);
6251 dd=dd->next;
6254 } while(DENOMINATOR_LIST!=NULL);
6255 }
6256 }
6257 rKill(r);
6258 }
6259 if (h==currRingHdl)
6260 {
6261 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6262 else
6263 {
6265 }
6266 }
6267}
void rKill(ring r)
Definition: ipshell.cc:6180
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 6180 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5186 of file ipshell.cc.

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

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

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

◆ rSimpleFindHdl()

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

Definition at line 6269 of file ipshell.cc.

6270{
6271 idhdl h=root;
6272 while (h!=NULL)
6273 {
6274 if ((IDTYP(h)==RING_CMD)
6275 && (h!=n)
6276 && (IDRING(h)==r)
6277 )
6278 {
6279 return h;
6280 }
6281 h=IDNEXT(h);
6282 }
6283 return NULL;
6284}

◆ rSleftvList2StringArray()

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

Definition at line 5577 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5305 of file ipshell.cc.

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

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

◆ semicProc()

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

Definition at line 4551 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4511 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4428 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3810 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4184 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3384 of file ipshell.cc.

3385{
3387 copy_deep( result, l );
3388 return result;
3389}
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3360

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4102 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4133 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3569 of file ipshell.cc.

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

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3170 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3147 of file ipshell.cc.

3148{
3149 syStrategy syzstr=(syStrategy)u->Data();
3150
3151 BOOLEAN minim=(int)(long)w->Data();
3152 int row_shift=0;
3153 int add_row_shift=0;
3154 intvec *weights=NULL;
3155 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3156 if (ww!=NULL)
3157 {
3158 weights=ivCopy(ww);
3159 add_row_shift = ww->min_in();
3160 (*weights) -= add_row_shift;
3161 }
3162
3163 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3164 //row_shift += add_row_shift;
3165 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3166 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3167
3168 return FALSE;
3169}
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 3254 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3182 of file ipshell.cc.

3183{
3184 resolvente fullres = syzstr->fullres;
3185 resolvente minres = syzstr->minres;
3186
3187 const int length = syzstr->length;
3188
3189 if ((fullres==NULL) && (minres==NULL))
3190 {
3191 if (syzstr->hilb_coeffs==NULL)
3192 { // La Scala
3193 fullres = syReorder(syzstr->res, length, syzstr);
3194 }
3195 else
3196 { // HRES
3197 minres = syReorder(syzstr->orderedRes, length, syzstr);
3198 syKillEmptyEntres(minres, length);
3199 }
3200 }
3201
3202 resolvente tr;
3203 int typ0=IDEAL_CMD;
3204
3205 if (minres!=NULL)
3206 tr = minres;
3207 else
3208 tr = fullres;
3209
3210 resolvente trueres=NULL;
3211 intvec ** w=NULL;
3212
3213 if (length>0)
3214 {
3215 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3216 for (int i=length-1;i>=0;i--)
3217 {
3218 if (tr[i]!=NULL)
3219 {
3220 trueres[i] = idCopy(tr[i]);
3221 }
3222 }
3223 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3224 typ0 = MODUL_CMD;
3225 if (syzstr->weights!=NULL)
3226 {
3227 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3228 for (int i=length-1;i>=0;i--)
3229 {
3230 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3231 }
3232 }
3233 }
3234
3235 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3236 w, add_row_shift);
3237
3238 if (toDel)
3239 syKillComputation(syzstr);
3240 else
3241 {
3242 if( fullres != NULL && syzstr->fullres == NULL )
3243 syzstr->fullres = fullres;
3244
3245 if( minres != NULL && syzstr->minres == NULL )
3246 syzstr->minres = minres;
3247 }
3248 return li;
3249}
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:2198
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

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