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 "Singular/feOpt.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)
 
int siSetCpus (int cpu)
 

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

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

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3546 of file ipshell.cc.

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

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum & spec,
lists l )

Definition at line 3356 of file ipshell.cc.

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

◆ exprlist_length()

int exprlist_length ( leftv v)

Definition at line 551 of file ipshell.cc.

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

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

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

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6375 of file ipshell.cc.

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

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv ,
leftv ,
int ,
leftv  )

Definition at line 6380 of file ipshell.cc.

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

◆ iiApplyINTVEC()

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

Definition at line 6343 of file ipshell.cc.

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

◆ iiApplyLIST()

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

Definition at line 6385 of file ipshell.cc.

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

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv r,
leftv arg )

Definition at line 6508 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv r,
leftv args )

Definition at line 1277 of file ipshell.cc.

1278{
1279 // must be inside a proc, as we simultae an proc_end at the end
1280 if (myynest==0)
1281 {
1282 WerrorS("branchTo can only occur in a proc");
1283 return TRUE;
1284 }
1285 // <string1...stringN>,<proc>
1286 // known: args!=NULL, l>=1
1287 int l=args->listLength();
1288 int ll=0;
1289 if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1290 if (ll!=(l-1)) return FALSE;
1291 leftv h=args;
1292 // set up the table for type test:
1293 short *t=(short*)omAlloc(l*sizeof(short));
1294 t[0]=l-1;
1295 int b;
1296 int i;
1297 for(i=1;i<l;i++,h=h->next)
1298 {
1299 if (h->Typ()!=STRING_CMD)
1300 {
1301 omFreeBinAddr(t);
1302 Werror("arg %d is not a string",i);
1303 return TRUE;
1304 }
1305 int tt;
1306 b=IsCmd((char *)h->Data(),tt);
1307 if(b) t[i]=tt;
1308 else
1309 {
1310 omFreeBinAddr(t);
1311 Werror("arg %d is not a type name",i);
1312 return TRUE;
1313 }
1314 }
1315 if (h->Typ()!=PROC_CMD)
1316 {
1317 omFreeBinAddr(t);
1318 Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1319 i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1320 return TRUE;
1321 }
1323 omFreeBinAddr(t);
1324 if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1325 {
1326 // get the proc:
1327 iiCurrProc=(idhdl)h->data;
1328 idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1329 procinfo * pi=IDPROC(currProc);
1330 // already loaded ?
1331 if( pi->data.s.body==NULL )
1332 {
1334 if (pi->data.s.body==NULL) return TRUE;
1335 }
1336 // set currPackHdl/currPack
1337 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1338 {
1339 currPack=pi->pack;
1342 //Print("set pack=%s\n",IDID(currPackHdl));
1343 }
1344 // see iiAllStart:
1345 BITSET save1=si_opt_1;
1346 BITSET save2=si_opt_2;
1347 newBuffer( omStrDup(pi->data.s.body), BT_proc,
1348 pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1349 BOOLEAN err=yyparse();
1351 si_opt_1=save1;
1352 si_opt_2=save2;
1353 // now save the return-expr.
1354 sLastPrinted.CleanUp(currRing);
1355 memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1356 iiRETURNEXPR.Init();
1357 // warning about args.:
1358 if (iiCurrArgs!=NULL)
1359 {
1360 if (err==0) Warn("too many arguments for %s",IDID(currProc));
1361 iiCurrArgs->CleanUp();
1364 }
1365 // similate proc_end:
1366 // - leave input
1367 void myychangebuffer();
1369 // - set the current buffer to its end (this is a pointer in a buffer,
1370 // not a file ptr) "branchTo" is only valid in proc)
1371 currentVoice->fptr=strlen(currentVoice->buffer);
1372 // - kill local vars
1374 // - return
1375 newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1376 return (err!=0);
1377 }
1378 return FALSE;
1379}
#define BITSET
Definition auxiliary.h:85
void * ADDRESS
Definition auxiliary.h:120
int listLength()
Definition subexpr.cc:51
#define Warn
Definition emacs.cc:77
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition fevoices.cc:166
VAR Voice * currentVoice
Definition fevoices.cc:49
@ BT_execute
Definition fevoices.h:23
@ BT_proc
Definition fevoices.h:20
const char * Tok2Cmdname(int tok)
Definition gentable.cc:137
int yyparse(void)
Definition grammar.cc:2149
int IsCmd(const char *n, int &tok)
Definition iparith.cc:9738
VAR package currPack
Definition ipid.cc:55
VAR idhdl currPackHdl
Definition ipid.cc:53
idhdl packFindHdl(package r)
Definition ipid.cc:808
#define IDPROC(a)
Definition ipid.h:140
#define IDID(a)
Definition ipid.h:122
INST_VAR sleftv iiRETURNEXPR
Definition iplib.cc:483
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition iplib.cc:197
VAR idhdl iiCurrProc
Definition ipshell.cc:82
void iiCheckPack(package &p)
Definition ipshell.cc:1625
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:6569
void killlocals(int v)
Definition ipshell.cc:387
VAR leftv iiCurrArgs
Definition ipshell.cc:81
#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
void myychangebuffer()
Definition scanner.cc:2311
INST_VAR sleftv sLastPrinted
Definition subexpr.cc:46
@ STRING_CMD
Definition tok.h:187

◆ iiCheckPack()

void iiCheckPack ( package & p)

Definition at line 1625 of file ipshell.cc.

1626{
1627 if (p!=basePack)
1628 {
1629 idhdl t=basePack->idroot;
1630 while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1631 if (t==NULL)
1632 {
1633 WarnS("package not found\n");
1634 p=basePack;
1635 }
1636 }
1637}
int p
Definition cfModGcd.cc:4086
idhdl next
Definition idrec.h:38
#define WarnS
Definition emacs.cc:78
VAR package basePack
Definition ipid.cc:56
#define IDPACKAGE(a)
Definition ipid.h:139
#define IDTYP(a)
Definition ipid.h:119
@ PACKAGE_CMD
Definition tok.h:150

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int i)

