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

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

const chariiTwoOps (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 charlastreserved =NULL
 
STATIC_VAR BOOLEAN iiNoKeepRing =TRUE
 
VAR BOOLEAN iiDebugMarker =TRUE
 
const short MAX_SHORT = 32767
 

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 1064 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3542 of file ipshell.cc.

3543{
3544 spectrumOK,
3553};
@ spectrumWrongRing
Definition ipshell.cc:3550
@ spectrumOK
Definition ipshell.cc:3544
@ spectrumDegenerate
Definition ipshell.cc:3549
@ spectrumUnspecErr
Definition ipshell.cc:3552
@ spectrumNotIsolated
Definition ipshell.cc:3548
@ spectrumBadPoly
Definition ipshell.cc:3546
@ spectrumNoSingularity
Definition ipshell.cc:3547
@ spectrumZero
Definition ipshell.cc:3545
@ spectrumNoHC
Definition ipshell.cc:3551

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3352 of file ipshell.cc.

3353{
3354 spec.mu = (int)(long)(l->m[0].Data( ));
3355 spec.pg = (int)(long)(l->m[1].Data( ));
3356 spec.n = (int)(long)(l->m[2].Data( ));
3357
3358 spec.copy_new( spec.n );
3359
3360 intvec *num = (intvec*)l->m[3].Data( );
3361 intvec *den = (intvec*)l->m[4].Data( );
3362 intvec *mul = (intvec*)l->m[5].Data( );
3363
3364 for( int i=0; i<spec.n; i++ )
3365 {
3366 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3367 spec.w[i] = (*mul)[i];
3368 }
3369}
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}
int length() const
Variable next() const
Definition factory.h:146
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 3388 of file ipshell.cc.

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

6421{
6422 res->Init();
6423 res->rtyp=a->Typ();
6424 switch (res->rtyp /*a->Typ()*/)
6425 {
6426 case INTVEC_CMD:
6427 case INTMAT_CMD:
6428 return iiApplyINTVEC(res,a,op,proc);
6429 case BIGINTMAT_CMD:
6430 return iiApplyBIGINTMAT(res,a,op,proc);
6431 case IDEAL_CMD:
6432 case MODUL_CMD:
6433 case MATRIX_CMD:
6434 return iiApplyIDEAL(res,a,op,proc);
6435 case LIST_CMD:
6436 return iiApplyLIST(res,a,op,proc);
6437 }
6438 WerrorS("first argument to `apply` must allow an index");
6439 return TRUE;
6440}
#define TRUE
Definition auxiliary.h:101
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:6339
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6381
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6376
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6371

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6371 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6376 of file ipshell.cc.

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

◆ iiApplyINTVEC()

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

Definition at line 6339 of file ipshell.cc.

6340{
6341 intvec *aa=(intvec*)a->Data();
6343 sleftv tmp_in;
6344 leftv curr=res;
6346 for(int i=0;i<aa->length(); i++)
6347 {
6348 tmp_in.Init();
6349 tmp_in.rtyp=INT_CMD;
6350 tmp_in.data=(void*)(long)(*aa)[i];
6351 if (proc==NULL)
6353 else
6355 if (bo)
6356 {
6357 res->CleanUp(currRing);
6358 Werror("apply fails at index %d",i+1);
6359 return TRUE;
6360 }
6361 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6362 else
6363 {
6365 curr=curr->next;
6366 memcpy(curr,&tmp_out,sizeof(tmp_out));
6367 }
6368 }
6369 return FALSE;
6370}
int BOOLEAN
Definition auxiliary.h:88
#define FALSE
Definition auxiliary.h:97
Class used for (list of) interpreter objects.
Definition subexpr.h:83
void * Data()
Definition subexpr.cc:1192
leftv next
Definition subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition iparith.cc:9330
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:53

◆ iiApplyLIST()

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

Definition at line 6381 of file ipshell.cc.

6382{
6383 lists aa=(lists)a->Data();
6384 if (aa->nr==-1) /* empty list*/
6385 {
6387 l->Init();
6388 res->data=(void *)l;
6389 return FALSE;
6390 }
6392 sleftv tmp_in;
6393 leftv curr=res;
6395 for(int i=0;i<=aa->nr; i++)
6396 {
6397 tmp_in.Init();
6398 tmp_in.Copy(&(aa->m[i]));
6399 if (proc==NULL)
6401 else
6403 tmp_in.CleanUp();
6404 if (bo)
6405 {
6406 res->CleanUp(currRing);
6407 Werror("apply fails at index %d",i+1);
6408 return TRUE;
6409 }
6410 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6411 else
6412 {
6414 curr=curr->next;
6415 memcpy(curr,&tmp_out,sizeof(tmp_out));
6416 }
6417 }
6418 return FALSE;
6419}

◆ iiARROW()

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

Definition at line 6469 of file ipshell.cc.

