My Project
Loading...
Searching...
No Matches
ipshell.cc File Reference
#include "kernel/mod2.h"
#include "factory/factory.h"
#include "misc/options.h"
#include "misc/mylimits.h"
#include "misc/intvec.h"
#include "misc/prime.h"
#include "coeffs/numbers.h"
#include "coeffs/coeffs.h"
#include "coeffs/rmodulon.h"
#include "coeffs/longrat.h"
#include "polys/monomials/p_polys.h"
#include "polys/monomials/ring.h"
#include "polys/monomials/maps.h"
#include "polys/prCopy.h"
#include "polys/matpol.h"
#include "polys/shiftop.h"
#include "polys/weight.h"
#include "polys/clapsing.h"
#include "polys/ext_fields/algext.h"
#include "polys/ext_fields/transext.h"
#include "kernel/polys.h"
#include "kernel/ideals.h"
#include "kernel/numeric/mpr_base.h"
#include "kernel/numeric/mpr_numeric.h"
#include "kernel/GBEngine/syz.h"
#include "kernel/GBEngine/kstd1.h"
#include "kernel/GBEngine/kutil.h"
#include "kernel/combinatorics/stairc.h"
#include "kernel/combinatorics/hutil.h"
#include "kernel/spectrum/semic.h"
#include "kernel/spectrum/splist.h"
#include "kernel/spectrum/spectrum.h"
#include "kernel/oswrapper/feread.h"
#include "Singular/lists.h"
#include "Singular/attrib.h"
#include "Singular/ipconv.h"
#include "Singular/links/silink.h"
#include "Singular/ipshell.h"
#include "Singular/maps_ip.h"
#include "Singular/tok.h"
#include "Singular/ipid.h"
#include "Singular/subexpr.h"
#include "Singular/fevoices.h"
#include "Singular/sdb.h"
#include <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
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm.
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).
 
lists listOfRoots (rootArranger *self, const unsigned int oprec)
 
void rSetHdl (idhdl h)
 
static leftv rOptimizeOrdAsSleftv (leftv ord)
 
BOOLEAN rSleftvOrdering2Ordering (sleftv *ord, ring R)
 
static BOOLEAN rSleftvList2StringArray (leftv sl, char **p)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
ring rSubring (ring org_ring, sleftv *rv)
 
void rKill (ring r)
 
void rKill (idhdl h)
 
BOOLEAN jjPROC (leftv res, leftv u, leftv v)
 
static void jjINT_S_TO_ID (int n, int *e, leftv res)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiApplyINTVEC (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApplyBIGINTMAT (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyIDEAL (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyLIST (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiARROW (leftv r, char *a, char *s)
 
BOOLEAN iiAssignCR (leftv r, leftv arg)
 
static void iiReportTypes (int nr, int t, const short *T)
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise
 
void iiSetReturn (const leftv source)
 

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 1063 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 3418 of file ipshell.cc.

3419{
3420 semicOK,
3422
3425
3432
3437
3443
3446
3449
3450} semicState;
semicState
Definition ipshell.cc:3419
@ semicListWrongNumberOfNumerators
Definition ipshell.cc:3434
@ semicListPGWrong
Definition ipshell.cc:3448
@ semicListFirstElementWrongType
Definition ipshell.cc:3426
@ semicListPgNegative
Definition ipshell.cc:3439
@ semicListSecondElementWrongType
Definition ipshell.cc:3427
@ semicListMilnorWrong
Definition ipshell.cc:3447
@ semicListMulNegative
Definition ipshell.cc:3442
@ semicListFourthElementWrongType
Definition ipshell.cc:3429
@ semicListWrongNumberOfDenominators
Definition ipshell.cc:3435
@ semicListNotMonotonous
Definition ipshell.cc:3445
@ semicListNotSymmetric
Definition ipshell.cc:3444
@ semicListNNegative
Definition ipshell.cc:3433
@ semicListDenNegative
Definition ipshell.cc:3441
@ semicListTooShort
Definition ipshell.cc:3423
@ semicListTooLong
Definition ipshell.cc:3424
@ semicListThirdElementWrongType
Definition ipshell.cc:3428
@ semicListMuNegative
Definition ipshell.cc:3438
@ semicListNumNegative
Definition ipshell.cc:3440
@ semicMulNegative
Definition ipshell.cc:3421
@ semicListWrongNumberOfMultiplicities
Definition ipshell.cc:3436
@ semicOK
Definition ipshell.cc:3420
@ semicListFifthElementWrongType
Definition ipshell.cc:3430
@ semicListSixthElementWrongType
Definition ipshell.cc:3431

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3534 of file ipshell.cc.

3535{
3536 spectrumOK,
3545};
@ spectrumWrongRing
Definition ipshell.cc:3542
@ spectrumOK
Definition ipshell.cc:3536
@ spectrumDegenerate
Definition ipshell.cc:3541
@ spectrumUnspecErr
Definition ipshell.cc:3544
@ spectrumNotIsolated
Definition ipshell.cc:3540
@ spectrumBadPoly
Definition ipshell.cc:3538
@ spectrumNoSingularity
Definition ipshell.cc:3539
@ spectrumZero
Definition ipshell.cc:3537
@ spectrumNoHC
Definition ipshell.cc:3543

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum & spec,
lists l )

Definition at line 3344 of file ipshell.cc.

3345{
3346 spec.mu = (int)(long)(l->m[0].Data( ));
3347 spec.pg = (int)(long)(l->m[1].Data( ));
3348 spec.n = (int)(long)(l->m[2].Data( ));
3349
3350 spec.copy_new( spec.n );
3351
3352 intvec *num = (intvec*)l->m[3].Data( );
3353 intvec *den = (intvec*)l->m[4].Data( );
3354 intvec *mul = (intvec*)l->m[5].Data( );
3355
3356 for( int i=0; i<spec.n; i++ )
3357 {
3358 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3359 spec.w[i] = (*mul)[i];
3360 }
3361}
CanonicalForm num(const CanonicalForm &f)
CanonicalForm den(const CanonicalForm &f)
int l
Definition cfEzgcd.cc:100
int i
Definition cfEzgcd.cc:132
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 550 of file ipshell.cc.

551{
552 int rc = 0;
553 while (v!=NULL)
554 {
555 switch (v->Typ())
556 {
557 case INT_CMD:
558 case POLY_CMD:
559 case VECTOR_CMD:
560 case NUMBER_CMD:
561 rc++;
562 break;
563 case INTVEC_CMD:
564 case INTMAT_CMD:
565 rc += ((intvec *)(v->Data()))->length();
566 break;
567 case MATRIX_CMD:
568 case IDEAL_CMD:
569 case MODUL_CMD:
570 {
571 matrix mm = (matrix)(v->Data());
572 rc += mm->rows() * mm->cols();
573 }
574 break;
575 case LIST_CMD:
576 rc+=((lists)v->Data())->nr+1;
577 break;
578 default:
579 rc++;
580 }
581 v = v->next;
582 }
583 return rc;
584}
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:285
@ MATRIX_CMD
Definition grammar.cc:287
@ INTMAT_CMD
Definition grammar.cc:280
@ MODUL_CMD
Definition grammar.cc:288
@ VECTOR_CMD
Definition grammar.cc:293
@ NUMBER_CMD
Definition grammar.cc:289
@ POLY_CMD
Definition grammar.cc:290
ip_smatrix * matrix
Definition matpol.h:43
slists * lists
#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 3380 of file ipshell.cc.

3381{
3383
3384 L->Init( 6 );
3385
3386 intvec *num = new intvec( spec.n );
3387 intvec *den = new intvec( spec.n );
3388 intvec *mult = new intvec( spec.n );
3389
3390 for( int i=0; i<spec.n; i++ )
3391 {
3392 (*num) [i] = spec.s[i].get_num_si( );
3393 (*den) [i] = spec.s[i].get_den_si( );
3394 (*mult)[i] = spec.w[i];
3395 }
3396
3397 L->m[0].rtyp = INT_CMD; // milnor number
3398 L->m[1].rtyp = INT_CMD; // geometrical genus
3399 L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3400 L->m[3].rtyp = INTVEC_CMD; // numerators
3401 L->m[4].rtyp = INTVEC_CMD; // denomiantors
3402 L->m[5].rtyp = INTVEC_CMD; // multiplicities
3403
3404 L->m[0].data = (void*)(long)spec.mu;
3405 L->m[1].data = (void*)(long)spec.pg;
3406 L->m[2].data = (void*)(long)spec.n;
3407 L->m[3].data = (void*)num;
3408 L->m[4].data = (void*)den;
3409 L->m[5].data = (void*)mult;
3410
3411 return L;
3412}
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)

◆ iiApply()

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

Definition at line 6412 of file ipshell.cc.

6413{
6414 res->Init();
6415 res->rtyp=a->Typ();
6416 switch (res->rtyp /*a->Typ()*/)
6417 {
6418 case INTVEC_CMD:
6419 case INTMAT_CMD:
6420 return iiApplyINTVEC(res,a,op,proc);
6421 case BIGINTMAT_CMD:
6422 return iiApplyBIGINTMAT(res,a,op,proc);
6423 case IDEAL_CMD:
6424 case MODUL_CMD:
6425 case MATRIX_CMD:
6426 return iiApplyIDEAL(res,a,op,proc);
6427 case LIST_CMD:
6428 return iiApplyLIST(res,a,op,proc);
6429 }
6430 WerrorS("first argument to `apply` must allow an index");
6431 return TRUE;
6432}
#define TRUE
Definition auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition checklibs.c:16
int Typ()
Definition subexpr.cc:1048
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:6331
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6373
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6368
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6363

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6363 of file ipshell.cc.

6364{
6365 WerrorS("not implemented");
6366 return TRUE;
6367}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6368 of file ipshell.cc.

6369{
6370 WerrorS("not implemented");
6371 return TRUE;
6372}

◆ iiApplyINTVEC()

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

Definition at line 6331 of file ipshell.cc.

6332{
6333 intvec *aa=(intvec*)a->Data();
6334 sleftv tmp_out;
6335 sleftv tmp_in;
6336 leftv curr=res;
6337 BOOLEAN bo=FALSE;
6338 for(int i=0;i<aa->length(); i++)
6339 {
6340 tmp_in.Init();
6341 tmp_in.rtyp=INT_CMD;
6342 tmp_in.data=(void*)(long)(*aa)[i];
6343 if (proc==NULL)
6344 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6345 else
6346 bo=jjPROC(&tmp_out,proc,&tmp_in);
6347 if (bo)
6348 {
6349 res->CleanUp(currRing);
6350 Werror("apply fails at index %d",i+1);
6351 return TRUE;
6352 }
6353 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6354 else
6355 {
6357 curr=curr->next;
6358 memcpy(curr,&tmp_out,sizeof(tmp_out));
6359 }
6360 }
6361 return FALSE;
6362}
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:1192
void Init()
Definition subexpr.h:107
leftv next
Definition subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition iparith.cc:9353
EXTERN_VAR omBin sleftv_bin
Definition ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition iparith.cc:1615
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 6373 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6461 of file ipshell.cc.

6462{
6463 size_t len=strlen(a)+strlen(s)+30; /* max. 27 currently */
6464 char *ss=(char*)omAlloc(len);
6465 // find end of s:
6466 int end_s=strlen(s);
6467 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6468 s[end_s+1]='\0';
6469 char *name=(char *)omAlloc(len);
6470 snprintf(name,len,"%s->%s",a,s);
6471 // find start of last expression
6472 int start_s=end_s-1;
6473 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6474 if (start_s<0) // ';' not found
6475 {
6476 snprintf(ss,len,"parameter def %s;return(%s);\n",a,s);
6477 }
6478 else // s[start_s] is ';'
6479 {
6480 s[start_s]='\0';
6481 snprintf(ss,len,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6482 }
6483 r->Init();
6484 // now produce procinfo for PROC_CMD:
6485 r->data = (void *)omAlloc0Bin(procinfo_bin);
6486 ((procinfo *)(r->data))->language=LANG_NONE;
6488 ((procinfo *)r->data)->data.s.body=ss;
6489 omFree(name);
6490 r->rtyp=PROC_CMD;
6491 //r->rtyp=STRING_CMD;
6492 //r->data=ss;
6493 return FALSE;
6494}
const CanonicalForm int s
Definition facAbsFact.cc:51
@ PROC_CMD
Definition grammar.cc:281
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition iplib.cc:1059
#define omAlloc(size)
#define omAlloc0Bin(bin)
#define omFree(addr)
VAR omBin procinfo_bin
Definition subexpr.cc:42
@ LANG_NONE
Definition subexpr.h:22
int name
New type name for int.

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv r,
leftv arg )

Definition at line 6496 of file ipshell.cc.

6497{
6498 char* ring_name=omStrDup((char*)r->Name());
6499 int t=arg->Typ();
6500 if (t==RING_CMD)
6501 {
6502 sleftv tmp;
6503 tmp.Init();
6504 tmp.rtyp=IDHDL;
6505 idhdl h=enterid(ring_name, myynest, RING_CMD, &IDROOT);
6506 IDRING(h)=NULL;
6507 tmp.data=(char*)h;
6508 if (h!=NULL)
6509 {
6510 tmp.name=h->id;
6511 BOOLEAN b=iiAssign(&tmp,arg);
6512 if (b) return TRUE;
6513 rSetHdl(ggetid(ring_name));
6514 omFree(ring_name);
6515 return FALSE;
6516 }
6517 else
6518 return TRUE;
6519 }
6520 else if (t==CRING_CMD)
6521 {
6522 sleftv tmp;
6523 sleftv n;
6524 n.Init();
6525 n.name=ring_name;
6526 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6527 if (iiAssign(&tmp,arg)) return TRUE;
6528 //Print("create %s\n",r->Name());
6529 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6530 return FALSE;
6531 }
6532 //Print("create %s\n",r->Name());
6533 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6534 return TRUE;// not handled -> error for now
6535}
CanonicalForm b
Definition cfModGcd.cc:4111
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:282
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition ipassign.cc:2097
idhdl ggetid(const char *n)
Definition ipid.cc:560
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:258
#define IDROOT
Definition ipid.h:19
#define IDRING(a)
Definition ipid.h:127
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition ipshell.cc:1197
void rSetHdl(idhdl h)
Definition ipshell.cc:5110
STATIC_VAR Poly * h
Definition janet.cc:971
#define omStrDup(s)
#define IDHDL
Definition tok.h:31
@ CRING_CMD
Definition tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv r,
leftv args )

Definition at line 1272 of file ipshell.cc.

1273{
1274 // must be inside a proc, as we simultae an proc_end at the end
1275 if (myynest==0)
1276 {
1277 WerrorS("branchTo can only occur in a proc");
1278 return TRUE;
1279 }
1280 // <string1...stringN>,<proc>
1281 // known: args!=NULL, l>=1
1282 int l=args->listLength();
1283 int ll=0;
1285 if (ll!=(l-1)) return FALSE;
1286 leftv h=args;
1287 // set up the table for type test:
1288 short *t=(short*)omAlloc(l*sizeof(short));
1289 t[0]=l-1;
1290 int b;
1291 int i;
1292 for(i=1;i<l;i++,h=h->next)
1293 {
1294 if (h->Typ()!=STRING_CMD)
1295 {
1296 omFreeBinAddr(t);
1297 Werror("arg %d is not a string",i);
1298 return TRUE;
1299 }
1300 int tt;
1301 b=IsCmd((char *)h->Data(),tt);
1302 if(b) t[i]=tt;
1303 else
1304 {
1305 omFreeBinAddr(t);
1306 Werror("arg %d is not a type name",i);
1307 return TRUE;
1308 }
1309 }
1310 if (h->Typ()!=PROC_CMD)
1311 {
1312 omFreeBinAddr(t);
1313 Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1314 i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1315 return TRUE;
1316 }
1318 omFreeBinAddr(t);
1319 if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1320 {
1321 // get the proc:
1322 iiCurrProc=(idhdl)h->data;
1323 idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1324 procinfo * pi=IDPROC(currProc);
1325 // already loaded ?
1326 if( pi->data.s.body==NULL )
1327 {
1329 if (pi->data.s.body==NULL) return TRUE;
1330 }
1331 // set currPackHdl/currPack
1332 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1333 {
1334 currPack=pi->pack;
1337 //Print("set pack=%s\n",IDID(currPackHdl));
1338 }
1339 // see iiAllStart:
1340 BITSET save1=si_opt_1;
1341 BITSET save2=si_opt_2;
1342 newBuffer( omStrDup(pi->data.s.body), BT_proc,
1343 pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1344 BOOLEAN err=yyparse();
1346 si_opt_1=save1;
1347 si_opt_2=save2;
1348 // now save the return-expr.
1350 memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1352 // warning about args.:
1353 if (iiCurrArgs!=NULL)
1354 {
1355 if (err==0) Warn("too many arguments for %s",IDID(currProc));
1359 }
1360 // similate proc_end:
1361 // - leave input
1362 void myychangebuffer();
1364 // - set the current buffer to its end (this is a pointer in a buffer,
1365 // not a file ptr) "branchTo" is only valid in proc)
1367 // - kill local vars
1369 // - return
1370 newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1371 return (err!=0);
1372 }
1373 return FALSE;
1374}
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:137
int yyparse(void)
Definition grammar.cc:2149
int IsCmd(const char *n, int &tok)
Definition iparith.cc:9761
VAR package currPack
Definition ipid.cc:57
VAR idhdl currPackHdl
Definition ipid.cc:55
idhdl packFindHdl(package r)
Definition ipid.cc:810
#define IDPROC(a)
Definition ipid.h:140
#define IDID(a)
Definition ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition iplib.cc:483
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition iplib.cc:197
VAR idhdl iiCurrProc
Definition ipshell.cc:81
void iiCheckPack(package &p)
Definition ipshell.cc:1620
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:6557
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)
#define omFreeBinAddr(addr)
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:187

◆ iiCheckPack()

void iiCheckPack ( package & p)

Definition at line 1620 of file ipshell.cc.

1621{
1622 if (p!=basePack)
1623 {
1624 idhdl t=basePack->idroot;
1625 while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1626 if (t==NULL)
1627 {
1628 WarnS("package not found\n");
1629 p=basePack;
1630 }
1631 }
1632}
int p
Definition cfModGcd.cc:4086
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:150

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int i)

