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

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3536 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3346 of file ipshell.cc.

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

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

6415{
6416 res->Init();
6417 res->rtyp=a->Typ();
6418 switch (res->rtyp /*a->Typ()*/)
6419 {
6420 case INTVEC_CMD:
6421 case INTMAT_CMD:
6422 return iiApplyINTVEC(res,a,op,proc);
6423 case BIGINTMAT_CMD:
6424 return iiApplyBIGINTMAT(res,a,op,proc);
6425 case IDEAL_CMD:
6426 case MODUL_CMD:
6427 case MATRIX_CMD:
6428 return iiApplyIDEAL(res,a,op,proc);
6429 case LIST_CMD:
6430 return iiApplyLIST(res,a,op,proc);
6431 }
6432 WerrorS("first argument to `apply` must allow an index");
6433 return TRUE;
6434}
#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:6333
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6375
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6370
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6365

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6365 of file ipshell.cc.

6366{
6367 WerrorS("not implemented");
6368 return TRUE;
6369}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6370 of file ipshell.cc.

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

◆ iiApplyINTVEC()

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

Definition at line 6333 of file ipshell.cc.

6334{
6335 intvec *aa=(intvec*)a->Data();
6337 sleftv tmp_in;
6338 leftv curr=res;
6340 for(int i=0;i<aa->length(); i++)
6341 {
6342 tmp_in.Init();
6343 tmp_in.rtyp=INT_CMD;
6344 tmp_in.data=(void*)(long)(*aa)[i];
6345 if (proc==NULL)
6347 else
6349 if (bo)
6350 {
6351 res->CleanUp(currRing);
6352 Werror("apply fails at index %d",i+1);
6353 return TRUE;
6354 }
6355 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6356 else
6357 {
6359 curr=curr->next;
6360 memcpy(curr,&tmp_out,sizeof(tmp_out));
6361 }
6362 }
6363 return FALSE;
6364}
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:9352
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 6375 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6463 of file ipshell.cc.

6464{
6465 size_t len=strlen(a)+strlen(s)+30; /* max. 27 currently */
6466 char *ss=(char*)omAlloc(len);
6467 // find end of s:
6468 int end_s=strlen(s);
6469 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6470 s[end_s+1]='\0';
6471 char *name=(char *)omAlloc(len);
6472 snprintf(name,len,"%s->%s",a,s);
6473 // find start of last expression
6474 int start_s=end_s-1;
6475 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6476 if (start_s<0) // ';' not found
6477 {
6478 snprintf(ss,len,"parameter def %s;return(%s);\n",a,s);
6479 }
6480 else // s[start_s] is ';'
6481 {
6482 s[start_s]='\0';
6483 snprintf(ss,len,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6484 }
6485 r->Init();
6486 // now produce procinfo for PROC_CMD:
6487 r->data = (void *)omAlloc0Bin(procinfo_bin);
6488 ((procinfo *)(r->data))->language=LANG_NONE;
6490 ((procinfo *)r->data)->data.s.body=ss;
6491 omFree(name);
6492 r->rtyp=PROC_CMD;
6493 //r->rtyp=STRING_CMD;
6494 //r->data=ss;
6495 return FALSE;
6496}
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 6498 of file ipshell.cc.

6499{
6500 char* ring_name=omStrDup((char*)r->Name());
6501 int t=arg->Typ();
6502 if (t==RING_CMD)
6503 {
6504 sleftv tmp;
6505 tmp.Init();
6506 tmp.rtyp=IDHDL;
6508 IDRING(h)=NULL;
6509 tmp.data=(char*)h;
6510 if (h!=NULL)
6511 {
6512 tmp.name=h->id;
6513 BOOLEAN b=iiAssign(&tmp,arg);
6514 if (b) return TRUE;
6517 return FALSE;
6518 }
6519 else
6520 return TRUE;
6521 }
6522 else if (t==CRING_CMD)
6523 {
6524 sleftv tmp;
6525 sleftv n;
6526 n.Init();
6527 n.name=ring_name;
6528 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6529 if (iiAssign(&tmp,arg)) return TRUE;
6530 //Print("create %s\n",r->Name());
6531 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6532 return FALSE;
6533 }
6534 //Print("create %s\n",r->Name());
6535 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6536 return TRUE;// not handled -> error for now
6537}
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:583
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:281
#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:5112
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:9760
VAR package currPack
Definition ipid.cc:57
VAR idhdl currPackHdl
Definition ipid.cc:55
idhdl packFindHdl(package r)
Definition ipid.cc:833
#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:6559
void killlocals(int v)
Definition ipshell.cc:386
VAR leftv iiCurrArgs
Definition ipshell.cc:80
#define pi
Definition libparse.cc:1145
#define omFreeBin(addr, bin)
#define omFreeBinAddr(addr)
VAR unsigned si_opt_2
Definition options.c:6
VAR unsigned si_opt_1
Definition options.c:5
idrec * idhdl
Definition ring.h:21
void myychangebuffer()
Definition scanner.cc:2311
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:58
#define IDPACKAGE(a)
Definition ipid.h:139
#define IDTYP(a)
Definition ipid.h:119
@ PACKAGE_CMD
Definition tok.h:150

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 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 6559 of file ipshell.cc.

6560{
6561 int l=0;
6562 if (args==NULL)
6563 {
6564 if (type_list[0]==0) return TRUE;
6565 }
6566 else l=args->listLength();
6567 if (l!=(int)type_list[0])
6568 {
6569 if (report) iiReportTypes(0,l,type_list);
6570 return FALSE;
6571 }
6572 for(int i=1;i<=l;i++,args=args->next)
6573 {
6574 short t=type_list[i];
6575 if (t!=ANY_TYPE)
6576 {
6577 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6578 || (t!=args->Typ()))
6579 {
6580 if (report) iiReportTypes(i,args->Typ(),type_list);
6581 return FALSE;
6582 }
6583 }
6584 }
6585 return TRUE;
6586}
static void iiReportTypes(int nr, int t, const short *T)
Definition ipshell.cc:6539
#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:59
#define IDFLAG(a)
Definition ipid.h:120
#define FLAG_QRING_DEF
Definition ipid.h:109
#define IDLEV(a)
Definition ipid.h:121
#define TEST_V_ALLWARN
Definition options.h:145
#define Sy_bit(x)
Definition options.h:31
@ QRING_CMD
Definition tok.h:160

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 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:447
#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:179
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition monomials.h:44
#define nInit(i)
Definition numbers.h:24
#define pSetm(p)
Definition polys.h:271
#define pSetComp(p, v)
Definition polys.h:38
#define pGetExp(p, i)
Exponent.
Definition polys.h:41
#define pOne()
Definition polys.h:315
#define pDecrExp(p, i)
Definition polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition ring.h:597
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:767

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 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:847
static void rDecRefCnt(ring r)
Definition ring.h:848