6470{
6471 size_t len=strlen(a)+strlen(s)+30; /* max. 27 currently */
6472 char *ss=(char*)omAlloc(len);
6473 // find end of s:
6474 int end_s=strlen(s);
6475 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6476 s[end_s+1]='\0';
6477 char *name=(char *)omAlloc(len);
6478 snprintf(name,len,"%s->%s",a,s);
6479 // find start of last expression
6480 int start_s=end_s-1;
6481 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6482 if (start_s<0) // ';' not found
6483 {
6484 snprintf(ss,len,"parameter def %s;return(%s);\n",a,s);
6485 }
6486 else // s[start_s] is ';'
6487 {
6488 s[start_s]='\0';
6489 snprintf(ss,len,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6490 }
6491 r->Init();
6492 // now produce procinfo for PROC_CMD:
6493 r->data = (void *)omAlloc0Bin(procinfo_bin);
6494 ((procinfo *)(r->data))->language=LANG_NONE;
6496 ((procinfo *)r->data)->data.s.body=ss;
6497 omFree(name);
6498 r->rtyp=PROC_CMD;
6499 //r->rtyp=STRING_CMD;
6500 //r->data=ss;
6501 return FALSE;
6502}
void Init()
Definition subexpr.h:107
const CanonicalForm int s
Definition facAbsFact.cc:51
char name(const Variable &v)
Definition factory.h:189
@ 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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6504 of file ipshell.cc.

6505{
6506 char* ring_name=omStrDup((char*)r->Name());
6507 int t=arg->Typ();
6508 if (t==RING_CMD)
6509 {
6510 sleftv tmp;
6511 tmp.Init();
6512 tmp.rtyp=IDHDL;
6514 IDRING(h)=NULL;
6515 tmp.data=(char*)h;
6516 if (h!=NULL)
6517 {
6518 tmp.name=h->id;
6519 BOOLEAN b=iiAssign(&tmp,arg);
6520 if (b) return TRUE;
6523 return FALSE;
6524 }
6525 else
6526 return TRUE;
6527 }
6528 else if (t==CRING_CMD)
6529 {
6530 sleftv tmp;
6531 sleftv n;
6532 n.Init();
6533 n.name=ring_name;
6534 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6535 if (iiAssign(&tmp,arg)) return TRUE;
6536 //Print("create %s\n",r->Name());
6537 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6538 return FALSE;
6539 }
6540 //Print("create %s\n",r->Name());
6541 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6542 return TRUE;// not handled -> error for now
6543}
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:581
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:279
#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:1198
void rSetHdl(idhdl h)
Definition ipshell.cc:5118
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 1273 of file ipshell.cc.

1274{
1275 // must be inside a proc, as we simultae an proc_end at the end
1276 if (myynest==0)
1277 {
1278 WerrorS("branchTo can only occur in a proc");
1279 return TRUE;
1280 }
1281 // <string1...stringN>,<proc>
1282 // known: args!=NULL, l>=1
1283 int l=args->listLength();
1284 int ll=0;
1286 if (ll!=(l-1)) return FALSE;
1287 leftv h=args;
1288 // set up the table for type test:
1289 short *t=(short*)omAlloc(l*sizeof(short));
1290 t[0]=l-1;
1291 int b;
1292 int i;
1293 for(i=1;i<l;i++,h=h->next)
1294 {
1295 if (h->Typ()!=STRING_CMD)
1296 {
1297 omFreeBinAddr(t);
1298 Werror("arg %d is not a string",i);
1299 return TRUE;
1300 }
1301 int tt;
1302 b=IsCmd((char *)h->Data(),tt);
1303 if(b) t[i]=tt;
1304 else
1305 {
1306 omFreeBinAddr(t);
1307 Werror("arg %d is not a type name",i);
1308 return TRUE;
1309 }
1310 }
1311 if (h->Typ()!=PROC_CMD)
1312 {
1313 omFreeBinAddr(t);
1314 Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1315 i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1316 return TRUE;
1317 }
1319 omFreeBinAddr(t);
1320 if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1321 {
1322 // get the proc:
1323 iiCurrProc=(idhdl)h->data;
1324 idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1326 // already loaded ?
1327 if( pi->data.s.body==NULL )
1328 {
1330 if (pi->data.s.body==NULL) return TRUE;
1331 }
1332 // set currPackHdl/currPack
1333 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1334 {
1335 currPack=pi->pack;
1338 //Print("set pack=%s\n",IDID(currPackHdl));
1339 }
1340 // see iiAllStart:
1343 newBuffer( omStrDup(pi->data.s.body), BT_proc,
1344 pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1345 BOOLEAN err=yyparse();
1349 // now save the return-expr.
1353 // warning about args.:
1354 if (iiCurrArgs!=NULL)
1355 {
1356 if (err==0) Warn("too many arguments for %s",IDID(currProc));
1360 }
1361 // similate proc_end:
1362 // - leave input
1363 void myychangebuffer();
1365 // - set the current buffer to its end (this is a pointer in a buffer,
1366 // not a file ptr) "branchTo" is only valid in proc)
1368 // - kill local vars
1370 // - return
1371 newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1372 return (err!=0);
1373 }
1374 return FALSE;
1375}
#define BITSET
Definition auxiliary.h:85
char * buffer
Definition fevoices.h:69
long fptr
Definition fevoices.h:70
int listLength()
Definition subexpr.cc:51
void CleanUp(ring r=currRing)
Definition subexpr.cc:351
#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:9738
VAR package currPack
Definition ipid.cc:55
VAR idhdl currPackHdl
Definition ipid.cc:53
idhdl packFindHdl(package r)
Definition ipid.cc:831
#define IDPROC(a)
Definition ipid.h:140
#define IDID(a)
Definition ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition iplib.cc: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:1621
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:6565
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:22
void myychangebuffer()
Definition scanner.cc:2311
INST_VAR sleftv sLastPrinted
Definition subexpr.cc:46
@ STRING_CMD
Definition tok.h:187

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1621 of file ipshell.cc.

1622{
1623 if (p!=basePack)
1624 {
1625 idhdl t=basePack->idroot;
1626 while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1627 if (t==NULL)
1628 {
1629 WarnS("package not found\n");
1630 p=basePack;
1631 }
1632 }
1633}
int p
Definition cfModGcd.cc:4086
idhdl next
Definition idrec.h:38
#define WarnS
Definition emacs.cc:78
VAR package basePack
Definition ipid.cc:56
#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 1577 of file ipshell.cc.

1578{
1579 if (currRing==NULL)
1580 {
1581 #ifdef SIQ
1582 if (siq<=0)
1583 {
1584 #endif
1585 if (RingDependend(i))
1586 {
1587 WerrorS("no ring active (9)");
1588 return TRUE;
1589 }
1590 #ifdef SIQ
1591 }
1592 #endif
1593 }
1594 return FALSE;
1595}
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 6565 of file ipshell.cc.

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

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 936 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

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

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1502 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1525 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1597 of file ipshell.cc.

1598{
1599 int i;
1600 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1601 poly po=NULL;
1603 {
1604 scComputeHC(I,currRing->qideal,ak,po);
1605 if (po!=NULL)
1606 {
1607 pGetCoeff(po)=nInit(1);
1608 for (i=rVar(currRing); i>0; i--)
1609 {
1610 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1611 }
1612 pSetComp(po,ak);
1613 pSetm(po);
1614 }
1615 }
1616 else
1617 po=pOne();
1618 return po;
1619}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition hdegree.cc:1074
static BOOLEAN idIsZeroDim(ideal i)
Definition ideals.h:180
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:272
#define pSetComp(p, v)
Definition polys.h:39
#define pGetExp(p, i)
Exponent.
Definition polys.h:42
#define pOne()
Definition polys.h:316
#define pDecrExp(p, i)
Definition polys.h:45
static BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:769
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition ring.h:598

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1403 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1456 of file ipshell.cc.

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

848{
849 lists L=liMakeResolv(r,length,rlen,typ0,weights);
850 int i=0;
851 idhdl h;
852 size_t len=strlen(name)+5;
853 char * s=(char *)omAlloc(len);
854
855 while (i<=L->nr)
856 {
857 snprintf(s,len,"%s(%d)",name,i+1);
858 if (i==0)
859 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860 else
862 if (h!=NULL)
863 {
864 h->data.uideal=(ideal)L->m[i].data;
865 h->attribute=L->m[i].attribute;
866 if (BVERBOSE(V_DEF_RES))
867 Print("//defining: %s as %d-th syzygy module\n",s,i+1);
868 }
869 else
870 {
871 idDelete((ideal *)&(L->m[i].data));
872 Warn("cannot define %s",s);
873 }
874 //L->m[i].data=NULL;
875 //L->m[i].rtyp=0;
876 //L->m[i].attribute=NULL;
877 i++;
878 }
879 omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
882}
attr attribute
Definition subexpr.h:89
int nr
Definition lists.h:44
#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;
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 {
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 {
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;
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;
681 {
682 poly p = p_One(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
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=NULL;
738 if (IDELEMS(id)>0) degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
739 for(int i=IDELEMS(id)-1;i>=0;i--)
740 {
741 poly p=id->m[i];
743 else degs[i]=0;
744 }
745 for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
746 {
747 if (theMap->m[j]!=NULL)
748 {
750
751 for(int i=IDELEMS(id)-1;i>=0;i--)
752 {
753 poly p=id->m[i];
754 if ((p!=NULL) && (degs[i]!=0) &&
755 ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
756 {
757 overflow=TRUE;
758 break;
759 }
760 }
761 }
762 }
763 if (degs!=NULL) omFreeSize(degs,IDELEMS(id)*sizeof(long));
764 }
765 else if (tmpW.rtyp==POLY_CMD)
766 {
767 for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
768 {
769 if (theMap->m[j]!=NULL)
770 {
772 poly p=(poly)tmpW.data;
773 long deg=0;
774 if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
775 ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
776 {
777 overflow=TRUE;
778 break;
779 }
780 }
781 }
782 }
783 if (overflow)
784#ifdef HAVE_SHIFTBBA
785 // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
786 if (!rIsLPRing(currRing))
787 {
788#endif
789 Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
790#ifdef HAVE_SHIFTBBA
791 }
792#endif
793#if 0
794 if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
795 {
796 v->rtyp=tmpW.rtyp;
797 v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
798 }
799 else
800#endif
801 {
802 if ((tmpW.rtyp==IDEAL_CMD)
803 ||(tmpW.rtyp==MODUL_CMD)
804 ||(tmpW.rtyp==MATRIX_CMD)
805 ||(tmpW.rtyp==MAP_CMD))
806 {
807 v->rtyp=tmpW.rtyp;
808 char *tmp = theMap->preimage;
809 theMap->preimage=(char*)1L;
810 // map gets 1 as its rank (as an ideal)
812 theMap->preimage=tmp; // map gets its preimage back
813 }
814 if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
815 {
817 {
818 Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
820 if (save_r!=NULL) IDMAP(w)->preimage=save_r;
821 return NULL;
822 }
823 }
824 }
825 if (save_r!=NULL)
826 {
827 IDMAP(w)->preimage=save_r;
828 IDMAP((idhdl)v)->preimage=omStrDup(save_r);
829 v->rtyp=MAP_CMD;
830 }
831 return v;
832 }
833 else
834 {
835 Werror("%s undefined in %s",what,theMap->preimage);
836 }
837 }
838 else
839 {
840 Werror("cannot find preimage %s",theMap->preimage);
841 }
842 return NULL;
843}
idhdl get(const char *s, int lev)
Definition ipid.cc:70
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:88
@ 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:490
static void p_Setm(poly p, const ring r)
Definition p_polys.h:235
static void p_Delete(poly *p, const ring r)
Definition p_polys.h:903
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition p_polys.h:848
static long p_Totaldegree(poly p, const ring r)
Definition p_polys.h:1523
static long pTotaldegree(poly p)
Definition polys.h:283
poly * polyset
Definition polys.h:260
static BOOLEAN rIsLPRing(const ring r)
Definition ring.h:417
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 1376 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

6546{
6547 char buf[250];
6548 buf[0]='\0';
6549 if (nr==0)
6550 snprintf(buf,250,"wrong length of parameters(%d), expected ",t);
6551 else if (t==0)
6552 snprintf(buf,250,"par. %d is of undefined, expected ",nr);
6553 else
6554 snprintf(buf,250,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6555 for(int i=1;i<=T[0];i++)
6556 {
6557 strcat(buf,"`");
6559 strcat(buf,"`");
6560 if (i<T[0]) strcat(buf,",");
6561 }
6562 WerrorS(buf);
6563}
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 6623 of file ipshell.cc.

6624{
6625 if ((source->next==NULL)&&(source->e==NULL))
6626 {
6627 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6628 {
6629 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6630 source->Init();
6631 return;
6632 }
6633 if (source->rtyp==IDHDL)
6634 {
6635 if ((IDLEV((idhdl)source->data)==myynest)
6636 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6637 {
6643 IDATTR((idhdl)source->data)=NULL;
6644 IDDATA((idhdl)source->data)=NULL;
6645 source->name=NULL;
6646 source->attribute=NULL;
6647 return;
6648 }
6649 }
6650 }
6652}
void Copy(leftv e)
Definition subexpr.cc:689
BITSET flag
Definition subexpr.h:90
#define IDATTR(a)
Definition ipid.h:123
@ ALIAS_CMD
Definition tok.h:34

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6442 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3339 of file ipshell.cc.

3340{
3342 return (res->data==NULL);
3343}
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 6277 of file ipshell.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

3333{
3334 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3335 (poly)w->CopyD(), currRing);
3336 return errorreported;
3337}
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 6307 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6299 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387{
388 BOOLEAN changed=FALSE;
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)
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:1691
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:16

◆ 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);
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 3315 of file ipshell.cc.

3316{
3317 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3318 if (res->data==NULL)
3319 res->data=(char *)new intvec(rVar(currRing));
3320 return FALSE;
3321}
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3287 of file ipshell.cc.

3288{
3289 ideal F=(ideal)id->Data();
3290 intvec * iv = new intvec(rVar(currRing));
3291 polyset s;
3292 int sl, n, i;
3293 int *x;
3294
3295 res->data=(char *)iv;
3296 s = F->m;
3297 sl = IDELEMS(F) - 1;
3298 n = rVar(currRing);
3299 if (sl==-1)
3300 {
3301 for(int i=0;i<n;i++) (*iv)[i]=1;
3302 return FALSE;
3303 }
3304
3305 double wNsqr = (double)2.0 / (double)n;
3307 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3308 wCall(s, sl, x, wNsqr, currRing);
3309 for (i = n; i!=0; i--)
3310 (*iv)[i-1] = x[i + n + 1];
3311 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3312 return FALSE;
3313}
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:126
Matrices of numbers.
Definition bigintmat.h:51
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition coeffs.h:960
CanonicalForm buf2
Definition facFqBivar.cc:76
@ SMATRIX_CMD
Definition grammar.cc:292
void ipListFlag(idhdl h)
Definition ipid.cc:619
#define IDMATRIX(a)
Definition ipid.h:134
#define IDSTRING(a)
Definition ipid.h:136
#define IDINTVEC(a)
Definition ipid.h:128
#define IDPOLY(a)
Definition ipid.h:130
void paPrint(const char *n, package p)
Definition ipshell.cc:6322
#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:311
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;
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
439 h=basePack->idroot;
440 }
441 else
442 {
443 h = ggetid(what);
444 if (h!=NULL)
445 {
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");
457 h=IDPACKAGE(h)->idroot;
458 }
459 else
460 {
462 return;
463 }
464 }
465 else
466 {
467 Werror("%s is undefined",what);
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 {
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);
505 }
506 }
507 h = IDNEXT(h);
508 }
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 3460 of file ipshell.cc.