Definition at line 1576 of file ipshell.cc.

1577{
1578 if (currRing==NULL)
1579 {
1580 #ifdef SIQ
1581 if (siq<=0)
1582 {
1583 #endif
1584 if (RingDependend(i))
1585 {
1586 WerrorS("no ring active (9)");
1587 return TRUE;
1588 }
1589 #ifdef SIQ
1590 }
1591 #endif
1592 }
1593 return FALSE;
1594}
static int RingDependend(int t)
Definition gentable.cc:23
VAR BOOLEAN siq
Definition subexpr.cc:48

◆ iiCheckTypes()

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

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

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

Definition at line 6557 of file ipshell.cc.

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

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente r,
int l )
static

Definition at line 935 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1064 of file ipshell.cc.

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

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv p)

Definition at line 1259 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv v,
int toLev )

Definition at line 1501 of file ipshell.cc.

1502{
1503 BOOLEAN nok=FALSE;
1504 leftv r=v;
1505 while (v!=NULL)
1506 {
1507 if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1508 {
1509 Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1510 nok=TRUE;
1511 }
1512 else
1513 {
1514 if(iiInternalExport(v, toLev))
1515 nok=TRUE;
1516 }
1517 v=v->next;
1518 }
1519 r->CleanUp();
1520 return nok;
1521}
char name() const
Definition variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition ipshell.cc:1402

◆ iiExport() [2/2]

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

Definition at line 1524 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal I,
int ak )

Definition at line 1596 of file ipshell.cc.

1597{
1598 int i;
1599 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1600 poly po=NULL;
1602 {
1603 scComputeHC(I,currRing->qideal,ak,po);
1604 if (po!=NULL)
1605 {
1606 pGetCoeff(po)=nInit(1);
1607 for (i=rVar(currRing); i>0; i--)
1608 {
1609 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1610 }
1611 pSetComp(po,ak);
1612 pSetm(po);
1613 }
1614 }
1615 else
1616 po=pOne();
1617 return po;
1618}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition hdegree.cc:1074
static BOOLEAN idIsZeroDim(ideal i)
Definition ideals.h:179
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:597
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:767

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv v,
int toLev )
static

Definition at line 1402 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1455 of file ipshell.cc.