Definition at line 1581 of file ipshell.cc.

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

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

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente r,
int l )
static

Definition at line 940 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1069 of file ipshell.cc.

1070{
1071#ifdef HAVE_SDB
1072 sdb_flags=1;
1073#endif
1074 Print("\n-- break point in %s --\n",VoiceName());
1076 char * s;
1078 s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1079 loop
1080 {
1081 memset(s,0,BREAK_LINE_LENGTH+4);
1083 if (s[BREAK_LINE_LENGTH-1]!='\0')
1084 {
1085 Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1086 }
1087 else
1088 break;
1089 }
1090 if (*s=='\n')
1091 {
1093 }
1094#if MDEBUG
1095 else if(strncmp(s,"cont;",5)==0)
1096 {
1098 }
1099#endif /* MDEBUG */
1100 else
1101 {
1102 strcat( s, "\n;~\n");
1104 }
1105}
#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:1067
#define BREAK_LINE_LENGTH
Definition ipshell.cc:1068
VAR int sdb_flags
Definition sdb.cc:31
#define loop
Definition structs.h:71

◆ iiDeclCommand()

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

Definition at line 1202 of file ipshell.cc.

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv p)

Definition at line 1264 of file ipshell.cc.

1265{
1266 attr at=NULL;
1267 if (iiCurrProc!=NULL)
1268 at=iiCurrProc->attribute->get("default_arg");
1269 if (at==NULL)
1270 return FALSE;
1271 sleftv tmp;
1272 tmp.Init();
1273 tmp.rtyp=at->atyp;
1274 tmp.data=at->CopyA();
1275 return iiAssign(p,&tmp);
1276}
sattr * attr
Definition attrib.h:16
void * CopyA()
Definition subexpr.cc:2192
int atyp
Definition attrib.h:27

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv v,
int toLev )

Definition at line 1506 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1529 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal I,
int ak )

Definition at line 1601 of file ipshell.cc.