3461{
3462 switch( state )
3463 {
3464 case semicListTooShort:
3465 WerrorS( "the list is too short" );
3466 break;
3467 case semicListTooLong:
3468 WerrorS( "the list is too long" );
3469 break;
3470
3472 WerrorS( "first element of the list should be int" );
3473 break;
3475 WerrorS( "second element of the list should be int" );
3476 break;
3478 WerrorS( "third element of the list should be int" );
3479 break;
3481 WerrorS( "fourth element of the list should be intvec" );
3482 break;
3484 WerrorS( "fifth element of the list should be intvec" );
3485 break;
3487 WerrorS( "sixth element of the list should be intvec" );
3488 break;
3489
3490 case semicListNNegative:
3491 WerrorS( "first element of the list should be positive" );
3492 break;
3494 WerrorS( "wrong number of numerators" );
3495 break;
3497 WerrorS( "wrong number of denominators" );
3498 break;
3500 WerrorS( "wrong number of multiplicities" );
3501 break;
3502
3504 WerrorS( "the Milnor number should be positive" );
3505 break;
3507 WerrorS( "the geometrical genus should be nonnegative" );
3508 break;
3510 WerrorS( "all numerators should be positive" );
3511 break;
3513 WerrorS( "all denominators should be positive" );
3514 break;
3516 WerrorS( "all multiplicities should be positive" );
3517 break;
3518
3520 WerrorS( "it is not symmetric" );
3521 break;
3523 WerrorS( "it is not monotonous" );
3524 break;
3525
3527 WerrorS( "the Milnor number is wrong" );
3528 break;
3529 case semicListPGWrong:
3530 WerrorS( "the geometrical genus is wrong" );
3531 break;
3532
3533 default:
3534 WerrorS( "unspecific error" );
3535 break;
3536 }
3537}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4245 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5071 of file ipshell.cc.

