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

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
static idhdl rSimpleFindHdl (const ring r, const idhdl root, const idhdl n)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rDecomposeCF (leftv h, const ring r, const ring R)
 
static void rDecomposeC_41 (leftv h, const coeffs C)
 
static void rDecomposeC (leftv h, const ring R)
 
static void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
static void rDecompose_23456 (const ring r, lists L)
 
lists rDecompose_list_cf (const ring r)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
static BOOLEAN rComposeVar (const lists L, ring R)
 
static BOOLEAN rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
 
ring rCompose (const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
 
syStrategy syConvList (lists li)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void copy_deep (spectrum &spec, lists l)
 
spectrum spectrumFromList (lists l)
 
lists getList (spectrum &spec)
 
void list_error (semicState state)
 
spectrumState spectrumStateFromList (spectrumPolyList &speclist, lists *L, int fast)
 
spectrumState spectrumCompute (poly h, lists *L, int fast)
 
void spectrumPrintError (spectrumState state)
 
BOOLEAN spectrumProc (leftv result, leftv first)
 
BOOLEAN spectrumfProc (leftv result, leftv first)
 
semicState list_is_spectrum (lists l)
 
BOOLEAN spaddProc (leftv result, leftv first, leftv second)
 
BOOLEAN spmulProc (leftv result, leftv first, leftv second)
 
BOOLEAN semicProc3 (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN semicProc (leftv res, leftv u, leftv v)
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm.
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).
 
lists listOfRoots (rootArranger *self, const unsigned int oprec)
 
void rSetHdl (idhdl h)
 
static leftv rOptimizeOrdAsSleftv (leftv ord)
 
BOOLEAN rSleftvOrdering2Ordering (sleftv *ord, ring R)
 
static BOOLEAN rSleftvList2StringArray (leftv sl, char **p)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
ring rSubring (ring org_ring, sleftv *rv)
 
void rKill (ring r)
 
void rKill (idhdl h)
 
BOOLEAN jjPROC (leftv res, leftv u, leftv v)
 
static void jjINT_S_TO_ID (int n, int *e, leftv res)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiApplyINTVEC (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApplyBIGINTMAT (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyIDEAL (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyLIST (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiARROW (leftv r, char *a, char *s)
 
BOOLEAN iiAssignCR (leftv r, leftv arg)
 
static void iiReportTypes (int nr, int t, const short *T)
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise
 
void iiSetReturn (const leftv source)
 

Variables

VAR leftv iiCurrArgs =NULL
 
VAR idhdl iiCurrProc =NULL
 
const char * lastreserved =NULL
 
STATIC_VAR BOOLEAN iiNoKeepRing =TRUE
 
VAR BOOLEAN iiDebugMarker =TRUE
 
const short MAX_SHORT = 32767
 

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 1063 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3429 of file ipshell.cc.

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3545 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum & spec,
lists l )

Definition at line 3355 of file ipshell.cc.

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

◆ exprlist_length()

int exprlist_length ( leftv v)

Definition at line 550 of file ipshell.cc.

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

◆ getList()

lists getList ( spectrum & spec)

Definition at line 3391 of file ipshell.cc.

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

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

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6374 of file ipshell.cc.

6375{
6376 WerrorS("not implemented");
6377 return TRUE;
6378}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6379 of file ipshell.cc.

6380{
6381 WerrorS("not implemented");
6382 return TRUE;
6383}

◆ iiApplyINTVEC()

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

Definition at line 6342 of file ipshell.cc.

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

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

◆ iiARROW()

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

Definition at line 6472 of file ipshell.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv r,
leftv arg )

Definition at line 6507 of file ipshell.cc.

6508{
6509 char* ring_name=omStrDup((char*)r->Name());
6510 int t=arg->Typ();
6511 if (t==RING_CMD)
6512 {
6513 sleftv tmp;
6514 tmp.Init();
6515 tmp.rtyp=IDHDL;
6516 idhdl h=rDefault(ring_name);
6517 tmp.data=(char*)h;
6518 if (h!=NULL)
6519 {
6520 tmp.name=h->id;
6521 BOOLEAN b=iiAssign(&tmp,arg);
6522 if (b) return TRUE;
6523 rSetHdl(ggetid(ring_name));
6524 omFree(ring_name);
6525 return FALSE;
6526 }
6527 else
6528 return TRUE;
6529 }
6530 else if (t==CRING_CMD)
6531 {
6532 sleftv tmp;
6533 sleftv n;
6534 n.Init();
6535 n.name=ring_name;
6536 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6537 if (iiAssign(&tmp,arg)) return TRUE;
6538 //Print("create %s\n",r->Name());
6539 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6540 return FALSE;
6541 }
6542 //Print("create %s\n",r->Name());
6543 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6544 return TRUE;// not handled -> error for now
6545}
CanonicalForm b
Definition cfModGcd.cc:4111
Definition idrec.h:35
const char * name
Definition subexpr.h:87
const char * Name()
Definition subexpr.h:120
VAR int myynest
Definition febase.cc:41
@ RING_CMD
Definition grammar.cc:282
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition ipassign.cc:2097
idhdl ggetid(const char *n)
Definition ipid.cc:560
#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:5121
STATIC_VAR Poly * h
Definition janet.cc:971
#define omStrDup(s)
#define IDHDL
Definition tok.h:31
@ CRING_CMD
Definition tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv r,
leftv args )

Definition at line 1272 of file ipshell.cc.

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

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

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente r,
int l )
static

Definition at line 935 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1064 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1197 of file ipshell.cc.

1198{
1200 BOOLEAN is_qring=FALSE;
1201 const char *id = name->name;
1202
1203 sy->Init();
1204 if ((name->name==NULL)||(isdigit(name->name[0])))
1205 {
1206 WerrorS("object to declare is not a name");
1207 res=TRUE;
1208 }
1209 else
1210 {
1211 if (root==NULL) return TRUE;
1212 if (*root!=IDROOT)
1213 {
1214 if ((currRing==NULL) || (*root!=currRing->idroot))
1215 {
1216 Werror("can not define `%s` in other package",name->name);
1217 return TRUE;
1218 }
1219 }
1220 if (t==QRING_CMD)
1221 {
1222 t=RING_CMD; // qring is always RING_CMD
1223 is_qring=TRUE;
1224 }
1225
1226 if (TEST_V_ALLWARN
1227 && (name->rtyp!=0)
1228 && (name->rtyp!=IDHDL)
1230 {
1231 Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1233 }
1234 {
1235 sy->data = (char *)enterid(id,lev,t,root,init_b);
1236 }
1237 if (sy->data!=NULL)
1238 {
1239 sy->rtyp=IDHDL;
1240 currid=sy->name=IDID((idhdl)sy->data);
1241 if (is_qring)
1242 {
1244 }
1245 // name->name=NULL; /* used in enterid */
1246 //sy->e = NULL;
1247 if (name->next!=NULL)
1248 {
1250 res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1251 }
1252 }
1253 else res=TRUE;
1254 }
1255 name->CleanUp();
1256 return res;
1257}
char * filename
Definition fevoices.h:63
BITSET flag
Definition subexpr.h:90
VAR int yylineno
Definition febase.cc:40
VAR char my_yylinebuf[80]
Definition febase.cc:44
const char * currid
Definition grammar.cc:171
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition ipid.cc:258
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
void * CopyA()
Definition subexpr.cc:2192
int atyp
Definition attrib.h:27

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv v,
int toLev )

Definition at line 1510 of file ipshell.cc.

1511{
1512 BOOLEAN nok=FALSE;
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 {
1523 if(iiInternalExport(v, toLev))
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);}
1537 BOOLEAN nok=FALSE;
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}
idhdl get(const char *s, int lev)
Definition ipid.cc:65
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition ipid.cc:424
#define BVERBOSE(a)
Definition options.h:35
#define V_REDEFINE
Definition options.h:45