◆ 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:72
int typ
Definition idrec.h:43
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition coeffs.h:701
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition coeffs.h:80
const CanonicalForm & w
Definition facAbsFact.cc:51
int j
Definition facHensel.cc:110
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition gen_maps.cc:87
@ MAP_CMD
Definition grammar.cc:286
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
#define IDMAP(a)
Definition ipid.h:135
#define IDIDEAL(a)
Definition ipid.h:133
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition maps_ip.cc:45
#define omReallocSize(addr, o_size, size)
poly p_One(const ring r)
Definition p_polys.cc:1314
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition p_polys.h:489
static void p_Setm(poly p, const ring r)
Definition p_polys.h:234
static void p_Delete(poly *p, const ring r)
Definition p_polys.h:902
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition p_polys.h:847
static long p_Totaldegree(poly p, const ring r)
Definition p_polys.h:1522
static long pTotaldegree(poly p)
Definition polys.h:282
poly * polyset
Definition polys.h:259
static BOOLEAN rIsLPRing(const ring r)
Definition ring.h:416
ideal idInit(int idsize, int rank)
initialise an ideal / module
#define IDELEMS(i)

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 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:145
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition lists.cc:338
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition syz.cc:783

◆ iiReportTypes()

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

Definition at line 6539 of file ipshell.cc.

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

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

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

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 586 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 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:85

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3333 of file ipshell.cc.

3334{
3336 return (res->data==NULL);
3337}
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 6271 of file ipshell.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

3327{
3328 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3329 (poly)w->CopyD(), currRing);
3330 return errorreported;
3331}
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 6301 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6293 of file ipshell.cc.

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

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

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