5072{
5073 int i,j;
5074 int count= self->roots[0]->getAnzRoots(); // number of roots
5075 int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5076
5077 lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5078
5079 if ( self->found_roots )
5080 {
5081 listofroots->Init( count );
5082
5083 for (i=0; i < count; i++)
5084 {
5085 lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5086 onepoint->Init(elem);
5087 for ( j= 0; j < elem; j++ )
5088 {
5089 if ( !rField_is_long_C(currRing) )
5090 {
5091 onepoint->m[j].rtyp=STRING_CMD;
5092 onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5093 }
5094 else
5095 {
5096 onepoint->m[j].rtyp=NUMBER_CMD;
5097 onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5098 }
5099 onepoint->m[j].next= NULL;
5100 onepoint->m[j].name= NULL;
5101 }
5102 listofroots->m[i].rtyp=LIST_CMD;
5103 listofroots->m[i].data=(void *)onepoint;
5104 listofroots->m[j].next= NULL;
5105 listofroots->m[j].name= NULL;
5106 }
5107
5108 }
5109 else
5110 {
5111 listofroots->Init( 0 );
5112 }
5113
5114 return listofroots;
5115}
rootContainer ** roots
gmp_complex * getRoot(const int i)
Definition mpr_numeric.h:88
int getAnzRoots()
Definition mpr_numeric.h:97
int getAnzElems()
Definition mpr_numeric.h:95
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition coeffs.h: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:551
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 4555 of file ipshell.cc.