◆ iiHighCorner()

poly iiHighCorner ( ideal I,
int ak )

Definition at line 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 }
1428 BOOLEAN keepring=FALSE;
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;
1473 if (frompack==NULL) frompack=currPack;
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));
880 omFreeSize((ADDRESS)s,strlen(name)+5);
881}
attr attribute
Definition subexpr.h:89
#define idDelete(H)
delete an ideal
Definition ideals.h:29
static BOOLEAN length(leftv result, leftv arg)
Definition interval.cc:257
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition lists.cc:239
#define omFreeSize(addr, size)
#define V_DEF_RES
Definition options.h:50

◆ iiMap()

leftv iiMap ( map theMap,
const char * what )

Definition at line 613 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char * s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv p)

Definition at line 1375 of file ipshell.cc.

1376{
1377 if (iiCurrArgs==NULL)
1378 {
1379 if (strcmp(p->name,"#")==0)
1380 return iiDefaultParameter(p);
1381 Werror("not enough arguments for proc %s",VoiceName());
1382 p->CleanUp();
1383 return TRUE;
1384 }
1386 leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1387 BOOLEAN is_default_list=FALSE;
1388 if (strcmp(p->name,"#")==0)
1389 {
1390 is_default_list=TRUE;
1391 rest=NULL;
1392 }
1393 else
1394 {
1395 h->next=NULL;
1396 }
1398 if (is_default_list)
1399 {
1401 }
1402 else
1403 {
1404 iiCurrArgs=rest;
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
int min_in()
Definition intvec.h:121
intvec * ivCopy(const intvec *o)
Definition intvec.h:145
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition lists.cc:338
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition syz.cc:783

◆ iiReportTypes()

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

Definition at line 6547 of file ipshell.cc.

6548{
6549 char buf[250];
6550 buf[0]='\0';
6551 if (nr==0)
6552 snprintf(buf,250,"wrong length of parameters(%d), expected ",t);
6553 else
6554 snprintf(buf,250,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6555 for(int i=1;i<=T[0];i++)
6556 {
6557 strcat(buf,"`");
6558 strcat(buf,Tok2Cmdname(T[i]));
6559 strcat(buf,"`");
6560 if (i<T[0]) strcat(buf,",");
6561 }
6562 WerrorS(buf);
6563}
STATIC_VAR jList * T
Definition janet.cc:30
int status int void * buf
Definition si_signals.h:69

◆ iiSetReturn()

void iiSetReturn ( const leftv source)

Definition at line 6623 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv a,
leftv b )

Definition at line 6445 of file ipshell.cc.

6446{
6447 // assume a: level
6448 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6449 {
6450 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6451 char assume_yylinebuf[80];
6452 strncpy(assume_yylinebuf,my_yylinebuf,79);
6453 int lev=(long)a->Data();
6454 int startlev=0;
6455 idhdl h=ggetid("assumeLevel");
6456 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6457 if(lev <=startlev)
6458 {
6459 BOOLEAN bo=b->Eval();
6460 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6461 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6462 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6463 }
6464 }
6465 b->CleanUp();
6466 a->CleanUp();
6467 return FALSE;
6468}
#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
int rows() const
Definition intvec.h:96
#define IMATELEM(M, I, J)
Definition intvec.h:85

◆ jjBETTI2_ID()

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

Definition at line 979 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv res,
leftv u )

Definition at line 3342 of file ipshell.cc.

3343{
3344 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3345 return (res->data==NULL);
3346}
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 6280 of file ipshell.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv res,
leftv v )

