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

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

enum  semicState {
  semicOK , semicMulNegative , semicListTooShort , semicListTooLong ,
  semicListFirstElementWrongType , semicListSecondElementWrongType , semicListThirdElementWrongType , semicListFourthElementWrongType ,
  semicListFifthElementWrongType , semicListSixthElementWrongType , semicListNNegative , semicListWrongNumberOfNumerators ,
  semicListWrongNumberOfDenominators , semicListWrongNumberOfMultiplicities , semicListMuNegative , semicListPgNegative ,
  semicListNumNegative , semicListDenNegative , semicListMulNegative , semicListNotSymmetric ,
  semicListNotMonotonous , semicListMilnorWrong , semicListPGWrong
}
 
enum  spectrumState {
  spectrumOK , spectrumZero , spectrumBadPoly , spectrumNoSingularity ,
  spectrumNotIsolated , spectrumDegenerate , spectrumWrongRing , spectrumNoHC ,
  spectrumUnspecErr
}
 

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
static idhdl rSimpleFindHdl (const ring r, const idhdl root, const idhdl n)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rDecomposeCF (leftv h, const ring r, const ring R)
 
static void rDecomposeC_41 (leftv h, const coeffs C)
 
static void rDecomposeC (leftv h, const ring R)
 
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 1065 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3436 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3552 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3362 of file ipshell.cc.

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

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

◆ getList()

lists getList ( spectrum spec)

Definition at line 3398 of file ipshell.cc.

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

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

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6384 of file ipshell.cc.

6385{
6386 WerrorS("not implemented");
6387 return TRUE;
6388}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6389 of file ipshell.cc.

6390{
6391 WerrorS("not implemented");
6392 return TRUE;
6393}

◆ iiApplyINTVEC()

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

Definition at line 6352 of file ipshell.cc.

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

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

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6517 of file ipshell.cc.

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

1275{
1276 // must be inside a proc, as we simultae an proc_end at the end
1277 if (myynest==0)
1278 {
1279 WerrorS("branchTo can only occur in a proc");
1280 return TRUE;
1281 }
1282 // <string1...stringN>,<proc>
1283 // known: args!=NULL, l>=1
1284 int l=args->listLength();
1285 int ll=0;
1287 if (ll!=(l-1)) return FALSE;
1288 leftv h=args;
1289 // set up the table for type test:
1290 short *t=(short*)omAlloc(l*sizeof(short));
1291 t[0]=l-1;
1292 int b;
1293 int i;
1294 for(i=1;i<l;i++,h=h->next)
1295 {
1296 if (h->Typ()!=STRING_CMD)
1297 {
1298 omFreeBinAddr(t);
1299 Werror("arg %d is not a string",i);
1300 return TRUE;
1301 }
1302 int tt;
1303 b=IsCmd((char *)h->Data(),tt);
1304 if(b) t[i]=tt;
1305 else
1306 {
1307 omFreeBinAddr(t);
1308 Werror("arg %d is not a type name",i);
1309 return TRUE;
1310 }
1311 }
1312 if (h->Typ()!=PROC_CMD)
1313 {
1314 omFreeBinAddr(t);
1315 Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1316 i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1317 return TRUE;
1318 }
1320 omFreeBinAddr(t);
1321 if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1322 {
1323 // get the proc:
1324 iiCurrProc=(idhdl)h->data;
1325 idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1326 procinfo * pi=IDPROC(currProc);
1327 // already loaded ?
1328 if( pi->data.s.body==NULL )
1329 {
1331 if (pi->data.s.body==NULL) return TRUE;
1332 }
1333 // set currPackHdl/currPack
1334 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1335 {
1336 currPack=pi->pack;
1339 //Print("set pack=%s\n",IDID(currPackHdl));
1340 }
1341 // see iiAllStart:
1342 BITSET save1=si_opt_1;
1343 BITSET save2=si_opt_2;
1344 newBuffer( omStrDup(pi->data.s.body), BT_proc,
1345 pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1346 BOOLEAN err=yyparse();
1348 si_opt_1=save1;
1349 si_opt_2=save2;
1350 // now save the return-expr.
1352 memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1354 // warning about args.:
1355 if (iiCurrArgs!=NULL)
1356 {
1357 if (err==0) Warn("too many arguments for %s",IDID(currProc));
1361 }
1362 // similate proc_end:
1363 // - leave input
1364 void myychangebuffer();
1366 // - set the current buffer to its end (this is a pointer in a buffer,
1367 // not a file ptr) "branchTo" is only valid in proc)
1369 // - kill local vars
1371 // - return
1372 newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1373 return (err!=0);
1374 }
1375 return FALSE;
1376}
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:9547
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:1631
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:6575
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 1631 of file ipshell.cc.

1632{
1633 if (p!=basePack)
1634 {
1635 idhdl t=basePack->idroot;
1636 while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1637 if (t==NULL)
1638 {
1639 WarnS("package not found\n");
1640 p=basePack;
1641 }
1642 }
1643}
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 1587 of file ipshell.cc.

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

◆ iiCheckTypes()

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

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

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

Definition at line 6575 of file ipshell.cc.

6576{
6577 int l=0;
6578 if (args==NULL)
6579 {
6580 if (type_list[0]==0) return TRUE;
6581 }
6582 else l=args->listLength();
6583 if (l!=(int)type_list[0])
6584 {
6585 if (report) iiReportTypes(0,l,type_list);
6586 return FALSE;
6587 }
6588 for(int i=1;i<=l;i++,args=args->next)
6589 {
6590 short t=type_list[i];
6591 if (t!=ANY_TYPE)
6592 {
6593 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6594 || (t!=args->Typ()))
6595 {
6596 if (report) iiReportTypes(i,args->Typ(),type_list);
6597 return FALSE;
6598 }
6599 }
6600 }
6601 return TRUE;
6602}
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6557
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 937 of file ipshell.cc.