4556{
4557 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4558 return FALSE;
4559}
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 4561 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3054 of file ipshell.cc.

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

◆ mpKoszul()

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

Definition at line 3076 of file ipshell.cc.

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

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

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

◆ nuMPResMat()

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

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

Definition at line 4647 of file ipshell.cc.

4648{
4649 ideal gls = (ideal)(arg1->Data());
4650 int imtype= (int)(long)arg2->Data();
4651
4653
4654 // check input ideal ( = polynomial system )
4655 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4656 {
4657 return TRUE;
4658 }
4659
4660 uResultant *resMat= new uResultant( gls, mtype, false );
4661 if (resMat!=NULL)
4662 {
4663 res->rtyp = MODUL_CMD;
4664 res->data= (void*)resMat->accessResMat()->getMatrix();
4665 if (!errorreported) delete resMat;
4666 }
4667 return errorreported;
4668}
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 4914 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4813 of file ipshell.cc.

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

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

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

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

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

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2293 of file ipshell.cc.

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

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2143 of file ipshell.cc.

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

◆ rDecompose_23456()

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

Definition at line 2003 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1933 of file ipshell.cc.

1934{
1935 assume( C != NULL );
1936
1937 // sanity check: require currRing==r for rings with polynomial data
1938 if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1939 {
1940 WerrorS("ring with polynomial data must be the base ring or compatible");
1941 return TRUE;
1942 }
1943 if (nCoeff_is_numeric(C))
1944 {
1946 }
1947 else if (nCoeff_is_Ring(C))
1948 {
1950 }
1951 else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1952 {
1953 rDecomposeCF(res, C->extRing, currRing);
1954 }
1955 else if(nCoeff_is_GF(C))
1956 {
1958 Lc->Init(4);
1959 // char:
1960 Lc->m[0].rtyp=INT_CMD;
1961 Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1962 // var:
1964 Lv->Init(1);
1965 Lv->m[0].rtyp=STRING_CMD;
1966 Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1967 Lc->m[1].rtyp=LIST_CMD;
1968 Lc->m[1].data=(void*)Lv;
1969 // ord:
1971 Lo->Init(1);
1973 Loo->Init(2);
1974 Loo->m[0].rtyp=STRING_CMD;
1975 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1976
1977 intvec *iv=new intvec(1); (*iv)[0]=1;
1978 Loo->m[1].rtyp=INTVEC_CMD;
1979 Loo->m[1].data=(void *)iv;
1980
1981 Lo->m[0].rtyp=LIST_CMD;
1982 Lo->m[0].data=(void*)Loo;
1983
1984 Lc->m[2].rtyp=LIST_CMD;
1985 Lc->m[2].data=(void*)Lo;
1986 // q-ideal:
1987 Lc->m[3].rtyp=IDEAL_CMD;
1988 Lc->m[3].data=(void *)idInit(1,1);
1989 // ----------------------
1990 res->rtyp=LIST_CMD;
1991 res->data=(void*)Lc;
1992 }
1993 else
1994 {
1995 res->rtyp=INT_CMD;
1996 res->data=(void *)(long)C->ch;
1997 }
1998 // ----------------------------------------
1999 return FALSE;
2000}
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:1809
static void rDecomposeRing_41(leftv h, const coeffs C)
Definition ipshell.cc:1878

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2104 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1843 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1809 of file ipshell.cc.

