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

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3546 of file ipshell.cc.

3547{
3548 spectrumOK,
3557};
@ spectrumWrongRing
Definition ipshell.cc:3554
@ spectrumOK
Definition ipshell.cc:3548
@ spectrumDegenerate
Definition ipshell.cc:3553
@ spectrumUnspecErr
Definition ipshell.cc:3556
@ spectrumNotIsolated
Definition ipshell.cc:3552
@ spectrumBadPoly
Definition ipshell.cc:3550
@ spectrumNoSingularity
Definition ipshell.cc:3551
@ spectrumZero
Definition ipshell.cc:3549
@ spectrumNoHC
Definition ipshell.cc:3555

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3356 of file ipshell.cc.

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

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

6426{
6427 res->Init();
6428 res->rtyp=a->Typ();
6429 switch (res->rtyp /*a->Typ()*/)
6430 {
6431 case INTVEC_CMD:
6432 case INTMAT_CMD:
6433 return iiApplyINTVEC(res,a,op,proc);
6434 case BIGINTMAT_CMD:
6435 return iiApplyBIGINTMAT(res,a,op,proc);
6436 case IDEAL_CMD:
6437 case MODUL_CMD:
6438 case MATRIX_CMD:
6439 return iiApplyIDEAL(res,a,op,proc);
6440 case LIST_CMD:
6441 return iiApplyLIST(res,a,op,proc);
6442 }
6443 WerrorS("first argument to `apply` must allow an index");
6444 return TRUE;
6445}
#define TRUE
Definition auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition checklibs.c:16
int Typ()
Definition subexpr.cc:1048
CanonicalForm res
Definition facAbsFact.cc:60
void WerrorS(const char *s)
Definition feFopen.cc:24
@ BIGINTMAT_CMD
Definition grammar.cc:278
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6344
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6386
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6381
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6376

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6376 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6381 of file ipshell.cc.

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

◆ iiApplyINTVEC()

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

Definition at line 6344 of file ipshell.cc.

6345{
6346 intvec *aa=(intvec*)a->Data();
6348 sleftv tmp_in;
6349 leftv curr=res;
6351 for(int i=0;i<aa->length(); i++)
6352 {
6353 tmp_in.Init();
6354 tmp_in.rtyp=INT_CMD;
6355 tmp_in.data=(void*)(long)(*aa)[i];
6356 if (proc==NULL)
6358 else
6360 if (bo)
6361 {
6362 res->CleanUp(currRing);
6363 Werror("apply fails at index %d",i+1);
6364 return TRUE;
6365 }
6366 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6367 else
6368 {
6370 curr=curr->next;
6371 memcpy(curr,&tmp_out,sizeof(tmp_out));
6372 }
6373 }
6374 return FALSE;
6375}
int BOOLEAN
Definition auxiliary.h:87
#define FALSE
Definition auxiliary.h:96
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:9355
EXTERN_VAR omBin sleftv_bin
Definition ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition iparith.cc:1614
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition polys.cc:13
void Werror(const char *fmt,...)
Definition reporter.cc:189
sleftv * leftv
Definition structs.h:57

◆ iiApplyLIST()

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

Definition at line 6386 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6474 of file ipshell.cc.

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