938{
939 int i;
940 resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
941
942 for (i=0; i<l; i++)
943 if (r[i]!=NULL) res[i]=idCopy(r[i]);
944 return res;
945}
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 1066 of file ipshell.cc.

1067{
1068#ifdef HAVE_SDB
1069 sdb_flags=1;
1070#endif
1071 Print("\n-- break point in %s --\n",VoiceName());
1073 char * s;
1075 s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1076 loop
1077 {
1078 memset(s,0,BREAK_LINE_LENGTH+4);
1080 if (s[BREAK_LINE_LENGTH-1]!='\0')
1081 {
1082 Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1083 }
1084 else
1085 break;
1086 }
1087 if (*s=='\n')
1088 {
1090 }
1091#if MDEBUG
1092 else if(strncmp(s,"cont;",5)==0)
1093 {
1095 }
1096#endif /* MDEBUG */
1097 else
1098 {
1099 strcat( s, "\n;~\n");
1101 }
1102}
#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:1064
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:1065
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 1199 of file ipshell.cc.

1200{
1202 BOOLEAN is_qring=FALSE;
1203 const char *id = name->name;
1204
1205 sy->Init();
1206 if ((name->name==NULL)||(isdigit(name->name[0])))
1207 {
1208 WerrorS("object to declare is not a name");
1209 res=TRUE;
1210 }
1211 else
1212 {
1213 if (root==NULL) return TRUE;
1214 if (*root!=IDROOT)
1215 {
1216 if ((currRing==NULL) || (*root!=currRing->idroot))
1217 {
1218 Werror("can not define `%s` in other package",name->name);
1219 return TRUE;
1220 }
1221 }
1222 if (t==QRING_CMD)
1223 {
1224 t=RING_CMD; // qring is always RING_CMD
1225 is_qring=TRUE;
1226 }
1227
1228 if (TEST_V_ALLWARN
1229 && (name->rtyp!=0)
1230 && (name->rtyp!=IDHDL)
1232 {
1233 Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1235 }
1236 {
1237 sy->data = (char *)enterid(id,lev,t,root,init_b);
1238 }
1239 if (sy->data!=NULL)
1240 {
1241 sy->rtyp=IDHDL;
1242 currid=sy->name=IDID((idhdl)sy->data);
1243 if (is_qring)
1244 {
1246 }
1247 // name->name=NULL; /* used in enterid */
1248 //sy->e = NULL;
1249 if (name->next!=NULL)
1250 {
1252 res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1253 }
1254 }
1255 else res=TRUE;
1256 }
1257 name->CleanUp();
1258 return res;
1259}
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:142
#define Sy_bit(x)
Definition: options.h:31
@ QRING_CMD
Definition: tok.h:158

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1261 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1512 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1535 of file ipshell.cc.

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

1608{
1609 int i;
1610 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1611 poly po=NULL;
1613 {
1614 scComputeHC(I,currRing->qideal,ak,po);
1615 if (po!=NULL)
1616 {
1617 pGetCoeff(po)=nInit(1);
1618 for (i=rVar(currRing); i>0; i--)
1619 {
1620 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1621 }
1622 pSetComp(po,ak);
1623 pSetm(po);
1624 }
1625 }
1626 else
1627 po=pOne();
1628 return po;
1629}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition: hdegree.cc:1100
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:177
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:762

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1413 of file ipshell.cc.

1414{
1415 idhdl h=(idhdl)v->data;
1416 //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1417 if (IDLEV(h)==0)
1418 {
1419 if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1420 }
1421 else
1422 {
1423 h=IDROOT->get(v->name,toLev);
1424 idhdl *root=&IDROOT;
1425 if ((h==NULL)&&(currRing!=NULL))
1426 {
1427 h=currRing->idroot->get(v->name,toLev);
1428 root=&currRing->idroot;
1429 }
1430 BOOLEAN keepring=FALSE;
1431 if ((h!=NULL)&&(IDLEV(h)==toLev))
1432 {
1433 if (IDTYP(h)==v->Typ())
1434 {
1435 if ((IDTYP(h)==RING_CMD)
1436 && (v->Data()==IDDATA(h)))
1437 {
1439 keepring=TRUE;
1440 IDLEV(h)=toLev;
1441 //WarnS("keepring");
1442 return FALSE;
1443 }
1444 if (BVERBOSE(V_REDEFINE))
1445 {
1446 Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1447 }
1448 if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1449 killhdl2(h,root,currRing);
1450 }
1451 else
1452 {
1453 WerrorS("object with a different type exists");
1454 return TRUE;
1455 }
1456 }
1457 h=(idhdl)v->data;
1458 IDLEV(h)=toLev;
1459 if (keepring) rDecRefCnt(IDRING(h));
1461 //Print("export %s\n",IDID(h));
1462 }
1463 return FALSE;
1464}
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:840
static void rDecRefCnt(ring r)
Definition: ring.h:841

◆ iiInternalExport() [2/2]

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

Definition at line 1466 of file ipshell.cc.

1467{
1468 idhdl h=(idhdl)v->data;
1469 if(h==NULL)
1470 {
1471 Warn("'%s': no such identifier\n", v->name);
1472 return FALSE;
1473 }
1474 package frompack=v->req_packhdl;
1475 if (frompack==NULL) frompack=currPack;
1476 if ((RingDependend(IDTYP(h)))
1477 || ((IDTYP(h)==LIST_CMD)
1478 && (lRingDependend(IDLIST(h)))
1479 )
1480 )
1481 {
1482 //Print("// ==> Ringdependent set nesting to 0\n");
1483 return (iiInternalExport(v, toLev));
1484 }
1485 else
1486 {
1487 IDLEV(h)=toLev;
1488 v->req_packhdl=rootpack;
1489 if (h==frompack->idroot)
1490 {
1491 frompack->idroot=h->next;
1492 }
1493 else
1494 {
1495 idhdl hh=frompack->idroot;
1496 while ((hh!=NULL) && (hh->next!=h))
1497 hh=hh->next;
1498 if ((hh!=NULL) && (hh->next==h))
1499 hh->next=h->next;
1500 else
1501 {
1502 Werror("`%s` not found",v->Name());
1503 return TRUE;
1504 }
1505 }
1506 h->next=rootpack->idroot;
1507 rootpack->idroot=h;
1508 }
1509 return FALSE;
1510}
#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 size_t len=strlen(name)+5;
854 char * s=(char *)omAlloc(len);
855
856 while (i<=L->nr)
857 {
858 snprintf(s,len,"%s(%d)",name,i+1);
859 if (i==0)
860 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
861 else
863 if (h!=NULL)
864 {
865 h->data.uideal=(ideal)L->m[i].data;
866 h->attribute=L->m[i].attribute;
868 Print("//defining: %s as %d-th syzygy module\n",s,i+1);
869 }
870 else
871 {
872 idDelete((ideal *)&(L->m[i].data));
873 Warn("cannot define %s",s);
874 }
875 //L->m[i].data=NULL;
876 //L->m[i].rtyp=0;
877 //L->m[i].attribute=NULL;
878 i++;
879 }
880 omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
882 omFreeSize((ADDRESS)s,strlen(name)+5);
883}
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:488
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:233
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:901
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:846
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1507
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 1377 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1038 of file ipshell.cc.