1602{
1603 int i;
1604 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1605 poly po=NULL;
1607 {
1608 scComputeHC(I,currRing->qideal,ak,po);
1609 if (po!=NULL)
1610 {
1611 pGetCoeff(po)=nInit(1);
1612 for (i=rVar(currRing); i>0; i--)
1613 {
1614 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1615 }
1616 pSetComp(po,ak);
1617 pSetm(po);
1618 }
1619 }
1620 else
1621 po=pOne();
1622 return po;
1623}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition hdegree.cc:1074
static BOOLEAN idIsZeroDim(ideal i)
Definition ideals.h:180
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition monomials.h:44
#define nInit(i)
Definition numbers.h:24
#define pSetm(p)
Definition polys.h:272
#define pSetComp(p, v)
Definition polys.h:39
#define pGetExp(p, i)
Exponent.
Definition polys.h:42
#define pOne()
Definition polys.h:316
#define pDecrExp(p, i)
Definition polys.h:45
static BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:769
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition ring.h:598

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv v,
int toLev )
static

Definition at line 1407 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1460 of file ipshell.cc.

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

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

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char * s)

Definition at line 122 of file ipshell.cc.

123{
124/* not handling: &&, ||, ** */
125 if (s[1]=='\0') return s[0];
126 else if (s[2]!='\0') return 0;
127 switch(s[0])
128 {
129 case '.': if (s[1]=='.') return DOTDOT;
130 else return 0;
131 case ':': if (s[1]==':') return COLONCOLON;
132 else return 0;
133 case '-': if (s[1]=='-') return MINUSMINUS;
134 else return 0;
135 case '+': if (s[1]=='+') return PLUSPLUS;
136 else return 0;
137 case '=': if (s[1]=='=') return EQUAL_EQUAL;
138 else return 0;
139 case '<': if (s[1]=='=') return LE;
140 else if (s[1]=='>') return NOTEQUAL;
141 else return 0;
142 case '>': if (s[1]=='=') return GE;
143 else return 0;
144 case '!': if (s[1]=='=') return NOTEQUAL;
145 else return 0;
146 }
147 return 0;
148}
@ 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 1380 of file ipshell.cc.

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

◆ iiRegularity()

int iiRegularity ( lists L)

Definition at line 1041 of file ipshell.cc.

1042{
1043 int len,reg,typ0;
1044
1045 resolvente r=liFindRes(L,&len,&typ0);
1046
1047 if (r==NULL)
1048 return -2;
1049 intvec *weights=NULL;
1050 int add_row_shift=0;
1051 intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1052 if (ww!=NULL)
1053 {
1054 weights=ivCopy(ww);
1055 add_row_shift = ww->min_in();
1056 (*weights) -= add_row_shift;
1057 }
1058 //Print("attr:%x\n",weights);
1059
1060 intvec *dummy=syBetti(r,len,&reg,weights);
1061 if (weights!=NULL) delete weights;
1062 delete dummy;
1063 omFreeSize((ADDRESS)r,len*sizeof(ideal));
1064 return reg+1+add_row_shift;
1065}
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition attrib.cc:132
int min_in()
Definition intvec.h:122
intvec * ivCopy(const intvec *o)
Definition intvec.h:146
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition lists.cc:338
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition syz.cc:783

◆ iiReportTypes()

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

Definition at line 6549 of file ipshell.cc.

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

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

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

◆ iiTwoOps()

const char * iiTwoOps ( int t)

Definition at line 89 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv res,
leftv v )

Definition at line 587 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv res,
leftv u )

Definition at line 971 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1005 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 984 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv res,
leftv u )

Definition at line 3343 of file ipshell.cc.

3344{
3345 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3346 return (res->data==NULL);
3347}
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition clapsing.cc:1571

◆ jjINT_S_TO_ID()

static void jjINT_S_TO_ID ( int n,
int * e,
leftv res )
static

Definition at line 6281 of file ipshell.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv res,
leftv v )

Definition at line 950 of file ipshell.cc.

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

◆ jjPROC()

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

Definition at line 1615 of file iparith.cc.