6510{
6511 char* ring_name=omStrDup((char*)r->Name());
6512 int t=arg->Typ();
6513 if (t==RING_CMD)
6514 {
6515 sleftv tmp;
6516 tmp.Init();
6517 tmp.rtyp=IDHDL;
6519 tmp.data=(char*)h;
6520 if (h!=NULL)
6521 {
6522 tmp.name=h->id;
6523 BOOLEAN b=iiAssign(&tmp,arg);
6524 if (b) return TRUE;
6527 return FALSE;
6528 }
6529 else
6530 return TRUE;
6531 }
6532 else if (t==CRING_CMD)
6533 {
6534 sleftv tmp;
6535 sleftv n;
6536 n.Init();
6537 n.name=ring_name;
6538 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6539 if (iiAssign(&tmp,arg)) return TRUE;
6540 //Print("create %s\n",r->Name());
6541 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6542 return FALSE;
6543 }
6544 //Print("create %s\n",r->Name());
6545 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6546 return TRUE;// not handled -> error for now
6547}
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
#define IDROOT
Definition ipid.h:19
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition ipshell.cc:1197
idhdl rDefault(const char *s)
Definition ipshell.cc:1643
void rSetHdl(idhdl h)
Definition ipshell.cc:5122
STATIC_VAR Poly * h
Definition janet.cc:971
#define omStrDup(s)
#define IDHDL
Definition tok.h:31
@ CRING_CMD
Definition tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1272 of file ipshell.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1629 of file ipshell.cc.

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

1586{
1587 if (currRing==NULL)
1588 {
1589 #ifdef SIQ
1590 if (siq<=0)
1591 {
1592 #endif
1593 if (RingDependend(i))
1594 {
1595 WerrorS("no ring active (9)");
1596 return TRUE;
1597 }
1598 #ifdef SIQ
1599 }
1600 #endif
1601 }
1602 return FALSE;
1603}
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 6567 of file ipshell.cc.

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

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 935 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1064 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1197 of file ipshell.cc.