1456{
1457 idhdl h=(idhdl)v->data;
1458 if(h==NULL)
1459 {
1460 Warn("'%s': no such identifier\n", v->name);
1461 return FALSE;
1462 }
1463 package frompack=v->req_packhdl;
1464 if (frompack==NULL) frompack=currPack;
1465 if ((RingDependend(IDTYP(h)))
1466 || ((IDTYP(h)==LIST_CMD)
1467 && (lRingDependend(IDLIST(h)))
1468 )
1469 )
1470 {
1471 //Print("// ==> Ringdependent set nesting to 0\n");
1472 return (iiInternalExport(v, toLev));
1473 }
1474 else
1475 {
1476 IDLEV(h)=toLev;
1477 v->req_packhdl=rootpack;
1478 if (h==frompack->idroot)
1479 {
1480 frompack->idroot=h->next;
1481 }
1482 else
1483 {
1484 idhdl hh=frompack->idroot;
1485 while ((hh!=NULL) && (hh->next!=h))
1486 hh=hh->next;
1487 if ((hh!=NULL) && (hh->next==h))
1488 hh->next=h->next;
1489 else
1490 {
1491 Werror("`%s` not found",v->Name());
1492 return TRUE;
1493 }
1494 }
1495 h->next=rootpack->idroot;
1496 rootpack->idroot=h;
1497 }
1498 return FALSE;
1499}
#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 845 of file ipshell.cc.

847{
848 lists L=liMakeResolv(r,length,rlen,typ0,weights);
849 int i=0;
850 idhdl h;
851 size_t len=strlen(name)+5;
852 char * s=(char *)omAlloc(len);
853
854 while (i<=L->nr)
855 {
856 snprintf(s,len,"%s(%d)",name,i+1);
857 if (i==0)
858 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
859 else
861 if (h!=NULL)
862 {
863 h->data.uideal=(ideal)L->m[i].data;
864 h->attribute=L->m[i].attribute;
865 if (BVERBOSE(V_DEF_RES))
866 Print("//defining: %s as %d-th syzygy module\n",s,i+1);
867 }
868 else
869 {
870 idDelete((ideal *)&(L->m[i].data));
871 Warn("cannot define %s",s);
872 }
873 //L->m[i].data=NULL;
874 //L->m[i].rtyp=0;
875 //L->m[i].attribute=NULL;
876 i++;
877 }
878 omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
880 omFreeSize((ADDRESS)s,strlen(name)+5);
881}
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)
#define V_DEF_RES
Definition options.h:50

◆ iiMap()

leftv iiMap ( map theMap,
const char * what )

Definition at line 613 of file ipshell.cc.

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

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

1376{
1377 if (iiCurrArgs==NULL)
1378 {
1379 if (strcmp(p->name,"#")==0)
1380 return iiDefaultParameter(p);
1381 Werror("not enough arguments for proc %s",VoiceName());
1382 p->CleanUp();
1383 return TRUE;
1384 }
1386 leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1387 if (strcmp(p->name,"#")==0)
1388 {
1389 rest=NULL;
1390 }
1391 else
1392 {
1393 h->next=NULL;
1394 }
1396 iiCurrArgs=rest; // may be NULL
1397 h->CleanUp();
1399 return res;
1400}
BOOLEAN iiDefaultParameter(leftv p)
Definition ipshell.cc:1259

◆ iiRegularity()

int iiRegularity ( lists L)

Definition at line 1036 of file ipshell.cc.

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

◆ iiReportTypes()

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

Definition at line 6537 of file ipshell.cc.

6538{
6539 char buf[250];
6540 buf[0]='\0';
6541 if (nr==0)
6542 snprintf(buf,250,"wrong length of parameters(%d), expected ",t);
6543 else if (t==0)
6544 snprintf(buf,250,"par. %d is of undefined, expected ",nr);
6545 else
6546 snprintf(buf,250,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6547 for(int i=1;i<=T[0];i++)
6548 {
6549 strcat(buf,"`");
6550 strcat(buf,Tok2Cmdname(T[i]));
6551 strcat(buf,"`");
6552 if (i<T[0]) strcat(buf,",");
6553 }
6554 WerrorS(buf);
6555}
STATIC_VAR jList * T
Definition janet.cc:30
int status int void * buf
Definition si_signals.h:69

◆ iiSetReturn()

void iiSetReturn ( const leftv source)

Definition at line 6615 of file ipshell.cc.

6616{
6617 if ((source->next==NULL)&&(source->e==NULL))
6618 {
6619 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6620 {
6621 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6622 source->Init();
6623 return;
6624 }
6625 if (source->rtyp==IDHDL)
6626 {
6627 if ((IDLEV((idhdl)source->data)==myynest)
6628 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6629 {
6631 iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6632 iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6633 iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6635 IDATTR((idhdl)source->data)=NULL;
6636 IDDATA((idhdl)source->data)=NULL;
6637 source->name=NULL;
6638 source->attribute=NULL;
6639 return;
6640 }
6641 }
6642 }
6643 iiRETURNEXPR.Copy(source);
6644}
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 6434 of file ipshell.cc.

6435{
6436 // assume a: level
6437 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6438 {
6439 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6440 char assume_yylinebuf[80];
6441 strncpy(assume_yylinebuf,my_yylinebuf,79);
6442 int lev=(long)a->Data();
6443 int startlev=0;
6444 idhdl h=ggetid("assumeLevel");
6445 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6446 if(lev <=startlev)
6447 {
6448 BOOLEAN bo=b->Eval();
6449 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6450 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6451 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6452 }
6453 }
6454 b->CleanUp();
6455 a->CleanUp();
6456 return FALSE;
6457}
#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 586 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv res,
leftv u )

Definition at line 966 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1000 of file ipshell.cc.

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

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv res,
leftv u )

Definition at line 3331 of file ipshell.cc.

3332{
3333 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3334 return (res->data==NULL);
3335}
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 6269 of file ipshell.cc.

6270{
6271 if (n==0) n=1;
6272 ideal l=idInit(n,1);
6273 int i;
6274 poly p;
6275 for(i=rVar(currRing);i>0;i--)
6276 {
6277 if (e[i]>0)
6278 {
6279 n--;
6280 p=pOne();
6281 pSetExp(p,i,1);
6282 pSetm(p);
6283 l->m[n]=p;
6284 if (n==0) break;
6285 }
6286 }
6287 res->data=(char*)l;
6289 omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6290}
#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 945 of file ipshell.cc.

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

◆ jjPROC()

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

Definition at line 1615 of file iparith.cc.

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

◆ jjRESULTANT()

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

Definition at line 3324 of file ipshell.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv res,
leftv u )

Definition at line 6299 of file ipshell.cc.

6300{
6301 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6302 ideal I=(ideal)u->Data();
6303 int i;
6304 int n=0;
6305 for(i=I->nrows*I->ncols-1;i>=0;i--)
6306 {
6307 int n0=pGetVariables(I->m[i],e);
6308 if (n0>n) n=n0;
6309 }
6310 jjINT_S_TO_ID(n,e,res);
6311 return FALSE;
6312}
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition ipshell.cc:6269
#define pGetVariables(p, e)
Definition polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv res,
leftv u )

Definition at line 6291 of file ipshell.cc.

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

◆ 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:484
BOOLEAN killlocals_list(int v, lists L)
Definition ipshell.cc:366
idhdl rFindHdl(ring r, idhdl n)
Definition ipshell.cc:1690
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 3307 of file ipshell.cc.

3308{
3309 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3310 if (res->data==NULL)
3311 res->data=(char *)new intvec(rVar(currRing));
3312 return FALSE;
3313}
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv res,
leftv id )

Definition at line 3285 of file ipshell.cc.

3286{
3287 ideal F=(ideal)id->Data();
3288 intvec * iv = new intvec(rVar(currRing));
3289 polyset s;
3290 int sl, n, i;
3291 int *x;
3292
3293 res->data=(char *)iv;
3294 s = F->m;
3295 sl = IDELEMS(F) - 1;
3296 n = rVar(currRing);
3297 double wNsqr = (double)2.0 / (double)n;
3299 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3300 wCall(s, sl, x, wNsqr, currRing);
3301 for (i = n; i!=0; i--)
3302 (*iv)[i-1] = x[i + n + 1];
3303 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3304 return FALSE;
3305}
Variable x
Definition cfModGcd.cc:4090
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:956
CanonicalForm buf2
Definition facFqBivar.cc:76
@ SMATRIX_CMD
Definition grammar.cc:292
void ipListFlag(idhdl h)
Definition ipid.cc:598
#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:6314
#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 {
450 h=IDRING(h)->idroot;
451 }
452 else if(IDTYP(h)==PACKAGE_CMD)
453 {
455 //Print("list_cmd:package\n");
456 all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
457 h=IDPACKAGE(h)->idroot;
458 }
459 else
460 {
461 currPack=savePack;
462 return;
463 }
464 }
465 else
466 {
467 Werror("%s is undefined",what);
468 currPack=savePack;
469 return;
470 }
471 }
472 all=TRUE;
473 }
474 else if (RingDependend(typ))
475 {
476 h = currRing->idroot;
477 }
478 else
479 h = IDROOT;
480 start=h;
481 while (h!=NULL)
482 {
483 if ((all
484 && (IDTYP(h)!=PROC_CMD)
485 &&(IDTYP(h)!=PACKAGE_CMD)
486 &&(IDTYP(h)!=CRING_CMD)
487 )
488 || (typ == IDTYP(h))
489 || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
490 )
491 {
492 list1(prefix,h,start==currRingHdl, fullname);
493 if ((IDTYP(h)==RING_CMD)
494 && (really_all || (all && (h==currRingHdl)))
495 && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
496 {
497 list_cmd(0,IDID(h),"// ",FALSE);
498 }
499 if (IDTYP(h)==PACKAGE_CMD && really_all)
500 {
501 package save_p=currPack;
503 list_cmd(0,IDID(h),"// ",FALSE);
504 currPack=save_p;
505 }
506 }
507 h = IDNEXT(h);
508 }
509 currPack=savePack;
510}
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 3452 of file ipshell.cc.