Definition at line 945 of file ipshell.cc.

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

◆ jjPROC()

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

Definition at line 1614 of file iparith.cc.

1615{
1616 void *d;
1617 Subexpr e;
1618 int typ;
1619 BOOLEAN t=FALSE;
1620 idhdl tmp_proc=NULL;
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}
utypes data
Definition idrec.h:40
short ref
Definition idrec.h:46
const char * id
Definition idrec.h:39
package req_packhdl
Definition subexpr.h:106
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition iplib.cc:512

◆ jjRESULTANT()

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

Definition at line 3335 of file ipshell.cc.

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

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv res,
leftv u )

Definition at line 6302 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int v)

Definition at line 386 of file ipshell.cc.

387{
388 BOOLEAN changed=FALSE;
390 ring cr=currRing;
391 if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392 //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393
394 killlocals_rec(&(basePack->idroot),v,currRing);
395
397 {
398 int t=iiRETURNEXPR.Typ();
399 if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
400 {
402 if (((ring)h->data)->idroot!=NULL)
403 killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404 }
405 else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406 {
408 changed |=killlocals_list(v,(lists)h->data);
409 }
410 }
411 if (changed)
412 {
414 if (currRingHdl==NULL)
416 else if(cr!=currRing)
417 rChangeCurrRing(cr);
418 }
419
420 if (myynest<=1) iiNoKeepRing=TRUE;
421 //Print("end killlocals >= %d\n",v);
422 //listall();
423}
VAR int iiRETURNEXPR_len
Definition iplib.cc:483
BOOLEAN killlocals_list(int v, lists L)
Definition ipshell.cc:366
idhdl rFindHdl(ring r, idhdl n)
Definition ipshell.cc:1699
void killlocals_rec(idhdl *root, int v, ring r)
Definition ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition ipshell.cc:295
void rChangeCurrRing(ring r)
Definition polys.cc:15

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