1198{
1201 const char *id = name->name;
1202
1203 sy->Init();
1204 if ((name->name==NULL)||(isdigit(name->name[0])))
1205 {
1206 WerrorS("object to declare is not a name");
1207 res=TRUE;
1208 }
1209 else
1210 {
1211 if (root==NULL) return TRUE;
1212 if (*root!=IDROOT)
1213 {
1214 if ((currRing==NULL) || (*root!=currRing->idroot))
1215 {
1216 Werror("can not define `%s` in other package",name->name);
1217 return TRUE;
1218 }
1219 }
1220 if (t==QRING_CMD)
1221 {
1222 t=RING_CMD; // qring is always RING_CMD
1223 is_qring=TRUE;
1224 }
1225
1226 if (TEST_V_ALLWARN
1227 && (name->rtyp!=0)
1228 && (name->rtyp!=IDHDL)
1230 {
1231 Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1233 }
1234 {
1235 sy->data = (char *)enterid(id,lev,t,root,init_b);
1236 }
1237 if (sy->data!=NULL)
1238 {
1239 sy->rtyp=IDHDL;
1240 currid=sy->name=IDID((idhdl)sy->data);
1241 if (is_qring)
1242 {
1243 IDFLAG((idhdl)sy->data)=sy->flag=Sy_bit(FLAG_QRING_DEF);
1244 }
1245 // name->name=NULL; /* used in enterid */
1246 //sy->e = NULL;
1247 if (name->next!=NULL)
1248 {
1249 sy->next=(leftv)omAllocBin(sleftv_bin);
1250 res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1251 }
1252 }
1253 else res=TRUE;
1254 }
1255 name->CleanUp();
1256 return res;
1257}
char * filename
Definition fevoices.h:63
VAR int yylineno
Definition febase.cc:40
VAR char my_yylinebuf[80]
Definition febase.cc:44
const char * currid
Definition grammar.cc:171
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:281
VAR idhdl currRingHdl
Definition ipid.cc:59
#define IDFLAG(a)
Definition ipid.h:120
#define FLAG_QRING_DEF
Definition ipid.h:109
#define IDLEV(a)
Definition ipid.h:121
#define TEST_V_ALLWARN
Definition options.h:142
#define Sy_bit(x)
Definition options.h:31
@ QRING_CMD
Definition tok.h:160

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1259 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1510 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1533 of file ipshell.cc.

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

1606{
1607 int i;
1608 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1609 poly po=NULL;
1611 {
1612 scComputeHC(I,currRing->qideal,ak,po);
1613 if (po!=NULL)
1614 {
1615 pGetCoeff(po)=nInit(1);
1616 for (i=rVar(currRing); i>0; i--)
1617 {
1618 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1619 }
1620 pSetComp(po,ak);
1621 pSetm(po);
1622 }
1623 }
1624 else
1625 po=pOne();
1626 return po;
1627}
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 1411 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1464 of file ipshell.cc.

1465{
1466 idhdl h=(idhdl)v->data;
1467 if(h==NULL)
1468 {
1469 Warn("'%s': no such identifier\n", v->name);
1470 return FALSE;
1471 }
1472 package frompack=v->req_packhdl;
1474 if ((RingDependend(IDTYP(h)))
1475 || ((IDTYP(h)==LIST_CMD)
1476 && (lRingDependend(IDLIST(h)))
1477 )
1478 )
1479 {
1480 //Print("// ==> Ringdependent set nesting to 0\n");
1481 return (iiInternalExport(v, toLev));
1482 }
1483 else
1484 {
1485 IDLEV(h)=toLev;
1486 v->req_packhdl=rootpack;
1487 if (h==frompack->idroot)
1488 {
1489 frompack->idroot=h->next;
1490 }
1491 else
1492 {
1493 idhdl hh=frompack->idroot;
1494 while ((hh!=NULL) && (hh->next!=h))
1495 hh=hh->next;
1496 if ((hh!=NULL) && (hh->next==h))
1497 hh->next=h->next;
1498 else
1499 {
1500 Werror("`%s` not found",v->Name());
1501 return TRUE;
1502 }
1503 }
1504 h->next=rootpack->idroot;
1505 rootpack->idroot=h;
1506 }
1507 return FALSE;
1508}
#define IDLIST(a)
Definition ipid.h:137
BOOLEAN lRingDependend(lists L)
Definition lists.cc:222

◆ iiMakeResolv()

void iiMakeResolv ( resolvente  r,
int  length,
int  rlen,
char name,
int  typ0,
intvec **  weights 
)

Definition at line 845 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1375 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1036 of file ipshell.cc.

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

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

6626{
6627 if ((source->next==NULL)&&(source->e==NULL))
6628 {
6629 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6630 {
6631 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6632 source->Init();
6633 return;
6634 }
6635 if (source->rtyp==IDHDL)
6636 {
6637 if ((IDLEV((idhdl)source->data)==myynest)
6638 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6639 {
6645 IDATTR((idhdl)source->data)=NULL;
6646 IDDATA((idhdl)source->data)=NULL;
6647 source->name=NULL;
6648 source->attribute=NULL;
6649 return;
6650 }
6651 }
6652 }
6654}
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 6447 of file ipshell.cc.

6448{
6449 // assume a: level
6450 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6451 {
6452 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6453 char assume_yylinebuf[80];
6455 int lev=(long)a->Data();
6456 int startlev=0;
6457 idhdl h=ggetid("assumeLevel");
6458 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6459 if(lev <=startlev)
6460 {
6461 BOOLEAN bo=b->Eval();
6462 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6463 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6464 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6465 }
6466 }
6467 b->CleanUp();
6468 a->CleanUp();
6469 return FALSE;
6470}
#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:296
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition ipconv.cc:457
@ LINK_CMD
Definition tok.h:117

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 966 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1000 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 979 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3343 of file ipshell.cc.

3344{
3346 return (res->data==NULL);
3347}
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 6282 of file ipshell.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 945 of file ipshell.cc.

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

◆ jjPROC()

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

Definition at line 1614 of file iparith.cc.

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

◆ jjRESULTANT()

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

Definition at line 3336 of file ipshell.cc.

3337{
3338 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3339 (poly)w->CopyD(), currRing);
3340 return errorreported;
3341}
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 6312 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6304 of file ipshell.cc.

6305{
6306 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6307 int n=pGetVariables((poly)u->Data(),e);
6308 jjINT_S_TO_ID(n,e,res);
6309 return FALSE;
6310}

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

3320{
3321 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3322 if (res->data==NULL)
3323 res->data=(char *)new intvec(rVar(currRing));
3324 return FALSE;
3325}
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3297 of file ipshell.cc.

3298{
3299 ideal F=(ideal)id->Data();
3300 intvec * iv = new intvec(rVar(currRing));
3301 polyset s;
3302 int sl, n, i;
3303 int *x;
3304
3305 res->data=(char *)iv;
3306 s = F->m;
3307 sl = IDELEMS(F) - 1;
3308 n = rVar(currRing);
3309 double wNsqr = (double)2.0 / (double)n;
3311 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3312 wCall(s, sl, x, wNsqr, currRing);
3313 for (i = n; i!=0; i--)
3314 (*iv)[i-1] = x[i + n + 1];
3315 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3316 return FALSE;
3317}
Variable x
Definition cfModGcd.cc:4090
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight0.cc:78

◆ list1()

static void list1 ( const char s,
idhdl  h,
BOOLEAN  c,
BOOLEAN  fullname 
)
static

Definition at line 149 of file ipshell.cc.

150{
151 char buffer[22];
152 int l;
153 char buf2[128];
154
155 if(fullname) snprintf(buf2,128, "%s::%s", "", IDID(h));
156 else snprintf(buf2,128, "%s", IDID(h));
157
158 Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
159 if (h == currRingHdl) PrintS("*");
160 PrintS(Tok2Cmdname((int)IDTYP(h)));
161
162 ipListFlag(h);
163 switch(IDTYP(h))
164 {
165 case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
166 case INT_CMD: Print(" %d",IDINT(h)); break;
167 case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
168 case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
169 break;
170 case POLY_CMD:
171 case VECTOR_CMD:if (c)
172 {
173 PrintS(" ");wrp(IDPOLY(h));
174 if(IDPOLY(h) != NULL)
175 {
176 Print(", %d monomial(s)",pLength(IDPOLY(h)));
177 }
178 }
179 break;
180 case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));// and continue
181 case IDEAL_CMD: Print(", %u generator(s)",
182 IDELEMS(IDIDEAL(h))); break;
183 case MAP_CMD:
184 Print(" from %s",IDMAP(h)->preimage); break;
185 case MATRIX_CMD:Print(" %u x %u"
188 );
189 break;
190 case SMATRIX_CMD:Print(" %u x %u"
191 ,(int)(IDIDEAL(h)->rank)
192 ,IDELEMS(IDIDEAL(h))
193 );
194 break;
195 case PACKAGE_CMD:
197 break;
198 case PROC_CMD: if((IDPROC(h)->libname!=NULL)
199 && (strlen(IDPROC(h)->libname)>0))
200 Print(" from %s",IDPROC(h)->libname);
201 if(IDPROC(h)->language==LANG_C)
202 PrintS(" (C)");
203 if(IDPROC(h)->is_static)
204 PrintS(" (static)");
205 break;
206 case STRING_CMD:
207 {
208 char *s;
209 l=strlen(IDSTRING(h));
210 memset(buffer,0,sizeof(buffer));
211 strncpy(buffer,IDSTRING(h),si_min(l,20));
212 if ((s=strchr(buffer,'\n'))!=NULL)
213 {
214 *s='\0';
215 }
216 PrintS(" ");
217 PrintS(buffer);
218 if((s!=NULL) ||(l>20))
219 {
220 Print("..., %d char(s)",l);
221 }
222 break;
223 }
224 case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
225 break;
226 case RING_CMD:
227 if ((IDRING(h)==currRing) && (currRingHdl!=h))
228 PrintS("(*)"); /* this is an alias to currRing */
229 //Print(" ref:%d",IDRING(h)->ref);
230#ifdef RDEBUG
232 Print(" <%lx>",(long)(IDRING(h)));
233#endif
234 break;
235#ifdef SINGULAR_4_2
236 case CNUMBER_CMD:
237 { number2 n=(number2)IDDATA(h);
238 Print(" (%s)",nCoeffName(n->cf));
239 break;
240 }
241 case CMATRIX_CMD:
243 Print(" %d x %d (%s)",
244 b->rows(),b->cols(),
245 nCoeffName(b->basecoeffs()));
246 break;
247 }
248#endif
249 /*default: break;*/
250 }
251 PrintLn();
252}
static int si_min(const int a, const int b)
Definition auxiliary.h:125
Matrices of numbers.
Definition bigintmat.h:51
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition coeffs.h:956
CanonicalForm buf2
Definition facFqBivar.cc:76
@ SMATRIX_CMD
Definition grammar.cc:292
void ipListFlag(idhdl h)
Definition ipid.cc: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:6327
#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 3464 of file ipshell.cc.