1811{
1813 if (nCoeff_is_long_C(C)) L->Init(3);
1814 else L->Init(2);
1815 h->rtyp=LIST_CMD;
1816 h->data=(void *)L;
1817 // 0: char/ cf - ring
1818 // 1: list (var)
1819 // 2: list (ord)
1820 // ----------------------------------------
1821 // 0: char/ cf - ring
1822 L->m[0].rtyp=INT_CMD;
1823 L->m[0].data=(void *)0;
1824 // ----------------------------------------
1825 // 1:
1827 LL->Init(2);
1828 LL->m[0].rtyp=INT_CMD;
1829 LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1830 LL->m[1].rtyp=INT_CMD;
1831 LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1832 L->m[1].rtyp=LIST_CMD;
1833 L->m[1].data=(void *)LL;
1834 // ----------------------------------------
1835 // 2: list (par)
1836 if (nCoeff_is_long_C(C))
1837 {
1838 L->m[2].rtyp=STRING_CMD;
1839 L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1840 }
1841 // ----------------------------------------
1842}
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 1719 of file ipshell.cc.

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1905 of file ipshell.cc.

1907{
1909 if (rField_is_Z(R)) L->Init(1);
1910 else L->Init(2);
1911 h->rtyp=LIST_CMD;
1912 h->data=(void *)L;
1913 // 0: char/ cf - ring
1914 // 1: list (module)
1915 // ----------------------------------------
1916 // 0: char/ cf - ring
1917 L->m[0].rtyp=STRING_CMD;
1918 L->m[0].data=(void *)omStrDup("integer");
1919 // ----------------------------------------
1920 // 1: module
1921 if (rField_is_Z(R)) return;
1923 LL->Init(2);
1924 LL->m[0].rtyp=BIGINT_CMD;
1925 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1926 LL->m[1].rtyp=INT_CMD;
1927 LL->m[1].data=(void *) R->cf->modExponent;
1928 L->m[1].rtyp=LIST_CMD;
1929 L->m[1].data=(void *)LL;
1930}
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:515