296{
297 idhdl h = *localhdl;
298 while (h!=NULL)
299 {
300 int vv;
301 //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
302 if ((vv=IDLEV(h))>0)
303 {
304 if (vv < v)
305 {
306 if (iiNoKeepRing)
307 {
308 //PrintS(" break\n");
309 return;
310 }
311 h = IDNEXT(h);
312 //PrintLn();
313 }
314 else //if (vv >= v)
315 {
316 idhdl nexth = IDNEXT(h);
317 killhdl2(h,localhdl,r);
318 h = nexth;
319 //PrintS("kill\n");
320 }
321 }
322 else
323 {
324 h = IDNEXT(h);
325 //PrintLn();
326 }
327 }
328}
#define IDNEXT(a)
Definition ipid.h:118

◆ killlocals_list()

BOOLEAN killlocals_list ( int v,
lists L )

Definition at line 366 of file ipshell.cc.

367{
368 if (L==NULL) return FALSE;
369 BOOLEAN changed=FALSE;
370 int n=L->nr;
371 for(;n>=0;n--)
372 {
373 leftv h=&(L->m[n]);
374 void *d=h->data;
375 if ((h->rtyp==RING_CMD)
376 && (((ring)d)->idroot!=NULL))
377 {
378 if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
379 killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
380 }
381 else if (h->rtyp==LIST_CMD)
382 changed|=killlocals_list(v,(lists)d);
383 }
384 return changed;
385}

◆ killlocals_rec()

void killlocals_rec ( idhdl * root,
int v,
ring r )

Definition at line 330 of file ipshell.cc.

331{
332 idhdl h=*root;
333 while (h!=NULL)
334 {
335 if (IDLEV(h)>=v)
336 {
337// Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
338 idhdl n=IDNEXT(h);
339 killhdl2(h,root,r);
340 h=n;
341 }
342 else if (IDTYP(h)==PACKAGE_CMD)
343 {
344 // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345 if (IDPACKAGE(h)!=basePack)
346 killlocals_rec(&(IDRING(h)->idroot),v,r);
347 h=IDNEXT(h);
348 }
349 else if (IDTYP(h)==RING_CMD)
350 {
351 if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
352 // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
353 {
354 // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
355 killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
356 }
357 h=IDNEXT(h);
358 }
359 else
360 {
361// Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
362 h=IDNEXT(h);
363 }
364 }
365}

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv res,
leftv v )

Definition at line 3318 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv res,
leftv id )

Definition at line 3296 of file ipshell.cc.

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

◆ list1()

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

Definition at line 149 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