3465{
3466 switch( state )
3467 {
3468 case semicListTooShort:
3469 WerrorS( "the list is too short" );
3470 break;
3471 case semicListTooLong:
3472 WerrorS( "the list is too long" );
3473 break;
3474
3476 WerrorS( "first element of the list should be int" );
3477 break;
3479 WerrorS( "second element of the list should be int" );
3480 break;
3482 WerrorS( "third element of the list should be int" );
3483 break;
3485 WerrorS( "fourth element of the list should be intvec" );
3486 break;
3488 WerrorS( "fifth element of the list should be intvec" );
3489 break;
3491 WerrorS( "sixth element of the list should be intvec" );
3492 break;
3493
3494 case semicListNNegative:
3495 WerrorS( "first element of the list should be positive" );
3496 break;
3498 WerrorS( "wrong number of numerators" );
3499 break;
3501 WerrorS( "wrong number of denominators" );
3502 break;
3504 WerrorS( "wrong number of multiplicities" );
3505 break;
3506
3508 WerrorS( "the Milnor number should be positive" );
3509 break;
3511 WerrorS( "the geometrical genus should be nonnegative" );
3512 break;
3514 WerrorS( "all numerators should be positive" );
3515 break;
3517 WerrorS( "all denominators should be positive" );
3518 break;
3520 WerrorS( "all multiplicities should be positive" );
3521 break;
3522
3524 WerrorS( "it is not symmetric" );
3525 break;
3527 WerrorS( "it is not monotonous" );
3528 break;
3529
3531 WerrorS( "the Milnor number is wrong" );
3532 break;
3533 case semicListPGWrong:
3534 WerrorS( "the geometrical genus is wrong" );
3535 break;
3536
3537 default:
3538 WerrorS( "unspecific error" );
3539 break;
3540 }
3541}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4249 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5075 of file ipshell.cc.

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