◆ rDecomposeRing_41()

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

Definition at line 1878 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char s)

Definition at line 1635 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1691 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5617 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6215 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6170 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5178 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2385 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5118 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6258 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5569 of file ipshell.cc.

5570{
5571
5572 while(sl!=NULL)
5573 {
5574 if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5575 {
5576 *p = omStrDup(sl->Name());
5577 }
5578 else if (sl->name!=NULL)
5579 {
5580 *p = (char*)sl->name;
5581 sl->name=NULL;
5582 }
5583 else if (sl->rtyp==POLY_CMD)
5584 {
5585 sleftv s_sl;
5587 if (s_sl.name != NULL)
5588 {
5589 *p = (char*)s_sl.name; s_sl.name=NULL;
5590 }
5591 else
5592 *p = NULL;
5593 sl->next = s_sl.next;
5594 s_sl.next = NULL;
5595 s_sl.CleanUp();
5596 if (*p == NULL) return TRUE;
5597 }
5598 else return TRUE;
5599 p++;
5600 sl=sl->next;
5601 }
5602 return FALSE;
5603}

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5297 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 6008 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

1105{
1106 int i;
1107 indset save;
1109
1110 hexist = hInit(S, Q, &hNexist);
1111 if (hNexist == 0)
1112 {
1113 intvec *iv=new intvec(rVar(currRing));
1114 for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1115 res->Init(1);
1116 res->m[0].rtyp=INTVEC_CMD;
1117 res->m[0].data=(intvec*)iv;
1118 return res;
1119 }
1121 hMu = 0;
1122 hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1123 hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1124 hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1125 hrad = hexist;
1126 hNrad = hNexist;
1127 radmem = hCreate(rVar(currRing) - 1);
1128 hCo = rVar(currRing) + 1;
1129 hNvar = rVar(currRing);
1131 hSupp(hrad, hNrad, hvar, &hNvar);
1132 if (hNvar)
1133 {
1134 hCo = hNvar;
1135 hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1138 }
1139 if (hCo && (hCo < rVar(currRing)))
1140 {
1142 }
1143 if (hMu!=0)
1144 {
1145 ISet = save;
1146 hMu2 = 0;
1147 if (all && (hCo+1 < rVar(currRing)))
1148 {
1151 i=hMu+hMu2;
1152 res->Init(i);
1153 if (hMu2 == 0)
1154 {
1156 }
1157 }
1158 else
1159 {
1160 res->Init(hMu);
1161 }
1162 for (i=0;i<hMu;i++)
1163 {
1164 res->m[i].data = (void *)save->set;
1165 res->m[i].rtyp = INTVEC_CMD;
1166 ISet = save;
1167 save = save->nx;
1169 }
1171 if (hMu2 != 0)
1172 {
1173 save = JSet;
1174 for (i=hMu;i<hMu+hMu2;i++)
1175 {
1176 res->m[i].data = (void *)save->set;
1177 res->m[i].rtyp = INTVEC_CMD;
1178 JSet = save;
1179 save = save->nx;
1181 }
1183 }
1184 }
1185 else
1186 {
1187 res->Init(0);
1189 }
1190 hKill(radmem, rVar(currRing) - 1);
1191 omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1192 omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1193 omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1195 return res;
1196}
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition hdegree.cc: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 4543 of file ipshell.cc.

4544{
4545 sleftv tmp;
4546 tmp.Init();
4547 tmp.rtyp=INT_CMD;
4548 /* tmp.data = (void *)0; -- done by Init */
4549
4550 return semicProc3(res,u,v,&tmp);
4551}
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition ipshell.cc:4503

◆ semicProc3()

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

Definition at line 4503 of file ipshell.cc.

4504{
4505 semicState state;
4506 BOOLEAN qh=(((int)(long)w->Data())==1);
4507
4508 // -----------------
4509 // check arguments
4510 // -----------------
4511
4512 lists l1 = (lists)u->Data( );
4513 lists l2 = (lists)v->Data( );
4514
4515 if( (state=list_is_spectrum( l1 ))!=semicOK )
4516 {
4517 WerrorS( "first argument is not a spectrum" );
4518 list_error( state );
4519 }
4520 else if( (state=list_is_spectrum( l2 ))!=semicOK )
4521 {
4522 WerrorS( "second argument is not a spectrum" );
4523 list_error( state );
4524 }
4525 else
4526 {
4529
4530 res->rtyp = INT_CMD;
4531 if (qh)
4532 res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4533 else
4534 res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4535 }
4536
4537 // -----------------
4538 // check status
4539 // -----------------
4540
4541 return (state!=semicOK);
4542}
void list_error(semicState state)
Definition ipshell.cc:3460
spectrum spectrumFromList(lists l)
Definition ipshell.cc:3376
semicState list_is_spectrum(lists l)
Definition ipshell.cc:4245