426{
427 package savePack=currPack;
428 idhdl h,start;
429 BOOLEAN all = typ<0;
430 BOOLEAN really_all=FALSE;
431
432 if ( typ==0 )
433 {
434 if (strcmp(what,"all")==0)
435 {
436 if (currPack!=basePack)
437 list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
438 really_all=TRUE;
439 h=basePack->idroot;
440 }
441 else
442 {
443 h = ggetid(what);
444 if (h!=NULL)
445 {
446 if (iterate) list1(prefix,h,TRUE,fullname);
447 if (IDTYP(h)==ALIAS_CMD) PrintS("A");
448 if (IDTYP(h)==RING_CMD)
449 {
450 h=IDRING(h)->idroot;
451 }
452 else if(IDTYP(h)==PACKAGE_CMD)
453 {
455 //Print("list_cmd:package\n");
456 all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
457 h=IDPACKAGE(h)->idroot;
458 }
459 else
460 {
461 currPack=savePack;
462 return;
463 }
464 }
465 else
466 {
467 Werror("%s is undefined",what);
468 currPack=savePack;
469 return;
470 }
471 }
472 all=TRUE;
473 }
474 else if (RingDependend(typ))
475 {
476 h = currRing->idroot;
477 }
478 else
479 h = IDROOT;
480 start=h;
481 while (h!=NULL)
482 {
483 if ((all
484 && (IDTYP(h)!=PROC_CMD)
485 &&(IDTYP(h)!=PACKAGE_CMD)
486 &&(IDTYP(h)!=CRING_CMD)
487 )
488 || (typ == IDTYP(h))
489 || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
490 )
491 {
492 list1(prefix,h,start==currRingHdl, fullname);
493 if ((IDTYP(h)==RING_CMD)
494 && (really_all || (all && (h==currRingHdl)))
495 && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
496 {
497 list_cmd(0,IDID(h),"// ",FALSE);
498 }
499 if (IDTYP(h)==PACKAGE_CMD && really_all)
500 {
501 package save_p=currPack;
503 list_cmd(0,IDID(h),"// ",FALSE);
504 currPack=save_p;
505 }
506 }
507 h = IDNEXT(h);
508 }
509 currPack=savePack;
510}
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition ipshell.cc:425
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition ipshell.cc:149

◆ list_error()

void list_error ( semicState state)

Definition at line 3463 of file ipshell.cc.

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists l)

Definition at line 4248 of file ipshell.cc.

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

◆ listOfRoots()

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

Definition at line 5074 of file ipshell.cc.

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

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

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

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

3087{
3088 int n=(int)(long)b->Data();
3089 int d=(int)(long)c->Data();
3090 int k,l,sign,row,col;
3091 matrix result;
3092 ideal temp;
3093 BOOLEAN bo;
3094 poly p;
3095
3096 if ((d>n) || (d<1) || (n<1))
3097 {
3098 res->data=(char *)mpNew(1,1);
3099 return FALSE;
3100 }
3101 int *choise = (int*)omAlloc(d*sizeof(int));
3102 if (id==NULL)
3103 temp=idMaxIdeal(1);
3104 else
3105 temp=(ideal)id->Data();
3106
3107 k = binom(n,d);
3108 l = k*d;
3109 l /= n-d+1;
3110 result =mpNew(l,k);
3111 col = 1;
3112 idInitChoise(d,1,n,&bo,choise);
3113 while (!bo)
3114 {
3115 sign = 1;
3116 for (l=1;l<=d;l++)
3117 {
3118 if (choise[l-1]<=IDELEMS(temp))
3119 {
3120 p = pCopy(temp->m[choise[l-1]-1]);
3121 if (sign == -1) p = pNeg(p);
3122 sign *= -1;
3123 row = idGetNumberOfChoise(l-1,d,1,n,choise);
3124 MATELEM(result,row,col) = p;
3125 }
3126 }
3127 col++;
3128 idGetNextChoise(d,n,&bo,choise);
3129 }
3130 omFreeSize(choise,d*sizeof(int));
3131 if (id==NULL) idDelete(&temp);
3132
3133 res->data=(char *)result;
3134 return FALSE;
3135}
int k
Definition cfEzgcd.cc:99
int binom(int n, int r)
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition ideals.h:33
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
#define pNeg(p)
Definition polys.h:198
#define pCopy(p)
return a copy of the poly
Definition polys.h:185
static int sign(int x)
Definition ring.cc:3442