3453{
3454 switch( state )
3455 {
3456 case semicListTooShort:
3457 WerrorS( "the list is too short" );
3458 break;
3459 case semicListTooLong:
3460 WerrorS( "the list is too long" );
3461 break;
3462
3464 WerrorS( "first element of the list should be int" );
3465 break;
3467 WerrorS( "second element of the list should be int" );
3468 break;
3470 WerrorS( "third element of the list should be int" );
3471 break;
3473 WerrorS( "fourth element of the list should be intvec" );
3474 break;
3476 WerrorS( "fifth element of the list should be intvec" );
3477 break;
3479 WerrorS( "sixth element of the list should be intvec" );
3480 break;
3481
3482 case semicListNNegative:
3483 WerrorS( "first element of the list should be positive" );
3484 break;
3486 WerrorS( "wrong number of numerators" );
3487 break;
3489 WerrorS( "wrong number of denominators" );
3490 break;
3492 WerrorS( "wrong number of multiplicities" );
3493 break;
3494
3496 WerrorS( "the Milnor number should be positive" );
3497 break;
3499 WerrorS( "the geometrical genus should be nonnegative" );
3500 break;
3502 WerrorS( "all numerators should be positive" );
3503 break;
3505 WerrorS( "all denominators should be positive" );
3506 break;
3508 WerrorS( "all multiplicities should be positive" );
3509 break;
3510
3512 WerrorS( "it is not symmetric" );
3513 break;
3515 WerrorS( "it is not monotonous" );
3516 break;
3517
3519 WerrorS( "the Milnor number is wrong" );
3520 break;
3521 case semicListPGWrong:
3522 WerrorS( "the geometrical genus is wrong" );
3523 break;
3524
3525 default:
3526 WerrorS( "unspecific error" );
3527 break;
3528 }
3529}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists l)

Definition at line 4237 of file ipshell.cc.

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

◆ listOfRoots()

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

Definition at line 5063 of file ipshell.cc.

5064{
5065 int i,j;
5066 int count= self->roots[0]->getAnzRoots(); // number of roots
5067 int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5068
5069 lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5070
5071 if ( self->found_roots )
5072 {
5073 listofroots->Init( count );
5074
5075 for (i=0; i < count; i++)
5076 {
5077 lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5078 onepoint->Init(elem);
5079 for ( j= 0; j < elem; j++ )
5080 {
5081 if ( !rField_is_long_C(currRing) )
5082 {
5083 onepoint->m[j].rtyp=STRING_CMD;
5084 onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5085 }
5086 else
5087 {
5088 onepoint->m[j].rtyp=NUMBER_CMD;
5089 onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5090 }
5091 onepoint->m[j].next= NULL;
5092 onepoint->m[j].name= NULL;
5093 }
5094 listofroots->m[i].rtyp=LIST_CMD;
5095 listofroots->m[i].data=(void *)onepoint;
5096 listofroots->m[j].next= NULL;
5097 listofroots->m[j].name= NULL;
5098 }
5099
5100 }
5101 else
5102 {
5103 listofroots->Init( 0 );
5104 }
5105
5106 return listofroots;
5107}
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition coeffs.h:455
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
static BOOLEAN rField_is_long_C(const ring r)
Definition ring.h:550
int status int void size_t count
Definition si_signals.h:69

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv res,
leftv arg1 )

compute Newton Polytopes of input polynomials

Definition at line 4547 of file ipshell.cc.

4548{
4549 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4550 return FALSE;
4551}
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 4553 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv res,
leftv a )

Definition at line 3053 of file ipshell.cc.

3054{
3055 int i,j;
3056 matrix result;
3057 ideal id=(ideal)a->Data();
3058
3060 for (i=1; i<=IDELEMS(id); i++)
3061 {
3062 for (j=1; j<=rVar(currRing); j++)
3063 {
3064 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3065 }
3066 }
3067 res->data=(char *)result;
3068 return FALSE;
3069}
return result
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 3075 of file ipshell.cc.

3076{
3077 int n=(int)(long)b->Data();
3078 int d=(int)(long)c->Data();
3079 int k,l,sign,row,col;
3080 matrix result;
3081 ideal temp;
3082 BOOLEAN bo;
3083 poly p;
3084
3085 if ((d>n) || (d<1) || (n<1))
3086 {
3087 res->data=(char *)mpNew(1,1);
3088 return FALSE;
3089 }
3090 int *choise = (int*)omAlloc(d*sizeof(int));
3091 if (id==NULL)
3092 temp=idMaxIdeal(1);
3093 else
3094 temp=(ideal)id->Data();
3095
3096 k = binom(n,d);
3097 l = k*d;
3098 l /= n-d+1;
3099 result =mpNew(l,k);
3100 col = 1;
3101 idInitChoise(d,1,n,&bo,choise);
3102 while (!bo)
3103 {
3104 sign = 1;
3105 for (l=1;l<=d;l++)
3106 {
3107 if (choise[l-1]<=IDELEMS(temp))
3108 {
3109 p = pCopy(temp->m[choise[l-1]-1]);
3110 if (sign == -1) p = pNeg(p);
3111 sign *= -1;
3112 row = idGetNumberOfChoise(l-1,d,1,n,choise);
3113 MATELEM(result,row,col) = p;
3114 }
3115 }
3116 col++;
3117 idGetNextChoise(d,n,&bo,choise);
3118 }
3119 omFreeSize(choise,d*sizeof(int));
3120 if (id==NULL) idDelete(&temp);
3121
3122 res->data=(char *)result;
3123 return FALSE;
3124}
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:3442

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