1039{
1040 int len,reg,typ0;
1041
1042 resolvente r=liFindRes(L,&len,&typ0);
1043
1044 if (r==NULL)
1045 return -2;
1046 intvec *weights=NULL;
1047 int add_row_shift=0;
1048 intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1049 if (ww!=NULL)
1050 {
1051 weights=ivCopy(ww);
1052 add_row_shift = ww->min_in();
1053 (*weights) -= add_row_shift;
1054 }
1055 //Print("attr:%x\n",weights);
1056
1057 intvec *dummy=syBetti(r,len,&reg,weights);
1058 if (weights!=NULL) delete weights;
1059 delete dummy;
1060 omFreeSize((ADDRESS)r,len*sizeof(ideal));
1061 return reg+1+add_row_shift;
1062}
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:771

◆ iiReportTypes()

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

Definition at line 6557 of file ipshell.cc.

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

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

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

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

◆ jjBETTI2()

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

Definition at line 1002 of file ipshell.cc.

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

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3349 of file ipshell.cc.

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

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

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

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

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6312 of file ipshell.cc.

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

◆ 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:1702
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 3325 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3303 of file ipshell.cc.

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

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4255 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5081 of file ipshell.cc.

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

4566{
4567 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4568 return FALSE;
4569}
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 4571 of file ipshell.cc.

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

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

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

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

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

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

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

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