◆ nuLagSolve()

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

find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.

Good for polynomials with low and middle degree (<40). Arguments 3: poly arg1 , int arg2 , int arg3 arg2>0: defines precision of fractional part if ground field is Q arg3: number of iterations for approximation of roots (default=2) Returns a list of all (complex) roots of the polynomial arg1

Definition at line 4673 of file ipshell.cc.

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

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

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

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

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

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

◆ rComposeC()

void rComposeC ( lists L,
ring R )

Definition at line 2250 of file ipshell.cc.

2252{
2253 // ----------------------------------------
2254 // 0: char/ cf - ring
2255 if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2256 {
2257 WerrorS("invalid coeff. field description, expecting 0");
2258 return;
2259 }
2260// R->cf->ch=0;
2261 // ----------------------------------------
2262 // 0, (r1,r2) [, "i" ]
2263 if (L->m[1].rtyp!=LIST_CMD)
2264 {
2265 WerrorS("invalid coeff. field description, expecting precision list");
2266 return;
2267 }
2268 lists LL=(lists)L->m[1].data;
2269 if ((LL->nr!=1)
2270 || (LL->m[0].rtyp!=INT_CMD)
2271 || (LL->m[1].rtyp!=INT_CMD))
2272 {
2273 WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2274 return;
2275 }
2276 int r1=(int)(long)LL->m[0].data;
2277 int r2=(int)(long)LL->m[1].data;
2278 r1=si_min(r1,32767);
2279 r2=si_min(r2,32767);
2280 LongComplexInfo par; memset(&par, 0, sizeof(par));
2281 par.float_len=r1;
2282 par.float_len2=r2;
2283 if (L->nr==2) // complex
2284 {
2285 if (L->m[2].rtyp!=STRING_CMD)
2286 {
2287 WerrorS("invalid coeff. field description, expecting parameter name");
2288 return;
2289 }
2290 par.par_name=(char*)L->m[2].data;
2291 R->cf = nInitChar(n_long_C, &par);
2292 }
2293 else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2294 R->cf = nInitChar(n_R, NULL);
2295 else /* && L->nr==1*/
2296 {
2297 R->cf = nInitChar(n_long_R, &par);
2298 }
2299}
@ n_R
single prescision (6,6) real numbers
Definition coeffs.h:31
@ n_long_R
real floating point (GMP) numbers
Definition coeffs.h:33
@ n_long_C
complex floating point (GMP) numbers
Definition coeffs.h:41
short float_len2
additional char-flags, rInit
Definition coeffs.h:109
const char * par_name
parameter name
Definition coeffs.h:110
short float_len
additional char-flags, rInit
Definition coeffs.h:108
#define SHORT_REAL_LENGTH
Definition numbers.h:57

◆ rComposeOrder()

static BOOLEAN rComposeOrder ( const lists L,
const BOOLEAN check_comp,
ring R )
inlinestatic

Definition at line 2480 of file ipshell.cc.

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

◆ rComposeRing()

void rComposeRing ( lists L,
ring R )

Definition at line 2301 of file ipshell.cc.

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

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

◆ rDecompose()

lists rDecompose ( const ring r)

Definition at line 2151 of file ipshell.cc.

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

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

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring r)

Definition at line 2112 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1851 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1817 of file ipshell.cc.

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

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv h,
const ring R )

Definition at line 1913 of file ipshell.cc.

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