4663{
4664 poly gls;
4665 gls= (poly)(arg1->Data());
4666 int howclean= (int)(long)arg3->Data();
4667
4668 if ( gls == NULL || pIsConstant( gls ) )
4669 {
4670 WerrorS("Input polynomial is constant!");
4671 return TRUE;
4672 }
4673
4675 {
4676 int* r=Zp_roots(gls, currRing);
4677 lists rlist;
4678 rlist= (lists)omAlloc( sizeof(slists) );
4679 rlist->Init( r[0] );
4680 for(int i=r[0];i>0;i--)
4681 {
4682 rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4683 rlist->m[i-1].rtyp=NUMBER_CMD;
4684 }
4685 omFree(r);
4686 res->data=rlist;
4687 res->rtyp= LIST_CMD;
4688 return FALSE;
4689 }
4690 if ( !(rField_is_R(currRing) ||
4694 {
4695 WerrorS("Ground field not implemented!");
4696 return TRUE;
4697 }
4698
4701 {
4702 unsigned long int ii = (unsigned long int)arg2->Data();
4703 setGMPFloatDigits( ii, ii );
4704 }
4705
4706 int ldummy;
4707 int deg= currRing->pLDeg( gls, &ldummy, currRing );
4708 int i,vpos=0;
4709 poly piter;
4710 lists elist;
4711
4712 elist= (lists)omAlloc( sizeof(slists) );
4713 elist->Init( 0 );
4714
4715 if ( rVar(currRing) > 1 )
4716 {
4717 piter= gls;
4718 for ( i= 1; i <= rVar(currRing); i++ )
4719 if ( pGetExp( piter, i ) )
4720 {
4721 vpos= i;
4722 break;
4723 }
4724 while ( piter )
4725 {
4726 for ( i= 1; i <= rVar(currRing); i++ )
4727 if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4728 {
4729 WerrorS("The input polynomial must be univariate!");
4730 return TRUE;
4731 }
4732 pIter( piter );
4733 }
4734 }
4735
4736 rootContainer * roots= new rootContainer();
4737 number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4738 piter= gls;
4739 for ( i= deg; i >= 0; i-- )
4740 {
4741 if ( piter && pTotaldegree(piter) == i )
4742 {
4743 pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4744 //nPrint( pcoeffs[i] );PrintS(" ");
4745 pIter( piter );
4746 }
4747 else
4748 {
4749 pcoeffs[i]= nInit(0);
4750 }
4751 }
4752
4753#ifdef mprDEBUG_PROT
4754 for (i=deg; i >= 0; i--)
4755 {
4756 nPrint( pcoeffs[i] );PrintS(" ");
4757 }
4758 PrintLn();
4759#endif
4760
4761 roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4762 roots->solver( howclean );
4763
4764 int elem= roots->getAnzRoots();
4765 char *dummy;
4766 int j;
4767
4768 lists rlist;
4769 rlist= (lists)omAlloc( sizeof(slists) );
4770 rlist->Init( elem );
4771
4773 {
4774 for ( j= 0; j < elem; j++ )
4775 {
4776 rlist->m[j].rtyp=NUMBER_CMD;
4777 rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4778 //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4779 }
4780 }
4781 else
4782 {
4783 for ( j= 0; j < elem; j++ )
4784 {
4785 dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4786 rlist->m[j].rtyp=STRING_CMD;
4787 rlist->m[j].data=(void *)dummy;
4788 }
4789 }
4790
4791 elist->Clean();
4792 //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4793
4794 // this is (via fillContainer) the same data as in root
4795 //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4796 //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4797
4798 delete roots;
4799
4800 res->data= (void*)rlist;
4801
4802 return FALSE;
4803}
int * Zp_roots(poly p, const ring r)
Definition clapsing.cc:2190
complex root finder for univariate polynomials based on laguers algorithm
Definition mpr_numeric.h:66
gmp_complex * getRoot(const int i)
Definition mpr_numeric.h:88
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
int getAnzRoots()
Definition mpr_numeric.h:97
bool solver(const int polishmode=PM_NONE)
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:539
#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...
#define nCopy(n)
Definition numbers.h:15
#define nPrint(a)
only for debug, over any initialized 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:523
static BOOLEAN rField_is_Zp(const ring r)
Definition ring.h:505
static BOOLEAN rField_is_Q(const ring r)
Definition ring.h:511

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

4640{
4641 ideal gls = (ideal)(arg1->Data());
4642 int imtype= (int)(long)arg2->Data();
4643
4644 uResultant::resMatType mtype= determineMType( imtype );
4645
4646 // check input ideal ( = polynomial system )
4647 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4648 {
4649 return TRUE;
4650 }
4651
4652 uResultant *resMat= new uResultant( gls, mtype, false );
4653 if (resMat!=NULL)
4654 {
4655 res->rtyp = MODUL_CMD;
4656 res->data= (void*)resMat->accessResMat()->getMatrix();
4657 if (!errorreported) delete resMat;
4658 }
4659 return errorreported;
4660}
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 4906 of file ipshell.cc.

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

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

6315{
6316 Print(" %s (",n);
6317 switch (p->language)
6318 {
6319 case LANG_SINGULAR: PrintS("S"); break;
6320 case LANG_C: PrintS("C"); break;
6321 case LANG_TOP: PrintS("T"); break;
6322 case LANG_MAX: PrintS("M"); break;
6323 case LANG_NONE: PrintS("N"); break;
6324 default: PrintS("U");
6325 }
6326 if(p->libname!=NULL)
6327 Print(",%s", p->libname);
6328 PrintS(")");
6329}
@ 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 2771 of file ipshell.cc.

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

2243{
2244 // ----------------------------------------
2245 // 0: char/ cf - ring
2246 if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2247 {
2248 WerrorS("invalid coeff. field description, expecting 0");
2249 return;
2250 }
2251// R->cf->ch=0;
2252 // ----------------------------------------
2253 // 0, (r1,r2) [, "i" ]
2254 if (L->m[1].rtyp!=LIST_CMD)
2255 {
2256 WerrorS("invalid coeff. field description, expecting precision list");
2257 return;
2258 }
2259 lists LL=(lists)L->m[1].data;
2260 if ((LL->nr!=1)
2261 || (LL->m[0].rtyp!=INT_CMD)
2262 || (LL->m[1].rtyp!=INT_CMD))
2263 {
2264 WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2265 return;
2266 }
2267 int r1=(int)(long)LL->m[0].data;
2268 int r2=(int)(long)LL->m[1].data;
2269 r1=si_min(r1,32767);
2270 r2=si_min(r2,32767);
2271 LongComplexInfo par; memset(&par, 0, sizeof(par));
2272 par.float_len=r1;
2273 par.float_len2=r2;
2274 if (L->nr==2) // complex
2275 {
2276 if (L->m[2].rtyp!=STRING_CMD)
2277 {
2278 WerrorS("invalid coeff. field description, expecting parameter name");
2279 return;
2280 }
2281 par.par_name=(char*)L->m[2].data;
2282 R->cf = nInitChar(n_long_C, &par);
2283 }
2284 else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2285 R->cf = nInitChar(n_R, NULL);
2286 else /* && L->nr==1*/
2287 {
2288 R->cf = nInitChar(n_long_R, &par);
2289 }
2290}
@ 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:109
const char * par_name
parameter name
Definition coeffs.h:110
short float_len
additional char-flags, rInit
Definition coeffs.h:108
#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 2471 of file ipshell.cc.

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

◆ rComposeRing()

void rComposeRing ( lists L,
ring R )

Definition at line 2292 of file ipshell.cc.

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

◆ rComposeVar()

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

Definition at line 2426 of file ipshell.cc.

2427{
2428 assume(R!=NULL);
2429 if (L->m[1].Typ()==LIST_CMD)
2430 {
2431 lists v=(lists)L->m[1].Data();
2432 R->N = v->nr+1;
2433 if (R->N<=0)
2434 {
2435 WerrorS("no ring variables");
2436 return TRUE;
2437 }
2438 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2439 int i;
2440 for(i=0;i<R->N;i++)
2441 {
2442 if (v->m[i].Typ()==STRING_CMD)
2443 R->names[i]=omStrDup((char *)v->m[i].Data());
2444 else if (v->m[i].Typ()==POLY_CMD)
2445 {
2446 poly p=(poly)v->m[i].Data();
2447 int nr=pIsPurePower(p);
2448 if (nr>0)
2449 R->names[i]=omStrDup(currRing->names[nr-1]);
2450 else
2451 {
2452 Werror("var name %d must be a string or a ring variable",i+1);
2453 return TRUE;
2454 }
2455 }
2456 else
2457 {
2458 Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
2459 return TRUE;
2460 }
2461 }
2462 }
2463 else
2464 {
2465 WerrorS("variable must be given as `list`");
2466 return TRUE;
2467 }
2468 return FALSE;
2469}
#define pIsPurePower(p)
Definition polys.h:248
char * char_ptr
Definition structs.h:53

◆ rDecompose()

lists rDecompose ( const ring r)

Definition at line 2142 of file ipshell.cc.

2143{
2144 assume( r != NULL );
2145 const coeffs C = r->cf;
2146 assume( C != NULL );
2147
2148 // sanity check: require currRing==r for rings with polynomial data
2149 if ( (r!=currRing) && (
2150 (nCoeff_is_algExt(C) && (C != currRing->cf))
2151 || (r->qideal != NULL)
2152#ifdef HAVE_PLURAL
2153 || (rIsPluralRing(r))
2154#endif
2155 )
2156 )
2157 {
2158 WerrorS("ring with polynomial data must be the base ring or compatible");
2159 return NULL;
2160 }
2161 // 0: char/ cf - ring
2162 // 1: list (var)
2163 // 2: list (ord)
2164 // 3: qideal
2165 // possibly:
2166 // 4: C
2167 // 5: D
2169 if (rIsPluralRing(r))
2170 L->Init(6);
2171 else
2172 L->Init(4);
2173 // ----------------------------------------
2174 // 0: char/ cf - ring
2175 if (rField_is_numeric(r))
2176 {
2177 rDecomposeC(&(L->m[0]),r);
2178 }
2179 else if (rField_is_Ring(r))
2180 {
2181 rDecomposeRing(&(L->m[0]),r);
2182 }
2183 else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2184 {
2185 rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2186 }
2187 else if(rField_is_GF(r))
2188 {
2190 Lc->Init(4);
2191 // char:
2192 Lc->m[0].rtyp=INT_CMD;
2193 Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2194 // var:
2196 Lv->Init(1);
2197 Lv->m[0].rtyp=STRING_CMD;
2198 Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2199 Lc->m[1].rtyp=LIST_CMD;
2200 Lc->m[1].data=(void*)Lv;
2201 // ord:
2203 Lo->Init(1);
2205 Loo->Init(2);
2206 Loo->m[0].rtyp=STRING_CMD;
2207 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2208
2209 intvec *iv=new intvec(1); (*iv)[0]=1;
2210 Loo->m[1].rtyp=INTVEC_CMD;
2211 Loo->m[1].data=(void *)iv;
2212
2213 Lo->m[0].rtyp=LIST_CMD;
2214 Lo->m[0].data=(void*)Loo;
2215
2216 Lc->m[2].rtyp=LIST_CMD;
2217 Lc->m[2].data=(void*)Lo;
2218 // q-ideal:
2219 Lc->m[3].rtyp=IDEAL_CMD;
2220 Lc->m[3].data=(void *)idInit(1,1);
2221 // ----------------------
2222 L->m[0].rtyp=LIST_CMD;
2223 L->m[0].data=(void*)Lc;
2224 }
2225 else if (rField_is_Zp(r) || rField_is_Q(r))
2226 {
2227 L->m[0].rtyp=INT_CMD;
2228 L->m[0].data=(void *)(long)r->cf->ch;
2229 }
2230 else
2231 {
2232 L->m[0].rtyp=CRING_CMD;
2233 L->m[0].data=(void *)r->cf;
2234 r->cf->ref++;
2235 }
2236 // ----------------------------------------
2237 rDecompose_23456(r,L);
2238 return L;
2239}
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:903
static void rDecomposeC(leftv h, const ring R)
Definition ipshell.cc:1842
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition ipshell.cc:1718
void rDecomposeRing(leftv h, const ring R)
Definition ipshell.cc:1904
static void rDecompose_23456(const ring r, lists L)
Definition ipshell.cc:2002
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition ring.h:405
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition ring.h:630
static BOOLEAN rField_is_numeric(const ring r)
Definition ring.h:520
static BOOLEAN rField_is_GF(const ring r)
Definition ring.h:526
#define rField_is_Ring(R)
Definition ring.h:490

◆ rDecompose_23456()

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

Definition at line 2002 of file ipshell.cc.

2003{
2004 // ----------------------------------------
2005 // 1: list (var)
2007 LL->Init(r->N);
2008 int i;
2009 for(i=0; i<r->N; i++)
2010 {
2011 LL->m[i].rtyp=STRING_CMD;
2012 LL->m[i].data=(void *)omStrDup(r->names[i]);
2013 }
2014 L->m[1].rtyp=LIST_CMD;
2015 L->m[1].data=(void *)LL;
2016 // ----------------------------------------
2017 // 2: list (ord)
2019 i=rBlocks(r)-1;
2020 LL->Init(i);
2021 i--;
2022 lists LLL;
2023 for(; i>=0; i--)
2024 {
2025 intvec *iv;
2026 int j;
2027 LL->m[i].rtyp=LIST_CMD;
2029 LLL->Init(2);
2030 LLL->m[0].rtyp=STRING_CMD;
2031 LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2032
2033 if((r->order[i] == ringorder_IS)
2034 || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2035 {
2036 assume( r->block0[i] == r->block1[i] );
2037 const int s = r->block0[i];
2038 assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2039
2040 iv=new intvec(1);
2041 (*iv)[0] = s;
2042 }
2043 else if (r->block1[i]-r->block0[i] >=0 )
2044 {
2045 int bl=j=r->block1[i]-r->block0[i];
2046 if (r->order[i]==ringorder_M)
2047 {
2048 j=(j+1)*(j+1)-1;
2049 bl=j+1;
2050 }
2051 else if (r->order[i]==ringorder_am)
2052 {
2053 j+=r->wvhdl[i][bl+1];
2054 }
2055 iv=new intvec(j+1);
2056 if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2057 {
2058 for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2059 }
2060 else switch (r->order[i])
2061 {
2062 case ringorder_dp:
2063 case ringorder_Dp:
2064 case ringorder_ds:
2065 case ringorder_Ds:
2066 case ringorder_lp:
2067 case ringorder_ls:
2068 case ringorder_rp:
2069 for(;j>=0; j--) (*iv)[j]=1;
2070 break;
2071 default: /* do nothing */;
2072 }
2073 }
2074 else
2075 {
2076 iv=new intvec(1);
2077 }
2078 LLL->m[1].rtyp=INTVEC_CMD;
2079 LLL->m[1].data=(void *)iv;
2080 LL->m[i].data=(void *)LLL;
2081 }
2082 L->m[2].rtyp=LIST_CMD;
2083 L->m[2].data=(void *)LL;
2084 // ----------------------------------------
2085 // 3: qideal
2086 L->m[3].rtyp=IDEAL_CMD;
2087 if (r->qideal==NULL)
2088 L->m[3].data=(void *)idInit(1,1);
2089 else
2090 L->m[3].data=(void *)idCopy(r->qideal);
2091 // ----------------------------------------
2092#ifdef HAVE_PLURAL // NC! in rDecompose
2093 if (rIsPluralRing(r))
2094 {
2095 L->m[4].rtyp=MATRIX_CMD;
2096 L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2097 L->m[5].rtyp=MATRIX_CMD;
2098 L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2099 }
2100#endif
2101}
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:573

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv res,
const coeffs C )

Definition at line 1932 of file ipshell.cc.

1933{
1934 assume( C != NULL );
1935
1936 // sanity check: require currRing==r for rings with polynomial data
1937 if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1938 {
1939 WerrorS("ring with polynomial data must be the base ring or compatible");
1940 return TRUE;
1941 }
1942 if (nCoeff_is_numeric(C))
1943 {
1945 }
1946 else if (nCoeff_is_Ring(C))
1947 {
1949 }
1950 else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1951 {
1952 rDecomposeCF(res, C->extRing, currRing);
1953 }
1954 else if(nCoeff_is_GF(C))
1955 {
1957 Lc->Init(4);
1958 // char:
1959 Lc->m[0].rtyp=INT_CMD;
1960 Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1961 // var:
1963 Lv->Init(1);
1964 Lv->m[0].rtyp=STRING_CMD;
1965 Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1966 Lc->m[1].rtyp=LIST_CMD;
1967 Lc->m[1].data=(void*)Lv;
1968 // ord:
1970 Lo->Init(1);
1972 Loo->Init(2);
1973 Loo->m[0].rtyp=STRING_CMD;
1974 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1975
1976 intvec *iv=new intvec(1); (*iv)[0]=1;
1977 Loo->m[1].rtyp=INTVEC_CMD;
1978 Loo->m[1].data=(void *)iv;
1979
1980 Lo->m[0].rtyp=LIST_CMD;
1981 Lo->m[0].data=(void*)Loo;
1982
1983 Lc->m[2].rtyp=LIST_CMD;
1984 Lc->m[2].data=(void*)Lo;
1985 // q-ideal:
1986 Lc->m[3].rtyp=IDEAL_CMD;
1987 Lc->m[3].data=(void *)idInit(1,1);
1988 // ----------------------
1989 res->rtyp=LIST_CMD;
1990 res->data=(void*)Lc;
1991 }
1992 else
1993 {
1994 res->rtyp=INT_CMD;
1995 res->data=(void *)(long)C->ch;
1996 }
1997 // ----------------------------------------
1998 return FALSE;
1999}
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition coeffs.h:832
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition coeffs.h:825
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition coeffs.h:771
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition coeffs.h:730
static void rDecomposeC_41(leftv h, const coeffs C)
Definition ipshell.cc:1808
static void rDecomposeRing_41(leftv h, const coeffs C)
Definition ipshell.cc:1877

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring r)

Definition at line 2103 of file ipshell.cc.

2104{
2105 assume( r != NULL );
2106 const coeffs C = r->cf;
2107 assume( C != NULL );
2108
2109 // sanity check: require currRing==r for rings with polynomial data
2110 if ( (r!=currRing) && (
2111 (r->qideal != NULL)
2112#ifdef HAVE_PLURAL
2113 || (rIsPluralRing(r))
2114#endif
2115 )
2116 )
2117 {
2118 WerrorS("ring with polynomial data must be the base ring or compatible");
2119 return NULL;
2120 }
2121 // 0: char/ cf - ring
2122 // 1: list (var)
2123 // 2: list (ord)
2124 // 3: qideal
2125 // possibly:
2126 // 4: C
2127 // 5: D
2129 if (rIsPluralRing(r))
2130 L->Init(6);
2131 else
2132 L->Init(4);
2133 // ----------------------------------------
2134 // 0: char/ cf - ring
2135 L->m[0].rtyp=CRING_CMD;
2136 L->m[0].data=(char*)r->cf; r->cf->ref++;
2137 // ----------------------------------------
2138 rDecompose_23456(r,L);
2139 return L;
2140}

◆ rDecomposeC()

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

Definition at line 1842 of file ipshell.cc.

1844{
1846 if (rField_is_long_C(R)) L->Init(3);
1847 else L->Init(2);
1848 h->rtyp=LIST_CMD;
1849 h->data=(void *)L;
1850 // 0: char/ cf - ring
1851 // 1: list (var)
1852 // 2: list (ord)
1853 // ----------------------------------------
1854 // 0: char/ cf - ring
1855 L->m[0].rtyp=INT_CMD;
1856 L->m[0].data=(void *)0;
1857 // ----------------------------------------
1858 // 1:
1860 LL->Init(2);
1861 LL->m[0].rtyp=INT_CMD;
1862 LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1863 LL->m[1].rtyp=INT_CMD;
1864 LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1865 L->m[1].rtyp=LIST_CMD;
1866 L->m[1].data=(void *)LL;
1867 // ----------------------------------------
1868 // 2: list (par)
1869 if (rField_is_long_C(R))
1870 {
1871 L->m[2].rtyp=STRING_CMD;
1872 L->m[2].data=(void *)omStrDup(*rParameter(R));
1873 }
1874 // ----------------------------------------
1875}

◆ rDecomposeC_41()

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

Definition at line 1808 of file ipshell.cc.

1810{
1812 if (nCoeff_is_long_C(C)) L->Init(3);
1813 else L->Init(2);
1814 h->rtyp=LIST_CMD;
1815 h->data=(void *)L;
1816 // 0: char/ cf - ring
1817 // 1: list (var)
1818 // 2: list (ord)
1819 // ----------------------------------------
1820 // 0: char/ cf - ring
1821 L->m[0].rtyp=INT_CMD;
1822 L->m[0].data=(void *)0;
1823 // ----------------------------------------
1824 // 1:
1826 LL->Init(2);
1827 LL->m[0].rtyp=INT_CMD;
1828 LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1829 LL->m[1].rtyp=INT_CMD;
1830 LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1831 L->m[1].rtyp=LIST_CMD;
1832 L->m[1].data=(void *)LL;
1833 // ----------------------------------------
1834 // 2: list (par)
1835 if (nCoeff_is_long_C(C))
1836 {
1837 L->m[2].rtyp=STRING_CMD;
1838 L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1839 }
1840 // ----------------------------------------
1841}
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition coeffs.h:887

◆ rDecomposeCF()

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

Definition at line 1718 of file ipshell.cc.

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv h,
const ring R )

Definition at line 1904 of file ipshell.cc.

1906{
1908 if (rField_is_Z(R)) L->Init(1);
1909 else L->Init(2);
1910 h->rtyp=LIST_CMD;
1911 h->data=(void *)L;
1912 // 0: char/ cf - ring
1913 // 1: list (module)
1914 // ----------------------------------------
1915 // 0: char/ cf - ring
1916 L->m[0].rtyp=STRING_CMD;
1917 L->m[0].data=(void *)omStrDup("integer");
1918 // ----------------------------------------
1919 // 1: module
1920 if (rField_is_Z(R)) return;
1922 LL->Init(2);
1923 LL->m[0].rtyp=BIGINT_CMD;
1924 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1925 LL->m[1].rtyp=INT_CMD;
1926 LL->m[1].data=(void *) R->cf->modExponent;
1927 L->m[1].rtyp=LIST_CMD;
1928 L->m[1].data=(void *)LL;
1929}
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition coeffs.h:543
static BOOLEAN rField_is_Z(const ring r)
Definition ring.h:514

◆ rDecomposeRing_41()

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

Definition at line 1877 of file ipshell.cc.

1879{
1881 if (nCoeff_is_Ring(C)) L->Init(1);
1882 else L->Init(2);
1883 h->rtyp=LIST_CMD;
1884 h->data=(void *)L;
1885 // 0: char/ cf - ring
1886 // 1: list (module)
1887 // ----------------------------------------
1888 // 0: char/ cf - ring
1889 L->m[0].rtyp=STRING_CMD;
1890 L->m[0].data=(void *)omStrDup("integer");
1891 // ----------------------------------------
1892 // 1: modulo
1893 if (nCoeff_is_Z(C)) return;
1895 LL->Init(2);
1896 LL->m[0].rtyp=BIGINT_CMD;
1897 LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1898 LL->m[1].rtyp=INT_CMD;
1899 LL->m[1].data=(void *) C->modExponent;
1900 L->m[1].rtyp=LIST_CMD;
1901 L->m[1].data=(void *)LL;
1902}
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition coeffs.h:809

◆ rDefault()

idhdl rDefault ( const char * s)

Definition at line 1634 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring r,
idhdl n )