◆ spaddProc()

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

Definition at line 4420 of file ipshell.cc.

4421{
4422 semicState state;
4423
4424 // -----------------
4425 // check arguments
4426 // -----------------
4427
4428 lists l1 = (lists)first->Data( );
4429 lists l2 = (lists)second->Data( );
4430
4431 if( (state=list_is_spectrum( l1 )) != semicOK )
4432 {
4433 WerrorS( "first argument is not a spectrum:" );
4434 list_error( state );
4435 }
4436 else if( (state=list_is_spectrum( l2 )) != semicOK )
4437 {
4438 WerrorS( "second argument is not a spectrum:" );
4439 list_error( state );
4440 }
4441 else
4442 {
4445 spectrum sum( s1+s2 );
4446
4447 result->rtyp = LIST_CMD;
4448 result->data = (char*)(getList(sum));
4449 }
4450
4451 return (state!=semicOK);
4452}
lists getList(spectrum &spec)
Definition ipshell.cc:3388

◆ spectrumCompute()

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

Definition at line 3802 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4176 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3376 of file ipshell.cc.

3377{
3379 copy_deep( result, l );
3380 return result;
3381}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3352

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4094 of file ipshell.cc.

4095{
4096 switch( state )
4097 {
4098 case spectrumZero:
4099 WerrorS( "polynomial is zero" );
4100 break;
4101 case spectrumBadPoly:
4102 WerrorS( "polynomial has constant term" );
4103 break;
4105 WerrorS( "not a singularity" );
4106 break;
4108 WerrorS( "the singularity is not isolated" );
4109 break;
4110 case spectrumNoHC:
4111 WerrorS( "highest corner cannot be computed" );
4112 break;
4113 case spectrumDegenerate:
4114 WerrorS( "principal part is degenerate" );
4115 break;
4116 case spectrumOK:
4117 break;
4118
4119 default:
4120 WerrorS( "unknown error occurred" );
4121 break;
4122 }
4123}

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4125 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3561 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4462 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3156 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3132 of file ipshell.cc.

3133{
3135
3136 BOOLEAN minim=(int)(long)w->Data();
3137 int row_shift=0;
3138 int add_row_shift=0;
3139 intvec *weights=NULL;
3140 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3141 if (ww!=NULL)
3142 {
3143 weights=ivCopy(ww);
3144 add_row_shift = ww->min_in();
3145 (*weights) -= add_row_shift;
3146 }
3147
3148 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3149 if (ww!=NULL) delete weights;
3150 //row_shift += add_row_shift;
3151 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3152 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3153
3154 return FALSE;
3155}
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 3240 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3168 of file ipshell.cc.

3169{
3170 resolvente fullres = syzstr->fullres;
3171 resolvente minres = syzstr->minres;
3172
3173 const int length = syzstr->length;
3174
3175 if ((fullres==NULL) && (minres==NULL))
3176 {
3177 if (syzstr->hilb_coeffs==NULL)
3178 { // La Scala
3179 fullres = syReorder(syzstr->res, length, syzstr);
3180 }
3181 else
3182 { // HRES
3183 minres = syReorder(syzstr->orderedRes, length, syzstr);
3184 syKillEmptyEntres(minres, length);
3185 }
3186 }
3187
3188 resolvente tr;
3189 int typ0=IDEAL_CMD;
3190
3191 if (minres!=NULL)
3192 tr = minres;
3193 else
3194 tr = fullres;
3195
3197 intvec ** w=NULL;
3198
3199 if (length>0)
3200 {
3201 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3202 for (int i=length-1;i>=0;i--)
3203 {
3204 if (tr[i]!=NULL)
3205 {
3206 trueres[i] = idCopy(tr[i]);
3207 }
3208 }
3209 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3210 typ0 = MODUL_CMD;
3211 if (syzstr->weights!=NULL)
3212 {
3213 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3214 for (int i=length-1;i>=0;i--)
3215 {
3216 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3217 }
3218 }
3219 }
3220
3221 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3222 w, add_row_shift);
3223
3224 if (toDel)
3226 else
3227 {
3228 if( fullres != NULL && syzstr->fullres == NULL )
3229 syzstr->fullres = fullres;
3230
3231 if( minres != NULL && syzstr->minres == NULL )
3232 syzstr->minres = minres;
3233 }
3234 return li;
3235}
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
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

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

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5605 of file ipshell.cc.