1888{
1890 if (nCoeff_is_Ring(C)) L->Init(1);
1891 else L->Init(2);
1892 h->rtyp=LIST_CMD;
1893 h->data=(void *)L;
1894 // 0: char/ cf - ring
1895 // 1: list (module)
1896 // ----------------------------------------
1897 // 0: char/ cf - ring
1898 L->m[0].rtyp=STRING_CMD;
1899 L->m[0].data=(void *)omStrDup("integer");
1900 // ----------------------------------------
1901 // 1: modulo
1902 if (nCoeff_is_Z(C)) return;
1904 LL->Init(2);
1905 LL->m[0].rtyp=BIGINT_CMD;
1906 LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1907 LL->m[1].rtyp=INT_CMD;
1908 LL->m[1].data=(void *) C->modExponent;
1909 L->m[1].rtyp=LIST_CMD;
1910 L->m[1].data=(void *)LL;
1911}
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
1651 {
1653 }
1654
1655 ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1656
1657 #ifndef TEST_ZN_AS_ZP
1658 r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1659 #else
1660 mpz_t modBase;
1661 mpz_init_set_ui(modBase, (long)32003);
1662 ZnmInfo info;
1663 info.base= modBase;
1664 info.exp= 1;
1665 r->cf=nInitChar(n_Zn,(void*) &info);
1666 r->cf->is_field=1;
1667 r->cf->is_domain=1;
1668 r->cf->has_simple_Inverse=1;
1669 #endif
1670 r->N = 3;
1671 /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1672 /*names*/
1673 r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1674 r->names[0] = omStrDup("x");
1675 r->names[1] = omStrDup("y");
1676 r->names[2] = omStrDup("z");
1677 /*weights: entries for 3 blocks: NULL*/
1678 r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1679 /*order: dp,C,0*/
1680 r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1681 r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1682 r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1683 /* ringorder dp for the first block: var 1..3 */
1684 r->order[0] = ringorder_dp;
1685 r->block0[0] = 1;
1686 r->block1[0] = 3;
1687 /* ringorder C for the second block: no vars */
1688 r->order[1] = ringorder_C;
1689 /* the last block: everything is 0 */
1690 r->order[2] = (rRingOrder_t)0;
1691
1692 /* complete ring intializations */
1693 rComplete(r);
1694 rSetHdl(tmp);
1695 return currRingHdl;
1696}
BOOLEAN RingDependend()
Definition subexpr.cc:421

◆ rFindHdl()

idhdl rFindHdl ( ring r,
idhdl n )

Definition at line 1699 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5620 of file ipshell.cc.

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

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

◆ rKill() [2/2]

void rKill ( ring r)

Definition at line 6173 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv ord)
static

Definition at line 5181 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring R)
static

Definition at line 2393 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl h)

Definition at line 5121 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6261 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5572 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv * ord,
ring R )

Definition at line 5300 of file ipshell.cc.

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

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

◆ scIndIndset()

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

Definition at line 1102 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4546 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4506 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4423 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3805 of file ipshell.cc.

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

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists l)

Definition at line 3379 of file ipshell.cc.

3380{
3382 copy_deep( result, l );
3383 return result;
3384}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3355

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState state)

Definition at line 4097 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv result,
leftv first )

Definition at line 4128 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3564 of file ipshell.cc.

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

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv res,
leftv u )

Definition at line 3165 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3142 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3177 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int i)

Definition at line 512 of file ipshell.cc.

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

◆ type_cmd()

void type_cmd ( leftv v)

Definition at line 254 of file ipshell.cc.

255{
256 BOOLEAN oldShortOut = FALSE;
257
258 if (currRing != NULL)
259 {
260 oldShortOut = currRing->ShortOut;
261 currRing->ShortOut = 1;
262 }
263 int t=v->Typ();
264 Print("// %s %s ",v->Name(),Tok2Cmdname(t));
265 switch (t)
266 {
267 case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
268 case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
269 ((intvec*)(v->Data()))->cols()); break;
270 case MATRIX_CMD:Print(" %u x %u\n" ,
271 MATROWS((matrix)(v->Data())),
272 MATCOLS((matrix)(v->Data())));break;
273 case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
274 case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
275
276 case PROC_CMD:
277 case RING_CMD:
278 case IDEAL_CMD: PrintLn(); break;
279
280 //case INT_CMD:
281 //case STRING_CMD:
282 //case INTVEC_CMD:
283 //case POLY_CMD:
284 //case VECTOR_CMD:
285 //case PACKAGE_CMD:
286
287 default:
288 break;
289 }
290 v->Print();
291 if (currRing != NULL)
292 currRing->ShortOut = oldShortOut;
293}
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1062 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5608 of file ipshell.cc.