Definition at line 1690 of file ipshell.cc.

1691{
1692 if ((r==NULL)||(r->VarOffset==NULL))
1693 return NULL;
1695 if (h!=NULL) return h;
1696 if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1697 if (h!=NULL) return h;
1699 while(p!=NULL)
1700 {
1701 if ((p->cPack!=basePack)
1702 && (p->cPack!=currPack))
1703 h=rSimpleFindHdl(r,p->cPack->idroot,n);
1704 if (h!=NULL) return h;
1705 p=p->next;
1706 }
1707 idhdl tmp=basePack->idroot;
1708 while (tmp!=NULL)
1709 {
1710 if (IDTYP(tmp)==PACKAGE_CMD)
1711 h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1712 if (h!=NULL) return h;
1713 tmp=IDNEXT(tmp);
1714 }
1715 return NULL;
1716}
VAR proclevel * procstack
Definition ipid.cc:52
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition ipshell.cc:6250

◆ rInit()

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

Definition at line 5609 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl h)

Definition at line 6207 of file ipshell.cc.

6208{
6209 ring r = IDRING(h);
6210 int ref=0;
6211 if (r!=NULL)
6212 {
6213 // avoid, that sLastPrinted is the last reference to the base ring:
6214 // clean up before killing the last "named" refrence:
6216 && (sLastPrinted.data==(void*)r))
6217 {
6219 }
6220 ref=r->ref;
6221 if ((ref<=0)&&(r==currRing))
6222 {
6223 // cleanup DENOMINATOR_LIST
6225 {
6227 if (TEST_V_ALLWARN)
6228 Warn("deleting denom_list for ring change from %s",IDID(h));
6229 do
6230 {
6231 n_Delete(&(dd->n),currRing->cf);
6232 dd=dd->next;
6235 } while(DENOMINATOR_LIST!=NULL);
6236 }
6237 }
6238 rKill(r);
6239 }
6240 if (h==currRingHdl)
6241 {
6242 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6243 else
6244 {
6246 }
6247 }
6248}
void rKill(ring r)
Definition ipshell.cc:6162
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 6162 of file ipshell.cc.