1616{
1617 void *d;
1618 Subexpr e;
1619 int typ;
1620 BOOLEAN t=FALSE;
1621 idhdl tmp_proc=NULL;
1622 if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1623 {
1624 tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1625 tmp_proc->id="_auto";
1626 tmp_proc->typ=PROC_CMD;
1627 tmp_proc->data.pinf=(procinfo *)u->Data();
1628 tmp_proc->ref=1;
1629 d=u->data; u->data=(void *)tmp_proc;
1630 e=u->e; u->e=NULL;
1631 t=TRUE;
1632 typ=u->rtyp; u->rtyp=IDHDL;
1633 }
1634 BOOLEAN sl;
1635 if (u->req_packhdl==currPack)
1636 sl = iiMake_proc((idhdl)u->data,NULL,v);
1637 else
1638 sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1639 if (t)
1640 {
1641 u->rtyp=typ;
1642 u->data=d;
1643 u->e=e;
1644 omFreeSize(tmp_proc,sizeof(idrec));
1645 }
1646 if (sl) return TRUE;
1647 memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1648 iiRETURNEXPR.Init();
1649 return FALSE;
1650}
Definition idrec.h:35
utypes data
Definition idrec.h:40
short ref
Definition idrec.h:46
const char * id
Definition idrec.h:39
package req_packhdl
Definition subexpr.h:106
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition iplib.cc:513

◆ jjRESULTANT()

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

Definition at line 3336 of file ipshell.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv res,
leftv u )

Definition at line 6311 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv res,
leftv u )

Definition at line 6303 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int v)

Definition at line 387 of file ipshell.cc.

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

◆ killlocals0()

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

Definition at line 296 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int v,
lists L )

Definition at line 367 of file ipshell.cc.

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

◆ killlocals_rec()

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

Definition at line 331 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv res,
leftv v )

Definition at line 3319 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv res,
leftv id )

Definition at line 3291 of file ipshell.cc.

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

◆ list1()

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

Definition at line 150 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 426 of file ipshell.cc.

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

◆ list_error()

void list_error ( semicState state)

Definition at line 3464 of file ipshell.cc.

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

◆ list_is_spectrum()

semicState list_is_spectrum ( lists l)

Definition at line 4249 of file ipshell.cc.

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

◆ listOfRoots()

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

Definition at line 5075 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv res,
leftv arg1 )

compute Newton Polytopes of input polynomials

Definition at line 4559 of file ipshell.cc.

4560{
4561 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4562 return FALSE;
4563}
ideal loNewtonPolytope(const ideal id)
Definition mpr_base.cc:3191

◆ loSimplex()

BOOLEAN loSimplex ( leftv res,
leftv args )

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4565 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv res,
leftv a )

Definition at line 3058 of file ipshell.cc.

3059{
3060 int i,j;
3061 matrix result;
3062 ideal id=(ideal)a->Data();
3063
3065 for (i=1; i<=IDELEMS(id); i++)
3066 {
3067 for (j=1; j<=rVar(currRing); j++)
3068 {
3069 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3070 }
3071 }
3072 res->data=(char *)result;
3073 return FALSE;
3074}
return result
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition matpol.cc:37
#define MATELEM(mat, i, j)
1-based access to matrix
Definition matpol.h:29
#define pDiff(a, b)
Definition polys.h:297

◆ mpKoszul()

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

Definition at line 3080 of file ipshell.cc.

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

◆ nuLagSolve()

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

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

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

Definition at line 4674 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4651 of file ipshell.cc.

4652{
4653 ideal gls = (ideal)(arg1->Data());
4654 int imtype= (int)(long)arg2->Data();
4655
4656 uResultant::resMatType mtype= determineMType( imtype );
4657
4658 // check input ideal ( = polynomial system )
4659 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4660 {
4661 return TRUE;
4662 }
4663
4664 uResultant *resMat= new uResultant( gls, mtype, false );
4665 if (resMat!=NULL)
4666 {
4667 res->rtyp = MODUL_CMD;
4668 res->data= (void*)resMat->accessResMat()->getMatrix();
4669 if (!errorreported) delete resMat;
4670 }
4671 return errorreported;
4672}
virtual ideal getMatrix()
Definition mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition mpr_base.h:63
resMatrixBase * accessResMat()
Definition mpr_base.h:78
@ mprOk
Definition mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv res,
leftv args )

solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).

Resultant method can be MPR_DENSE, which uses Macaulay Resultant (good for dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant (Gelfand, Kapranov, Zelevinsky). Arguments 4: ideal i, int k, int l, int m k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) l>0: defines precision of fractional part if ground field is Q m=0,1,2: number of iterations for approximation of roots (default=2) Returns a list containing the roots of the system.