6336{
6337 Print(" %s (",n);
6338 switch (p->language)
6339 {
6340 case LANG_SINGULAR: PrintS("S"); break;
6341 case LANG_C: PrintS("C"); break;
6342 case LANG_TOP: PrintS("T"); break;
6343 case LANG_MAX: PrintS("M"); break;
6344 case LANG_NONE: PrintS("N"); break;
6345 default: PrintS("U");
6346 }
6347 if(p->libname!=NULL)
6348 Print(",%s", p->libname);
6349 PrintS(")");
6350}
@ 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 2785 of file ipshell.cc.

2786{
2787 if ((L->nr!=3)
2788#ifdef HAVE_PLURAL
2789 &&(L->nr!=5)
2790#endif
2791 )
2792 return NULL;
2793 int is_gf_char=0;
2794 // 0: char/ cf - ring
2795 // 1: list (var)
2796 // 2: list (ord)
2797 // 3: qideal
2798 // possibly:
2799 // 4: C
2800 // 5: D
2801
2802 ring R = (ring) omAlloc0Bin(sip_sring_bin);
2803
2804 // ------------------------------------------------------------------
2805 // 0: char:
2806 if (L->m[0].Typ()==CRING_CMD)
2807 {
2808 R->cf=(coeffs)L->m[0].Data();
2809 R->cf->ref++;
2810 }
2811 else if (L->m[0].Typ()==INT_CMD)
2812 {
2813 int ch = (int)(long)L->m[0].Data();
2814 assume( ch >= 0 );
2815
2816 if (ch == 0) // Q?
2817 R->cf = nInitChar(n_Q, NULL);
2818 else
2819 {
2820 int l = IsPrime(ch); // Zp?
2821 if( l != ch )
2822 {
2823 Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2824 ch = l;
2825 }
2826 #ifndef TEST_ZN_AS_ZP
2827 R->cf = nInitChar(n_Zp, (void*)(long)ch);
2828 #else
2829 mpz_t modBase;
2830 mpz_init_set_ui(modBase,(long) ch);
2831 ZnmInfo info;
2832 info.base= modBase;
2833 info.exp= 1;
2834 R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2835 R->cf->is_field=1;
2836 R->cf->is_domain=1;
2837 R->cf->has_simple_Inverse=1;
2838 #endif
2839 }
2840 }
2841 else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2842 {
2843 lists LL=(lists)L->m[0].Data();
2844
2845#ifdef HAVE_RINGS
2846 if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2847 {
2848 rComposeRing(LL, R); // Ring!?
2849 }
2850 else
2851#endif
2852 if (LL->nr < 3)
2853 rComposeC(LL,R); // R, long_R, long_C
2854 else
2855 {
2856 if (LL->m[0].Typ()==INT_CMD)
2857 {
2858 int ch = (int)(long)LL->m[0].Data();
2859 while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2860 if (fftable[is_gf_char]==0) is_gf_char=-1;
2861
2862 if(is_gf_char!= -1)
2863 {
2864 GFInfo param;
2865
2866 param.GFChar = ch;
2867 param.GFDegree = 1;
2868 param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2869
2870 // nfInitChar should be able to handle the case when ch is in fftables!
2871 R->cf = nInitChar(n_GF, (void*)&param);
2872 }
2873 }
2874
2875 if( R->cf == NULL )
2876 {
2877 ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2878
2879 if (extRing==NULL)
2880 {
2881 WerrorS("could not create the specified coefficient field");
2882 goto rCompose_err;
2883 }
2884
2885 if( extRing->qideal != NULL ) // Algebraic extension
2886 {
2887 AlgExtInfo extParam;
2888
2889 extParam.r = extRing;
2890
2891 R->cf = nInitChar(n_algExt, (void*)&extParam);
2892 }
2893 else // Transcendental extension
2894 {
2895 TransExtInfo extParam;
2896 extParam.r = extRing;
2897
2898 R->cf = nInitChar(n_transExt, &extParam);
2899 }
2900 }
2901 }
2902 }
2903 else
2904 {
2905 WerrorS("coefficient field must be described by `int` or `list`");
2906 goto rCompose_err;
2907 }
2908
2909 if( R->cf == NULL )
2910 {
2911 WerrorS("could not create coefficient field described by the input!");
2912 goto rCompose_err;
2913 }
2914
2915 // ------------------------- VARS ---------------------------
2916 if (rComposeVar(L,R)) goto rCompose_err;
2917 // ------------------------ ORDER ------------------------------
2918 if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2919
2920 // ------------------------ ??????? --------------------
2921
2922 if (!isLetterplace) rRenameVars(R);
2923 #ifdef HAVE_SHIFTBBA
2924 else
2925 {
2926 R->isLPring=isLetterplace;
2927 R->ShortOut=FALSE;
2928 R->CanShortOut=FALSE;
2929 }
2930 #endif
2931 if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2932 rComplete(R);
2933
2934 // ------------------------ Q-IDEAL ------------------------
2935
2936 if (L->m[3].Typ()==IDEAL_CMD)
2937 {
2938 ideal q=(ideal)L->m[3].Data();
2939 if (q->m[0]!=NULL)
2940 {
2941 if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2942 {
2943 #if 0
2944 WerrorS("coefficient fields must be equal if q-ideal !=0");
2945 goto rCompose_err;
2946 #else
2947 ring orig_ring=currRing;
2949 int *perm=NULL;
2950 int *par_perm=NULL;
2951 int par_perm_size=0;
2952 nMapFunc nMap;
2953
2954 if ((nMap=nSetMap(orig_ring->cf))==NULL)
2955 {
2956 if (rEqual(orig_ring,currRing))
2957 {
2958 nMap=n_SetMap(currRing->cf, currRing->cf);
2959 }
2960 else
2961 // Allow imap/fetch to be make an exception only for:
2962 if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2966 ||
2967 (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2968 (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2969 rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2970 {
2971 par_perm_size=rPar(orig_ring);
2972
2973// if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2974// naSetChar(rInternalChar(orig_ring),orig_ring);
2975// else ntSetChar(rInternalChar(orig_ring),orig_ring);
2976
2977 nSetChar(currRing->cf);
2978 }
2979 else
2980 {
2981 WerrorS("coefficient fields must be equal if q-ideal !=0");
2982 goto rCompose_err;
2983 }
2984 }
2985 perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2986 if (par_perm_size!=0)
2987 par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2988 int i;
2989 #if 0
2990 // use imap:
2991 maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2992 currRing->names,currRing->N,currRing->parameter, currRing->P,
2993 perm,par_perm, currRing->ch);
2994 #else
2995 // use fetch
2996 if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2997 {
2998 for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2999 }
3000 else if (par_perm_size!=0)
3001 for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3002 for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3003 #endif
3004 ideal dest_id=idInit(IDELEMS(q),1);
3005 for(i=IDELEMS(q)-1; i>=0; i--)
3006 {
3007 dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3008 par_perm,par_perm_size);
3009 // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3010 pTest(dest_id->m[i]);
3011 }
3012 R->qideal=dest_id;
3013 if (perm!=NULL)
3014 omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3015 if (par_perm!=NULL)
3016 omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3017 rChangeCurrRing(orig_ring);
3018 #endif
3019 }
3020 else
3021 R->qideal=idrCopyR(q,currRing,R);
3022 }
3023 }
3024 else
3025 {
3026 WerrorS("q-ideal must be given as `ideal`");
3027 goto rCompose_err;
3028 }
3029
3030
3031 // ---------------------------------------------------------------
3032 #ifdef HAVE_PLURAL
3033 if (L->nr==5)
3034 {
3035 if (nc_CallPlural((matrix)L->m[4].Data(),
3036 (matrix)L->m[5].Data(),
3037 NULL,NULL,
3038 R,
3039 true, // !!!
3040 true, false,
3041 currRing, FALSE)) goto rCompose_err;
3042 // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3043 }
3044 #endif
3045 return R;
3046
3047rCompose_err:
3048 if (R->N>0)
3049 {
3050 int i;
3051 if (R->names!=NULL)
3052 {
3053 i=R->N-1;
3054 while (i>=0) { omfree(R->names[i]); i--; }
3055 omFree(R->names);
3056 }
3057 }
3058 omfree(R->order);
3059 omfree(R->block0);
3060 omfree(R->block1);
3061 omfree(R->wvhdl);
3062 omFree(R);
3063 return NULL;
3064}
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:414
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
const ExtensionInfo & info
< [in] sqrfree poly
static void rRenameVars(ring R)
Definition: ipshell.cc:2406
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2261
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2493
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2785
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2313
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2448
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type,...
Definition: old.gring.cc:2692
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:3459
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 2261 of file ipshell.cc.

2263{
2264 // ----------------------------------------
2265 // 0: char/ cf - ring
2266 if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2267 {
2268 WerrorS("invalid coeff. field description, expecting 0");
2269 return;
2270 }
2271// R->cf->ch=0;
2272 // ----------------------------------------
2273 // 0, (r1,r2) [, "i" ]
2274 if (L->m[1].rtyp!=LIST_CMD)
2275 {
2276 WerrorS("invalid coeff. field description, expecting precision list");
2277 return;
2278 }
2279 lists LL=(lists)L->m[1].data;
2280 if ((LL->nr!=1)
2281 || (LL->m[0].rtyp!=INT_CMD)
2282 || (LL->m[1].rtyp!=INT_CMD))
2283 {
2284 WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2285 return;
2286 }
2287 int r1=(int)(long)LL->m[0].data;
2288 int r2=(int)(long)LL->m[1].data;
2289 r1=si_min(r1,32767);
2290 r2=si_min(r2,32767);
2291 LongComplexInfo par; memset(&par, 0, sizeof(par));
2292 par.float_len=r1;
2293 par.float_len2=r2;
2294 if (L->nr==2) // complex
2295 {
2296 if (L->m[2].rtyp!=STRING_CMD)
2297 {
2298 WerrorS("invalid coeff. field description, expecting parameter name");
2299 return;
2300 }
2301 par.par_name=(char*)L->m[2].data;
2302 R->cf = nInitChar(n_long_C, &par);
2303 }
2304 else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2305 R->cf = nInitChar(n_R, NULL);
2306 else /* && L->nr==1*/
2307 {
2308 R->cf = nInitChar(n_long_R, &par);
2309 }
2310}
@ 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 2493 of file ipshell.cc.

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

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

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2162 of file ipshell.cc.

2163{
2164 assume( r != NULL );
2165 const coeffs C = r->cf;
2166 assume( C != NULL );
2167
2168 // sanity check: require currRing==r for rings with polynomial data
2169 if ( (r!=currRing) && (
2170 (nCoeff_is_algExt(C) && (C != currRing->cf))
2171 || (r->qideal != NULL)
2172#ifdef HAVE_PLURAL
2173 || (rIsPluralRing(r))
2174#endif
2175 )
2176 )
2177 {
2178 WerrorS("ring with polynomial data must be the base ring or compatible");
2179 return NULL;
2180 }
2181 // 0: char/ cf - ring
2182 // 1: list (var)
2183 // 2: list (ord)
2184 // 3: qideal
2185 // possibly:
2186 // 4: C
2187 // 5: D
2189 if (rIsPluralRing(r))
2190 L->Init(6);
2191 else
2192 L->Init(4);
2193 // ----------------------------------------
2194 // 0: char/ cf - ring
2195 if (rField_is_numeric(r))
2196 {
2197 rDecomposeC(&(L->m[0]),r);
2198 }
2199 else if (rField_is_Ring(r))
2200 {
2201 rDecomposeRing(&(L->m[0]),r);
2202 }
2203 else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2204 {
2205 rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2206 }
2207 else if(rField_is_GF(r))
2208 {
2210 Lc->Init(4);
2211 // char:
2212 Lc->m[0].rtyp=INT_CMD;
2213 Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2214 // var:
2216 Lv->Init(1);
2217 Lv->m[0].rtyp=STRING_CMD;
2218 Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2219 Lc->m[1].rtyp=LIST_CMD;
2220 Lc->m[1].data=(void*)Lv;
2221 // ord:
2223 Lo->Init(1);
2225 Loo->Init(2);
2226 Loo->m[0].rtyp=STRING_CMD;
2227 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2228
2229 intvec *iv=new intvec(1); (*iv)[0]=1;
2230 Loo->m[1].rtyp=INTVEC_CMD;
2231 Loo->m[1].data=(void *)iv;
2232
2233 Lo->m[0].rtyp=LIST_CMD;
2234 Lo->m[0].data=(void*)Loo;
2235
2236 Lc->m[2].rtyp=LIST_CMD;
2237 Lc->m[2].data=(void*)Lo;
2238 // q-ideal:
2239 Lc->m[3].rtyp=IDEAL_CMD;
2240 Lc->m[3].data=(void *)idInit(1,1);
2241 // ----------------------
2242 L->m[0].rtyp=LIST_CMD;
2243 L->m[0].data=(void*)Lc;
2244 }
2245 else if (rField_is_Zp(r) || rField_is_Q(r))
2246 {
2247 L->m[0].rtyp=INT_CMD;
2248 L->m[0].data=(void *)(long)r->cf->ch;
2249 }
2250 else
2251 {
2252 L->m[0].rtyp=CRING_CMD;
2253 L->m[0].data=(void *)r->cf;
2254 r->cf->ref++;
2255 }
2256 // ----------------------------------------
2257 rDecompose_23456(r,L);
2258 return L;
2259}
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:1854
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1730
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1918
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2022
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 2022 of file ipshell.cc.

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

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2123 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1854 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1820 of file ipshell.cc.

1822{
1824 if (nCoeff_is_long_C(C)) L->Init(3);
1825 else L->Init(2);
1826 h->rtyp=LIST_CMD;
1827 h->data=(void *)L;
1828 // 0: char/ cf - ring
1829 // 1: list (var)
1830 // 2: list (ord)
1831 // ----------------------------------------
1832 // 0: char/ cf - ring
1833 L->m[0].rtyp=INT_CMD;
1834 L->m[0].data=(void *)0;
1835 // ----------------------------------------
1836 // 1:
1838 LL->Init(2);
1839 LL->m[0].rtyp=INT_CMD;
1840 LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1841 LL->m[1].rtyp=INT_CMD;
1842 LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1843 L->m[1].rtyp=LIST_CMD;
1844 L->m[1].data=(void *)LL;
1845 // ----------------------------------------
1846 // 2: list (par)
1847 if (nCoeff_is_long_C(C))
1848 {
1849 L->m[2].rtyp=STRING_CMD;
1850 L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1851 }
1852 // ----------------------------------------
1853}
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 1730 of file ipshell.cc.

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1918 of file ipshell.cc.

1920{
1921#ifdef HAVE_RINGS
1923 if (rField_is_Z(R)) L->Init(1);
1924 else L->Init(2);
1925 h->rtyp=LIST_CMD;
1926 h->data=(void *)L;
1927 // 0: char/ cf - ring
1928 // 1: list (module)
1929 // ----------------------------------------
1930 // 0: char/ cf - ring
1931 L->m[0].rtyp=STRING_CMD;
1932 L->m[0].data=(void *)omStrDup("integer");
1933 // ----------------------------------------
1934 // 1: module
1935 if (rField_is_Z(R)) return;
1937 LL->Init(2);
1938 LL->m[0].rtyp=BIGINT_CMD;
1939 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1940 LL->m[1].rtyp=INT_CMD;
1941 LL->m[1].data=(void *) R->cf->modExponent;
1942 L->m[1].rtyp=LIST_CMD;
1943 L->m[1].data=(void *)LL;
1944#else
1945 WerrorS("rDecomposeRing");
1946#endif
1947}
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 1890 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1645 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1702 of file ipshell.cc.

1703{
1704 if ((r==NULL)||(r->VarOffset==NULL))
1705 return NULL;
1707 if (h!=NULL) return h;
1708 if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1709 if (h!=NULL) return h;
1711 while(p!=NULL)
1712 {
1713 if ((p->cPack!=basePack)
1714 && (p->cPack!=currPack))
1715 h=rSimpleFindHdl(r,p->cPack->idroot,n);
1716 if (h!=NULL) return h;
1717 p=p->next;
1718 }
1719 idhdl tmp=basePack->idroot;
1720 while (tmp!=NULL)
1721 {
1722 if (IDTYP(tmp)==PACKAGE_CMD)
1723 h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1724 if (h!=NULL) return h;
1725 tmp=IDNEXT(tmp);
1726 }
1727 return NULL;
1728}
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:6271

◆ rInit()

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

Definition at line 5627 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6228 of file ipshell.cc.

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

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5188 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2406 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5128 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6271 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5579 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5307 of file ipshell.cc.

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

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

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

◆ semicProc()

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

Definition at line 4553 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4513 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4430 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3812 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4186 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3386 of file ipshell.cc.

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

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4104 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4135 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3571 of file ipshell.cc.

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

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3172 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3149 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3184 of file ipshell.cc.

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

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