6163{
6164 if ((r->ref<=0)&&(r->order!=NULL))
6165 {
6166#ifdef RDEBUG
6167 if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6168#endif
6169 int j;
6170 for (j=0;j<myynest;j++)
6171 {
6172 if (iiLocalRing[j]==r)
6173 {
6174 if (j==0) WarnS("killing the basering for level 0");
6176 }
6177 }
6178// any variables depending on r ?
6179 while (r->idroot!=NULL)
6180 {
6181 r->idroot->lev=myynest; // avoid warning about kill global objects
6182 killhdl2(r->idroot,&(r->idroot),r);
6183 }
6184 if (r==currRing)
6185 {
6186 // all dependend stuff is done, clean global vars:
6188 {
6190 }
6191 //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6192 //{
6193 // WerrorS("return value depends on local ring variable (export missing ?)");
6194 // iiRETURNEXPR.CleanUp();
6195 //}
6196 currRing=NULL;
6198 }
6199
6200 /* nKillChar(r); will be called from inside of rDelete */
6201 rDelete(r);
6202 return;
6203 }
6204 rDecRefCnt(r);
6205}

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv ord)
static

Definition at line 5170 of file ipshell.cc.

5171{
5172 // change some bad orderings/combination into better ones
5173 leftv h=ord;
5174 while(h!=NULL)
5175 {
5176 BOOLEAN change=FALSE;
5177 intvec *iv = (intvec *)(h->data);
5178 // ws(-i) -> wp(i)
5179 if ((*iv)[1]==ringorder_ws)
5180 {
5181 BOOLEAN neg=TRUE;
5182 for(int i=2;i<iv->length();i++)
5183 if((*iv)[i]>=0) { neg=FALSE; break; }
5184 if (neg)
5185 {
5186 (*iv)[1]=ringorder_wp;
5187 for(int i=2;i<iv->length();i++)
5188 (*iv)[i]= - (*iv)[i];
5189 change=TRUE;
5190 }
5191 }
5192 // Ws(-i) -> Wp(i)
5193 if ((*iv)[1]==ringorder_Ws)
5194 {
5195 BOOLEAN neg=TRUE;
5196 for(int i=2;i<iv->length();i++)
5197 if((*iv)[i]>=0) { neg=FALSE; break; }
5198 if (neg)
5199 {
5200 (*iv)[1]=ringorder_Wp;
5201 for(int i=2;i<iv->length();i++)
5202 (*iv)[i]= -(*iv)[i];
5203 change=TRUE;
5204 }
5205 }
5206 // wp(1) -> dp
5207 if ((*iv)[1]==ringorder_wp)
5208 {
5209 BOOLEAN all_one=TRUE;
5210 for(int i=2;i<iv->length();i++)
5211 if((*iv)[i]!=1) { all_one=FALSE; break; }
5212 if (all_one)
5213 {
5214 intvec *iv2=new intvec(3);
5215 (*iv2)[0]=1;
5216 (*iv2)[1]=ringorder_dp;
5217 (*iv2)[2]=iv->length()-2;
5218 delete iv;
5219 iv=iv2;
5220 h->data=iv2;
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 // dp(1)/Dp(1)/rp(1) -> lp(1)
5243 if (((*iv)[1]==ringorder_dp)
5244 || ((*iv)[1]==ringorder_Dp)
5245 || ((*iv)[1]==ringorder_rp))
5246 {
5247 if (iv->length()==3)
5248 {
5249 if ((*iv)[2]==1)
5250 {
5251 if(h->next!=NULL)
5252 {
5253 intvec *iv2 = (intvec *)(h->next->data);
5254 if ((*iv2)[1]==ringorder_lp)
5255 {
5256 (*iv)[1]=ringorder_lp;
5257 change=TRUE;
5258 }
5259 }
5260 }
5261 }
5262 }
5263 // lp(i),lp(j) -> lp(i+j)
5264 if(((*iv)[1]==ringorder_lp)
5265 && (h->next!=NULL))
5266 {
5267 intvec *iv2 = (intvec *)(h->next->data);
5268 if ((*iv2)[1]==ringorder_lp)
5269 {
5270 leftv hh=h->next;
5271 h->next=hh->next;
5272 hh->next=NULL;
5273 if ((*iv2)[0]==1)
5274 (*iv)[2] += 1; // last block unspecified, at least 1
5275 else
5276 (*iv)[2] += (*iv2)[2];
5277 hh->CleanUp();
5279 change=TRUE;
5280 }
5281 }
5282 // -------------------
5283 if (!change) h=h->next;
5284 }
5285 return ord;
5286}

◆ rRenameVars()

static void rRenameVars ( ring R)
static

Definition at line 2384 of file ipshell.cc.

2385{
2386 int i,j;
2387 BOOLEAN ch;
2388 do
2389 {
2390 ch=0;
2391 for(i=0;i<R->N-1;i++)
2392 {
2393 for(j=i+1;j<R->N;j++)
2394 {
2395 if (strcmp(R->names[i],R->names[j])==0)
2396 {
2397 ch=TRUE;
2398 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);
2399 omFree(R->names[j]);
2400 size_t len=2+strlen(R->names[i]);
2401 R->names[j]=(char *)omAlloc(len);
2402 snprintf(R->names[j],len,"@%s",R->names[i]);
2403 }
2404 }
2405 }
2406 }
2407 while (ch);
2408 for(i=0;i<rPar(R); i++)
2409 {
2410 for(j=0;j<R->N;j++)
2411 {
2412 if (strcmp(rParameter(R)[i],R->names[j])==0)
2413 {
2414 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);
2415// omFree(rParameter(R)[i]);
2416// rParameter(R)[i]=(char *)omAlloc(10);
2417// sprintf(rParameter(R)[i],"@@(%d)",i+1);
2418 omFree(R->names[j]);
2419 R->names[j]=(char *)omAlloc(16);
2420 snprintf(R->names[j],16,"@@(%d)",i+1);
2421 }
2422 }
2423 }
2424}

◆ rSetHdl()

void rSetHdl ( idhdl h)

Definition at line 5110 of file ipshell.cc.

5111{
5112 ring rg = NULL;
5113 if (h!=NULL)
5114 {
5115// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5116 rg = IDRING(h);
5117 if (rg==NULL) return; //id <>NULL, ring==NULL
5118 omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5119 if (IDID(h)) // OB: ????
5121 rTest(rg);
5122 }
5123 else return;
5124
5125 // clean up history
5126 if (currRing!=NULL)
5127 {
5129 {
5131 }
5132
5133 if (rg!=currRing)/*&&(currRing!=NULL)*/
5134 {
5135 if (rg->cf!=currRing->cf)
5136 {
5139 {
5140 if (TEST_V_ALLWARN)
5141 Warn("deleting denom_list for ring change to %s",IDID(h));
5142 do
5143 {
5144 n_Delete(&(dd->n),currRing->cf);
5145 dd=dd->next;
5148 } while(DENOMINATOR_LIST!=NULL);
5149 }
5150 }
5151 }
5152 }
5153
5154 // test for valid "currRing":
5155 if ((rg!=NULL) && (rg->idroot==NULL))
5156 {
5157 ring old=rg;
5158 rg=rAssure_HasComp(rg);
5159 if (old!=rg)
5160 {
5161 rKill(old);
5162 IDRING(h)=rg;
5163 }
5164 }
5165 /*------------ change the global ring -----------------------*/
5166 rChangeCurrRing(rg);
5167 currRingHdl = h;
5168}
#define omCheckAddr(addr)
#define omCheckAddrSize(addr, size)
ring rAssure_HasComp(const ring r)
Definition ring.cc:4656

◆ rSimpleFindHdl()

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

Definition at line 6250 of file ipshell.cc.

6251{
6252 idhdl h=root;
6253 while (h!=NULL)
6254 {
6255 if ((IDTYP(h)==RING_CMD)
6256 && (h!=n)
6257 && (IDRING(h)==r)
6258 )
6259 {
6260 return h;
6261 }
6262 h=IDNEXT(h);
6263 }
6264 return NULL;
6265}

◆ rSleftvList2StringArray()

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

Definition at line 5561 of file ipshell.cc.

5562{
5563
5564 while(sl!=NULL)
5565 {
5566 if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5567 {
5568 *p = omStrDup(sl->Name());
5569 }
5570 else if (sl->name!=NULL)
5571 {
5572 *p = (char*)sl->name;
5573 sl->name=NULL;
5574 }
5575 else if (sl->rtyp==POLY_CMD)
5576 {
5577 sleftv s_sl;
5578 iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5579 if (s_sl.name != NULL)
5580 {
5581 *p = (char*)s_sl.name; s_sl.name=NULL;
5582 }
5583 else
5584 *p = NULL;
5585 sl->next = s_sl.next;
5586 s_sl.next = NULL;
5587 s_sl.CleanUp();
5588 if (*p == NULL) return TRUE;
5589 }
5590 else return TRUE;
5591 p++;
5592 sl=sl->next;
5593 }
5594 return FALSE;
5595}

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv * ord,
ring R )

Definition at line 5289 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring org_ring,
sleftv * rv )

Definition at line 6000 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1102 of file ipshell.cc.

1104{
1105 int i;
1106 indset save;
1108
1109 hexist = hInit(S, Q, &hNexist);
1110 if (hNexist == 0)
1111 {
1112 intvec *iv=new intvec(rVar(currRing));
1113 for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1114 res->Init(1);
1115 res->m[0].rtyp=INTVEC_CMD;
1116 res->m[0].data=(intvec*)iv;
1117 return res;
1118 }
1120 hMu = 0;
1121 hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1122 hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1123 hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1124 hrad = hexist;
1125 hNrad = hNexist;
1126 radmem = hCreate(rVar(currRing) - 1);
1127 hCo = rVar(currRing) + 1;
1128 hNvar = rVar(currRing);
1130 hSupp(hrad, hNrad, hvar, &hNvar);
1131 if (hNvar)
1132 {
1133 hCo = hNvar;
1134 hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1137 }
1138 if (hCo && (hCo < rVar(currRing)))
1139 {
1141 }
1142 if (hMu!=0)
1143 {
1144 ISet = save;
1145 hMu2 = 0;
1146 if (all && (hCo+1 < rVar(currRing)))
1147 {
1150 i=hMu+hMu2;
1151 res->Init(i);
1152 if (hMu2 == 0)
1153 {
1155 }
1156 }
1157 else
1158 {
1159 res->Init(hMu);
1160 }
1161 for (i=0;i<hMu;i++)
1162 {
1163 res->m[i].data = (void *)save->set;
1164 res->m[i].rtyp = INTVEC_CMD;
1165 ISet = save;
1166 save = save->nx;
1168 }
1170 if (hMu2 != 0)
1171 {
1172 save = JSet;
1173 for (i=hMu;i<hMu+hMu2;i++)
1174 {
1175 res->m[i].data = (void *)save->set;
1176 res->m[i].rtyp = INTVEC_CMD;
1177 JSet = save;
1178 save = save->nx;
1180 }
1182 }
1183 }
1184 else
1185 {
1186 res->Init(0);
1188 }
1189 hKill(radmem, rVar(currRing) - 1);
1190 omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1191 omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1192 omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1194 return res;
1195}
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition hdegree.cc:382
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:351
VAR long hMu
Definition hdegree.cc:28
VAR indset JSet
Definition hdegree.cc:351
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:562
monf hCreate(int Nvar)
Definition hutil.cc:996
VAR varset hvar
Definition hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition hutil.cc:1010
VAR int hNexist
Definition hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition hutil.cc:140
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition hutil.cc:621
VAR scfmon hwork
Definition hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition hutil.cc:174
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition hutil.cc:565
VAR scmon hpure
Definition hutil.cc:17
VAR scfmon hrad
Definition hutil.cc:16
VAR monf radmem
Definition hutil.cc:21
VAR int hNpure
Definition hutil.cc:19
VAR int hNrad
Definition hutil.cc:19
scfmon hInit(ideal S, ideal Q, int *Nexist)
Definition hutil.cc:31
VAR scfmon hexist
Definition hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition hutil.cc:411
VAR int hNvar
Definition hutil.cc:19
scmon * scfmon
Definition hutil.h:15
indlist * indset
Definition hutil.h:28
int * varset
Definition hutil.h:16
int * scmon
Definition hutil.h:14
#define Q
Definition sirandom.c:26