Definition at line 4918 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4817 of file ipshell.cc.

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

◆ paPrint()

void paPrint ( const char * n,
package p )

Definition at line 6326 of file ipshell.cc.

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

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

◆ rComposeC()

void rComposeC ( lists L,
ring R )

Definition at line 2246 of file ipshell.cc.

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

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

◆ rComposeRing()

void rComposeRing ( lists L,
ring R )

Definition at line 2297 of file ipshell.cc.

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

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

◆ rDecompose()

lists rDecompose ( const ring r)

Definition at line 2147 of file ipshell.cc.

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

◆ rDecompose_23456()

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

Definition at line 2007 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv res,
const coeffs C )

Definition at line 1937 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring r)

Definition at line 2108 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1847 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1813 of file ipshell.cc.

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

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv h,
const ring R )

Definition at line 1909 of file ipshell.cc.

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

◆ rDecomposeRing_41()

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

Definition at line 1882 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char * s)

Definition at line 1639 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring r,
idhdl n )

Definition at line 1695 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5621 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl h)

Definition at line 6219 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring r)

Definition at line 6174 of file ipshell.cc.

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

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv ord)
static

Definition at line 5182 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring R)
static

Definition at line 2389 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl h)

Definition at line 5122 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6262 of file ipshell.cc.

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

◆ rSleftvList2StringArray()

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

Definition at line 5573 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv * ord,
ring R )

Definition at line 5301 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring org_ring,
sleftv * rv )

Definition at line 6012 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1107 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4547 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4507 of file ipshell.cc.

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

◆ siSetCpus()

int siSetCpus ( int cpu)

Definition at line 6658 of file ipshell.cc.

6659{
6660 int old=(int)(long)feOptValue(FE_OPT_CPUS);
6661 feSetOptValue(FE_OPT_CPUS,cpu);
6662 return old;
6663}
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition feOpt.cc:154
static void * feOptValue(feOptIndex opt)
Definition feOpt.h:40

◆ spaddProc()

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

Definition at line 4424 of file ipshell.cc.

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

◆ spectrumCompute()

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

Definition at line 3806 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv result,
leftv first )

Definition at line 4180 of file ipshell.cc.

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists l)

Definition at line 3380 of file ipshell.cc.

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

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState state)

Definition at line 4098 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv result,
leftv first )

Definition at line 4129 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3565 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4466 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv res,
leftv u )

Definition at line 3160 of file ipshell.cc.

3161{
3162 sleftv tmp;
3163 tmp.Init();
3164 tmp.rtyp=INT_CMD;
3165 tmp.data=(void *)1;
3166 return syBetti2(res,u,&tmp);
3167}
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition ipshell.cc:3136

◆ syBetti2()

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

Definition at line 3136 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3172 of file ipshell.cc.

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

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

◆ type_cmd()

void type_cmd ( leftv v)

Definition at line 255 of file ipshell.cc.

256{
257 BOOLEAN oldShortOut = FALSE;
258
259 if (currRing != NULL)
260 {
261 oldShortOut = currRing->ShortOut;
262 currRing->ShortOut = 1;
263 }
264 int t=v->Typ();
265 Print("// %s %s ",v->Name(),Tok2Cmdname(t));
266 switch (t)
267 {
268 case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
269 case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
270 ((intvec*)(v->Data()))->cols()); break;
271 case MATRIX_CMD:Print(" %u x %u\n" ,
272 MATROWS((matrix)(v->Data())),
273 MATCOLS((matrix)(v->Data())));break;
274 case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
275 case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
276
277 case PROC_CMD:
278 case RING_CMD:
279 case IDEAL_CMD: PrintLn(); break;
280
281 //case INT_CMD:
282 //case STRING_CMD:
283 //case INTVEC_CMD:
284 //case POLY_CMD:
285 //case VECTOR_CMD:
286 //case PACKAGE_CMD:
287
288 default:
289 break;
290 }
291 v->Print();
292 if (currRing != NULL)
293 currRing->ShortOut = oldShortOut;
294}
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 81 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 82 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1067 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 85 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 83 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5609 of file ipshell.cc.