4560{
4561 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4562 return FALSE;
4563}
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 4565 of file ipshell.cc.

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

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

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

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

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

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

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

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

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

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

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

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

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2302 of file ipshell.cc.

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

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2152 of file ipshell.cc.

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

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

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2113 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1852 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1818 of file ipshell.cc.

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

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1914 of file ipshell.cc.

1916{
1918 if (rField_is_Z(R)) L->Init(1);
1919 else L->Init(2);
1920 h->rtyp=LIST_CMD;
1921 h->data=(void *)L;
1922 // 0: char/ cf - ring
1923 // 1: list (module)
1924 // ----------------------------------------
1925 // 0: char/ cf - ring
1926 L->m[0].rtyp=STRING_CMD;
1927 L->m[0].data=(void *)omStrDup("integer");
1928 // ----------------------------------------
1929 // 1: module
1930 if (rField_is_Z(R)) return;
1932 LL->Init(2);
1933 LL->m[0].rtyp=BIGINT_CMD;
1934 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1935 LL->m[1].rtyp=INT_CMD;
1936 LL->m[1].data=(void *) R->cf->modExponent;
1937 L->m[1].rtyp=LIST_CMD;
1938 L->m[1].data=(void *)LL;
1939}
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 1887 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char s)

Definition at line 1643 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1700 of file ipshell.cc.