◆ semicProc()

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

Definition at line 4535 of file ipshell.cc.

4536{
4537 sleftv tmp;
4538 tmp.Init();
4539 tmp.rtyp=INT_CMD;
4540 /* tmp.data = (void *)0; -- done by Init */
4541
4542 return semicProc3(res,u,v,&tmp);
4543}
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition ipshell.cc:4495

◆ semicProc3()

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

Definition at line 4495 of file ipshell.cc.

4496{
4497 semicState state;
4498 BOOLEAN qh=(((int)(long)w->Data())==1);
4499
4500 // -----------------
4501 // check arguments
4502 // -----------------
4503
4504 lists l1 = (lists)u->Data( );
4505 lists l2 = (lists)v->Data( );
4506
4507 if( (state=list_is_spectrum( l1 ))!=semicOK )
4508 {
4509 WerrorS( "first argument is not a spectrum" );
4510 list_error( state );
4511 }
4512 else if( (state=list_is_spectrum( l2 ))!=semicOK )
4513 {
4514 WerrorS( "second argument is not a spectrum" );
4515 list_error( state );
4516 }
4517 else
4518 {
4519 spectrum s1= spectrumFromList( l1 );
4520 spectrum s2= spectrumFromList( l2 );
4521
4522 res->rtyp = INT_CMD;
4523 if (qh)
4524 res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4525 else
4526 res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4527 }
4528
4529 // -----------------
4530 // check status
4531 // -----------------
4532
4533 return (state!=semicOK);
4534}
int mult_spectrum(spectrum &)
Definition semic.cc:396
int mult_spectrumh(spectrum &)
Definition semic.cc:425
void list_error(semicState state)
Definition ipshell.cc:3452
spectrum spectrumFromList(lists l)
Definition ipshell.cc:3368
semicState list_is_spectrum(lists l)
Definition ipshell.cc:4237

◆ spaddProc()

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

Definition at line 4412 of file ipshell.cc.

4413{
4414 semicState state;
4415
4416 // -----------------
4417 // check arguments
4418 // -----------------
4419
4420 lists l1 = (lists)first->Data( );
4421 lists l2 = (lists)second->Data( );
4422
4423 if( (state=list_is_spectrum( l1 )) != semicOK )
4424 {
4425 WerrorS( "first argument is not a spectrum:" );
4426 list_error( state );
4427 }
4428 else if( (state=list_is_spectrum( l2 )) != semicOK )
4429 {
4430 WerrorS( "second argument is not a spectrum:" );
4431 list_error( state );
4432 }
4433 else
4434 {
4435 spectrum s1= spectrumFromList ( l1 );
4436 spectrum s2= spectrumFromList ( l2 );
4437 spectrum sum( s1+s2 );
4438
4439 result->rtyp = LIST_CMD;
4440 result->data = (char*)(getList(sum));
4441 }
4442
4443 return (state!=semicOK);
4444}
lists getList(spectrum &spec)
Definition ipshell.cc:3380

◆ spectrumCompute()

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

Definition at line 3794 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv result,
leftv first )

Definition at line 4168 of file ipshell.cc.

4169{
4170 spectrumState state = spectrumOK;
4171
4172 // -------------------
4173 // check consistency
4174 // -------------------
4175
4176 // check for a local polynomial ring
4177
4178 if( currRing->OrdSgn != -1 )
4179 // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4180 // or should we use:
4181 //if( !ringIsLocal( ) )
4182 {
4183 WerrorS( "only works for local orderings" );
4184 state = spectrumWrongRing;
4185 }
4186 else if( currRing->qideal != NULL )
4187 {
4188 WerrorS( "does not work in quotient rings" );
4189 state = spectrumWrongRing;
4190 }
4191 else
4192 {
4193 lists L = (lists)NULL;
4194 int flag = 2; // symmetric optimization
4195
4196 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4197
4198 if( state==spectrumOK )
4199 {
4200 result->rtyp = LIST_CMD;
4201 result->data = (char*)L;
4202 }
4203 else
4204 {
4205 spectrumPrintError(state);
4206 }
4207 }
4208
4209 return (state!=spectrumOK);
4210}
spectrumState
Definition ipshell.cc:3535
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition ipshell.cc:3794
void spectrumPrintError(spectrumState state)
Definition ipshell.cc:4086

◆ spectrumFromList()

spectrum spectrumFromList ( lists l)

Definition at line 3368 of file ipshell.cc.

3369{
3371 copy_deep( result, l );
3372 return result;
3373}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3344

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState state)

Definition at line 4086 of file ipshell.cc.

4087{
4088 switch( state )
4089 {
4090 case spectrumZero:
4091 WerrorS( "polynomial is zero" );
4092 break;
4093 case spectrumBadPoly:
4094 WerrorS( "polynomial has constant term" );
4095 break;
4097 WerrorS( "not a singularity" );
4098 break;
4100 WerrorS( "the singularity is not isolated" );
4101 break;
4102 case spectrumNoHC:
4103 WerrorS( "highest corner cannot be computed" );
4104 break;
4105 case spectrumDegenerate:
4106 WerrorS( "principal part is degenerate" );
4107 break;
4108 case spectrumOK:
4109 break;
4110
4111 default:
4112 WerrorS( "unknown error occurred" );
4113 break;
4114 }
4115}

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv result,
leftv first )

Definition at line 4117 of file ipshell.cc.

4118{
4119 spectrumState state = spectrumOK;
4120
4121 // -------------------
4122 // check consistency
4123 // -------------------
4124
4125 // check for a local ring
4126
4127 if( !ringIsLocal(currRing ) )
4128 {
4129 WerrorS( "only works for local orderings" );
4130 state = spectrumWrongRing;
4131 }
4132
4133 // no quotient rings are allowed
4134
4135 else if( currRing->qideal != NULL )
4136 {
4137 WerrorS( "does not work in quotient rings" );
4138 state = spectrumWrongRing;
4139 }
4140 else
4141 {
4142 lists L = (lists)NULL;
4143 int flag = 1; // weight corner optimization is safe
4144
4145 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4146
4147 if( state==spectrumOK )
4148 {
4149 result->rtyp = LIST_CMD;
4150 result->data = (char*)L;
4151 }
4152 else
4153 {
4154 spectrumPrintError(state);
4155 }
4156 }
4157
4158 return (state!=spectrumOK);
4159}
BOOLEAN ringIsLocal(const ring r)
Definition spectrum.cc:461

◆ spectrumStateFromList()

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

Definition at line 3553 of file ipshell.cc.

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

4455{
4456 semicState state;
4457
4458 // -----------------
4459 // check arguments
4460 // -----------------
4461
4462 lists l = (lists)first->Data( );
4463 int k = (int)(long)second->Data( );
4464
4465 if( (state=list_is_spectrum( l ))!=semicOK )
4466 {
4467 WerrorS( "first argument is not a spectrum" );
4468 list_error( state );
4469 }
4470 else if( k < 0 )
4471 {
4472 WerrorS( "second argument should be positive" );
4473 state = semicMulNegative;
4474 }
4475 else
4476 {
4478 spectrum product( k*s );
4479
4480 result->rtyp = LIST_CMD;
4481 result->data = (char*)getList(product);
4482 }
4483
4484 return (state!=semicOK);
4485}

◆ syBetti1()

BOOLEAN syBetti1 ( leftv res,
leftv u )

Definition at line 3154 of file ipshell.cc.

3155{
3156 sleftv tmp;
3157 tmp.Init();
3158 tmp.rtyp=INT_CMD;
3159 tmp.data=(void *)1;
3160 return syBetti2(res,u,&tmp);
3161}
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition ipshell.cc:3131

◆ syBetti2()

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

Definition at line 3131 of file ipshell.cc.

3132{
3133 syStrategy syzstr=(syStrategy)u->Data();
3134
3135 BOOLEAN minim=(int)(long)w->Data();
3136 int row_shift=0;
3137 int add_row_shift=0;
3138 intvec *weights=NULL;
3139 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3140 if (ww!=NULL)
3141 {
3142 weights=ivCopy(ww);
3143 add_row_shift = ww->min_in();
3144 (*weights) -= add_row_shift;
3145 }
3146
3147 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3148 //row_shift += add_row_shift;
3149 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3150 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3151
3152 return FALSE;
3153}
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition syz1.cc:1756
ssyStrategy * syStrategy
Definition syz.h:36

◆ syConvList()

syStrategy syConvList ( lists li)

Definition at line 3238 of file ipshell.cc.

3239{
3240 int typ0;
3242
3243 resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3244 if (fr != NULL)
3245 {
3246
3247 result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3248 for (int i=result->length-1;i>=0;i--)
3249 {
3250 if (fr[i]!=NULL)
3251 result->fullres[i] = idCopy(fr[i]);
3252 }
3253 result->list_length=result->length;
3254 omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3255 }
3256 else
3257 {
3258 omFreeSize(result, sizeof(ssyStrategy));
3259 result = NULL;
3260 }
3261 return result;
3262}

◆ syConvRes()

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

Definition at line 3166 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int i)

Definition at line 512 of file ipshell.cc.

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

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 1062 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 5597 of file ipshell.cc.