296{
297 idhdl h = *localhdl;
298 while (h!=NULL)
299 {
300 int vv;
301 //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
302 if ((vv=IDLEV(h))>0)
303 {
304 if (vv < v)
305 {
306 if (iiNoKeepRing)
307 {
308 //PrintS(" break\n");
309 return;
310 }
311 h = IDNEXT(h);
312 //PrintLn();
313 }
314 else //if (vv >= v)
315 {
316 idhdl nexth = IDNEXT(h);
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 3309 of file ipshell.cc.

3310{
3311 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3312 if (res->data==NULL)
3313 res->data=(char *)new intvec(rVar(currRing));
3314 return FALSE;
3315}
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 double wNsqr = (double)2.0 / (double)n;
3301 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3302 wCall(s, sl, x, wNsqr, currRing);
3303 for (i = n; i!=0; i--)
3304 (*iv)[i-1] = x[i + n + 1];
3305 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3306 return FALSE;
3307}
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:621
#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:6316
#define MATROWS(i)
Definition matpol.h:26
#define MATCOLS(i)
Definition matpol.h:27
static int pLength(poly a)
Definition p_polys.h:190
void wrp(poly p)
Definition polys.h:310
void PrintS(const char *s)
Definition reporter.cc:284
void PrintLn()
Definition reporter.cc:310
EXTERN_VAR int traceit
Definition reporter.h:24
#define TRACE_SHOW_RINGS
Definition reporter.h:36
@ LANG_C
Definition subexpr.h:22
@ CMATRIX_CMD
Definition tok.h:46
@ CNUMBER_CMD
Definition tok.h:47

◆ list_cmd()

void list_cmd ( int  typ,
const char what,
const char prefix,
BOOLEAN  iterate,
BOOLEAN  fullname 
)

Definition at line 425 of file ipshell.cc.

426{
427 package savePack=currPack;
428 idhdl h,start;
429 BOOLEAN all = typ<0;
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 3454 of file ipshell.cc.

3455{
3456 switch( state )
3457 {
3458 case semicListTooShort:
3459 WerrorS( "the list is too short" );
3460 break;
3461 case semicListTooLong:
3462 WerrorS( "the list is too long" );
3463 break;
3464
3466 WerrorS( "first element of the list should be int" );
3467 break;
3469 WerrorS( "second element of the list should be int" );
3470 break;
3472 WerrorS( "third element of the list should be int" );
3473 break;
3475 WerrorS( "fourth element of the list should be intvec" );
3476 break;
3478 WerrorS( "fifth element of the list should be intvec" );
3479 break;
3481 WerrorS( "sixth element of the list should be intvec" );
3482 break;
3483
3484 case semicListNNegative:
3485 WerrorS( "first element of the list should be positive" );
3486 break;
3488 WerrorS( "wrong number of numerators" );
3489 break;
3491 WerrorS( "wrong number of denominators" );
3492 break;
3494 WerrorS( "wrong number of multiplicities" );
3495 break;
3496
3498 WerrorS( "the Milnor number should be positive" );
3499 break;
3501 WerrorS( "the geometrical genus should be nonnegative" );
3502 break;
3504 WerrorS( "all numerators should be positive" );
3505 break;
3507 WerrorS( "all denominators should be positive" );
3508 break;
3510 WerrorS( "all multiplicities should be positive" );
3511 break;
3512
3514 WerrorS( "it is not symmetric" );
3515 break;
3517 WerrorS( "it is not monotonous" );
3518 break;
3519
3521 WerrorS( "the Milnor number is wrong" );
3522 break;
3523 case semicListPGWrong:
3524 WerrorS( "the geometrical genus is wrong" );
3525 break;
3526
3527 default:
3528 WerrorS( "unspecific error" );
3529 break;
3530 }
3531}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4239 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5065 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4549 of file ipshell.cc.

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

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 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:296

◆ 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:198
#define pCopy(p)
return a copy of the poly
Definition polys.h:185
static int sign(int x)
Definition ring.cc:3458

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

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

◆ nuMPResMat()

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

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

Definition at line 4641 of file ipshell.cc.

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

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

◆ nuVanderSys()

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

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

Definition at line 4807 of file ipshell.cc.

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

6317{
6318 Print(" %s (",n);
6319 switch (p->language)
6320 {
6321 case LANG_SINGULAR: PrintS("S"); break;
6322 case LANG_C: PrintS("C"); break;
6323 case LANG_TOP: PrintS("T"); break;
6324 case LANG_MAX: PrintS("M"); break;
6325 case LANG_NONE: PrintS("N"); break;
6326 default: PrintS("U");
6327 }
6328 if(p->libname!=NULL)
6329 Print(",%s", p->libname);
6330 PrintS(")");
6331}
@ 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->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:4171
#define pTest(p)
Definition polys.h:414
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition prCopy.cc:192
int IsPrime(int p)
Definition prime.cc:61
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition ring.cc:3481
VAR omBin sip_sring_bin
Definition ring.cc:43
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition ring.cc:1749
static BOOLEAN rField_is_Zp_a(const ring r)
Definition ring.h:534
static BOOLEAN rField_is_Zn(const ring r)
Definition ring.h:517
static int rPar(const ring r)
(r->cf->P)
Definition ring.h:604
static int rInternalChar(const ring r)
Definition ring.h:694
static BOOLEAN rField_is_Q_a(const ring r)
Definition ring.h:544
#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:102
void show(int mat=0, int spaces=0) const
Definition intvec.cc:149
int length() const
Definition intvec.h:94
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ....
Definition coeffs.h:548
VAR coeffs coeffs_BIGINT
Definition ipid.cc:50
char * lString(lists l, BOOLEAN typed, int dim)
Definition lists.cc:403
gmp_float sqrt(const gmp_float &a)
#define omRealloc0Size(addr, o_size, size)
const char * rSimpleOrdStr(int ord)
Definition ring.cc:78
rRingOrder_t rOrderName(char *ordername)
Definition ring.cc:510
void rSetSyzComp(int k, const ring r)
Definition ring.cc:5185
#define ringorder_rp
Definition ring.h:99
rRingOrder_t
order stuff
Definition ring.h:68
@ ringorder_lp
Definition ring.h:77
@ ringorder_a
Definition ring.h:70
@ ringorder_am
Definition ring.h:89
@ ringorder_a64
for int64 weights
Definition ring.h:71
@ ringorder_C
Definition ring.h:73
@ ringorder_S
S?
Definition ring.h:75
@ ringorder_ds
Definition ring.h:85
@ ringorder_Dp
Definition ring.h:80
@ ringorder_unspec
Definition ring.h:95
@ ringorder_L
Definition ring.h:90
@ ringorder_Ds
Definition ring.h:86
@ ringorder_Ip
Definition ring.h:83
@ ringorder_dp
Definition ring.h:78
@ ringorder_c
Definition ring.h:72
@ ringorder_aa
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition ring.h:92
@ ringorder_Wp
Definition ring.h:82
@ ringorder_ws
Definition ring.h:87
@ ringorder_Ws
Definition ring.h:88
@ ringorder_IS
Induced (Schreyer) ordering.
Definition ring.h:94
@ ringorder_ls
degree, ip
Definition ring.h:84
@ ringorder_s
s?
Definition ring.h:76
@ ringorder_wp
Definition ring.h:81
@ ringorder_M
Definition ring.h:74
#define ringorder_rs
Definition ring.h:100
int * int_ptr
Definition structs.h: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:248

◆ 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:405
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition ring.h:630
static BOOLEAN rField_is_numeric(const ring r)
Definition ring.h:520
static BOOLEAN rField_is_GF(const ring r)
Definition ring.h:526
#define rField_is_Ring(R)
Definition ring.h:490

◆ rDecompose_23456()

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

Definition at line 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:573

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

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

◆ 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:52
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition ipshell.cc:6252

◆ rInit()

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

Definition at line 5611 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6209 of file ipshell.cc.

6210{
6211 ring r = IDRING(h);
6212 int ref=0;
6213 if (r!=NULL)
6214 {
6215 // avoid, that sLastPrinted is the last reference to the base ring:
6216 // clean up before killing the last "named" refrence:
6218 && (sLastPrinted.data==(void*)r))
6219 {
6221 }
6222 ref=r->ref;
6223 if ((ref<=0)&&(r==currRing))
6224 {
6225 // cleanup DENOMINATOR_LIST
6227 {
6229 if (TEST_V_ALLWARN)
6230 Warn("deleting denom_list for ring change from %s",IDID(h));
6231 do
6232 {
6233 n_Delete(&(dd->n),currRing->cf);
6234 dd=dd->next;
6237 } while(DENOMINATOR_LIST!=NULL);
6238 }
6239 }
6240 rKill(r);
6241 }
6242 if (h==currRingHdl)
6243 {
6244 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6245 else
6246 {
6248 }
6249 }
6250}
void rKill(ring r)
Definition ipshell.cc:6164
VAR denominator_list DENOMINATOR_LIST
Definition kutil.cc:84

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6164 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5172 of file ipshell.cc.

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

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

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

◆ rSimpleFindHdl()

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

Definition at line 6252 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5563 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5291 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 6002 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 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 4537 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4497 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4414 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3796 of file ipshell.cc.

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

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3370 of file ipshell.cc.

3371{
3373 copy_deep( result, l );
3374 return result;
3375}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3346

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4088 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4119 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3555 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4456 of file ipshell.cc.

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

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