1701{
1702 if ((r==NULL)||(r->VarOffset==NULL))
1703 return NULL;
1705 if (h!=NULL) return h;
1706 if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1707 if (h!=NULL) return h;
1709 while(p!=NULL)
1710 {
1711 if ((p->cPack!=basePack)
1712 && (p->cPack!=currPack))
1713 h=rSimpleFindHdl(r,p->cPack->idroot,n);
1714 if (h!=NULL) return h;
1715 p=p->next;
1716 }
1717 idhdl tmp=basePack->idroot;
1718 while (tmp!=NULL)
1719 {
1720 if (IDTYP(tmp)==PACKAGE_CMD)
1721 h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1722 if (h!=NULL) return h;
1723 tmp=IDNEXT(tmp);
1724 }
1725 return NULL;
1726}
VAR proclevel * procstack
Definition ipid.cc:52
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition ipshell.cc:6263

◆ rInit()

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

Definition at line 5621 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6220 of file ipshell.cc.

6221{
6222 ring r = IDRING(h);
6223 int ref=0;
6224 if (r!=NULL)
6225 {
6226 // avoid, that sLastPrinted is the last reference to the base ring:
6227 // clean up before killing the last "named" refrence:
6229 && (sLastPrinted.data==(void*)r))
6230 {
6232 }
6233 ref=r->ref;
6234 if ((ref<=0)&&(r==currRing))
6235 {
6236 // cleanup DENOMINATOR_LIST
6238 {
6240 if (TEST_V_ALLWARN)
6241 Warn("deleting denom_list for ring change from %s",IDID(h));
6242 do
6243 {
6244 n_Delete(&(dd->n),currRing->cf);
6245 dd=dd->next;
6248 } while(DENOMINATOR_LIST!=NULL);
6249 }
6250 }
6251 rKill(r);
6252 }
6253 if (h==currRingHdl)
6254 {
6255 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6256 else
6257 {
6259 }
6260 }
6261}
void rKill(ring r)
Definition ipshell.cc:6174
VAR denominator_list DENOMINATOR_LIST
Definition kutil.cc:84

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6174 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5182 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2394 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5122 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6263 of file ipshell.cc.

6264{
6265 idhdl h=root;
6266 while (h!=NULL)
6267 {
6268 if ((IDTYP(h)==RING_CMD)
6269 && (h!=n)
6270 && (IDRING(h)==r)
6271 )
6272 {
6273 return h;
6274 }
6275 h=IDNEXT(h);
6276 }
6277 return NULL;
6278}

◆ rSleftvList2StringArray()

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

Definition at line 5573 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5301 of file ipshell.cc.

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

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

◆ scIndIndset()

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

Definition at line 1102 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4547 of file ipshell.cc.

4548{
4549 sleftv tmp;
4550 tmp.Init();
4551 tmp.rtyp=INT_CMD;
4552 /* tmp.data = (void *)0; -- done by Init */
4553
4554 return semicProc3(res,u,v,&tmp);
4555}
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition ipshell.cc:4507

◆ semicProc3()

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

Definition at line 4507 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4424 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3806 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4180 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3380 of file ipshell.cc.

3381{
3383 copy_deep( result, l );
3384 return result;
3385}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3356

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4098 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4129 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3565 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4466 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3166 of file ipshell.cc.

3167{
3168 sleftv tmp;
3169 tmp.Init();
3170 tmp.rtyp=INT_CMD;
3171 tmp.data=(void *)1;
3172 return syBetti2(res,u,&tmp);
3173}
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition ipshell.cc:3143

◆ syBetti2()

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

Definition at line 3143 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3178 of file ipshell.cc.

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

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5609 of file ipshell.cc.