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

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

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

Variables

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

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 1065 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3443 of file ipshell.cc.

3444{
3445 semicOK,
3447
3450
3457
3462
3468
3471
3474
3475} semicState;
semicState
Definition ipshell.cc:3444
@ semicListWrongNumberOfNumerators
Definition ipshell.cc:3459
@ semicListPGWrong
Definition ipshell.cc:3473
@ semicListFirstElementWrongType
Definition ipshell.cc:3451
@ semicListPgNegative
Definition ipshell.cc:3464
@ semicListSecondElementWrongType
Definition ipshell.cc:3452
@ semicListMilnorWrong
Definition ipshell.cc:3472
@ semicListMulNegative
Definition ipshell.cc:3467
@ semicListFourthElementWrongType
Definition ipshell.cc:3454
@ semicListWrongNumberOfDenominators
Definition ipshell.cc:3460
@ semicListNotMonotonous
Definition ipshell.cc:3470
@ semicListNotSymmetric
Definition ipshell.cc:3469
@ semicListNNegative
Definition ipshell.cc:3458
@ semicListDenNegative
Definition ipshell.cc:3466
@ semicListTooShort
Definition ipshell.cc:3448
@ semicListTooLong
Definition ipshell.cc:3449
@ semicListThirdElementWrongType
Definition ipshell.cc:3453
@ semicListMuNegative
Definition ipshell.cc:3463
@ semicListNumNegative
Definition ipshell.cc:3465
@ semicMulNegative
Definition ipshell.cc:3446
@ semicListWrongNumberOfMultiplicities
Definition ipshell.cc:3461
@ semicOK
Definition ipshell.cc:3445
@ semicListFifthElementWrongType
Definition ipshell.cc:3455
@ semicListSixthElementWrongType
Definition ipshell.cc:3456

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3559 of file ipshell.cc.

3560{
3561 spectrumOK,
3570};
@ spectrumWrongRing
Definition ipshell.cc:3567
@ spectrumOK
Definition ipshell.cc:3561
@ spectrumDegenerate
Definition ipshell.cc:3566
@ spectrumUnspecErr
Definition ipshell.cc:3569
@ spectrumNotIsolated
Definition ipshell.cc:3565
@ spectrumBadPoly
Definition ipshell.cc:3563
@ spectrumNoSingularity
Definition ipshell.cc:3564
@ spectrumZero
Definition ipshell.cc:3562
@ spectrumNoHC
Definition ipshell.cc:3568

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3369 of file ipshell.cc.

3370{
3371 spec.mu = (int)(long)(l->m[0].Data( ));
3372 spec.pg = (int)(long)(l->m[1].Data( ));
3373 spec.n = (int)(long)(l->m[2].Data( ));
3374
3375 spec.copy_new( spec.n );
3376
3377 intvec *num = (intvec*)l->m[3].Data( );
3378 intvec *den = (intvec*)l->m[4].Data( );
3379 intvec *mul = (intvec*)l->m[5].Data( );
3380
3381 for( int i=0; i<spec.n; i++ )
3382 {
3383 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3384 spec.w[i] = (*mul)[i];
3385 }
3386}
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 552 of file ipshell.cc.

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

◆ getList()

lists getList ( spectrum spec)

Definition at line 3405 of file ipshell.cc.

3406{
3408
3409 L->Init( 6 );
3410
3411 intvec *num = new intvec( spec.n );
3412 intvec *den = new intvec( spec.n );
3413 intvec *mult = new intvec( spec.n );
3414
3415 for( int i=0; i<spec.n; i++ )
3416 {
3417 (*num) [i] = spec.s[i].get_num_si( );
3418 (*den) [i] = spec.s[i].get_den_si( );
3419 (*mult)[i] = spec.w[i];
3420 }
3421
3422 L->m[0].rtyp = INT_CMD; // milnor number
3423 L->m[1].rtyp = INT_CMD; // geometrical genus
3424 L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3425 L->m[3].rtyp = INTVEC_CMD; // numerators
3426 L->m[4].rtyp = INTVEC_CMD; // denomiantors
3427 L->m[5].rtyp = INTVEC_CMD; // multiplicities
3428
3429 L->m[0].data = (void*)(long)spec.mu;
3430 L->m[1].data = (void*)(long)spec.pg;
3431 L->m[2].data = (void*)(long)spec.n;
3432 L->m[3].data = (void*)num;
3433 L->m[4].data = (void*)den;
3434 L->m[5].data = (void*)mult;
3435
3436 return L;
3437}
int get_num_si()
Definition GMPrat.cc:138
int get_den_si()
Definition GMPrat.cc:152
int rtyp
Definition subexpr.h:91
void * data
Definition subexpr.h:88
Definition lists.h:24
sleftv * m
Definition lists.h:46
INLINE_THIS void Init(int l=0)
VAR omBin slists_bin
Definition lists.cc:23
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition minpoly.cc:647
#define omAllocBin(bin)

◆ iiApply()

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

Definition at line 6440 of file ipshell.cc.

6441{
6442 res->Init();
6443 res->rtyp=a->Typ();
6444 switch (res->rtyp /*a->Typ()*/)
6445 {
6446 case INTVEC_CMD:
6447 case INTMAT_CMD:
6448 return iiApplyINTVEC(res,a,op,proc);
6449 case BIGINTMAT_CMD:
6450 return iiApplyBIGINTMAT(res,a,op,proc);
6451 case IDEAL_CMD:
6452 case MODUL_CMD:
6453 case MATRIX_CMD:
6454 return iiApplyIDEAL(res,a,op,proc);
6455 case LIST_CMD:
6456 return iiApplyLIST(res,a,op,proc);
6457 }
6458 WerrorS("first argument to `apply` must allow an index");
6459 return TRUE;
6460}
#define TRUE
Definition auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition checklibs.c:16
int Typ()
Definition subexpr.cc:1049
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:6359
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition ipshell.cc:6401
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition ipshell.cc:6396
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition ipshell.cc:6391

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6391 of file ipshell.cc.

6392{
6393 WerrorS("not implemented");
6394 return TRUE;
6395}

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6396 of file ipshell.cc.

6397{
6398 WerrorS("not implemented");
6399 return TRUE;
6400}

◆ iiApplyINTVEC()

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

Definition at line 6359 of file ipshell.cc.

6360{
6361 intvec *aa=(intvec*)a->Data();
6363 sleftv tmp_in;
6364 leftv curr=res;
6366 for(int i=0;i<aa->length(); i++)
6367 {
6368 tmp_in.Init();
6369 tmp_in.rtyp=INT_CMD;
6370 tmp_in.data=(void*)(long)(*aa)[i];
6371 if (proc==NULL)
6373 else
6375 if (bo)
6376 {
6377 res->CleanUp(currRing);
6378 Werror("apply fails at index %d",i+1);
6379 return TRUE;
6380 }
6381 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6382 else
6383 {
6385 curr=curr->next;
6386 memcpy(curr,&tmp_out,sizeof(tmp_out));
6387 }
6388 }
6389 return FALSE;
6390}
int BOOLEAN
Definition auxiliary.h:87
#define FALSE
Definition auxiliary.h:96
Class used for (list of) interpreter objects.
Definition subexpr.h:83
void * Data()
Definition subexpr.cc:1193
leftv next
Definition subexpr.h:86
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition iparith.cc:9371
EXTERN_VAR omBin sleftv_bin
Definition ipid.h:145
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition iparith.cc:1619
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition polys.cc:13
void Werror(const char *fmt,...)
Definition reporter.cc:189
sleftv * leftv
Definition structs.h:57

◆ iiApplyLIST()

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

Definition at line 6401 of file ipshell.cc.

6402{
6403 lists aa=(lists)a->Data();
6404 if (aa->nr==-1) /* empty list*/
6405 {
6407 l->Init();
6408 res->data=(void *)l;
6409 return FALSE;
6410 }
6412 sleftv tmp_in;
6413 leftv curr=res;
6415 for(int i=0;i<=aa->nr; i++)
6416 {
6417 tmp_in.Init();
6418 tmp_in.Copy(&(aa->m[i]));
6419 if (proc==NULL)
6421 else
6423 tmp_in.CleanUp();
6424 if (bo)
6425 {
6426 res->CleanUp(currRing);
6427 Werror("apply fails at index %d",i+1);
6428 return TRUE;
6429 }
6430 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6431 else
6432 {
6434 curr=curr->next;
6435 memcpy(curr,&tmp_out,sizeof(tmp_out));
6436 }
6437 }
6438 return FALSE;
6439}

◆ iiARROW()

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

Definition at line 6489 of file ipshell.cc.

6490{
6491 size_t len=strlen(a)+strlen(s)+30; /* max. 27 currently */
6492 char *ss=(char*)omAlloc(len);
6493 // find end of s:
6494 int end_s=strlen(s);
6495 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6496 s[end_s+1]='\0';
6497 char *name=(char *)omAlloc(len);
6498 snprintf(name,len,"%s->%s",a,s);
6499 // find start of last expression
6500 int start_s=end_s-1;
6501 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6502 if (start_s<0) // ';' not found
6503 {
6504 snprintf(ss,len,"parameter def %s;return(%s);\n",a,s);
6505 }
6506 else // s[start_s] is ';'
6507 {
6508 s[start_s]='\0';
6509 snprintf(ss,len,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6510 }
6511 r->Init();
6512 // now produce procinfo for PROC_CMD:
6513 r->data = (void *)omAlloc0Bin(procinfo_bin);
6514 ((procinfo *)(r->data))->language=LANG_NONE;
6516 ((procinfo *)r->data)->data.s.body=ss;
6517 omFree(name);
6518 r->rtyp=PROC_CMD;
6519 //r->rtyp=STRING_CMD;
6520 //r->data=ss;
6521 return FALSE;
6522}
void Init()
Definition subexpr.h:107
const CanonicalForm int s
Definition facAbsFact.cc:51
char name(const Variable &v)
Definition factory.h:189
@ PROC_CMD
Definition grammar.cc:281
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition iplib.cc:1058
#define omAlloc(size)
#define omAlloc0Bin(bin)
#define omFree(addr)
VAR omBin procinfo_bin
Definition subexpr.cc:42
@ LANG_NONE
Definition subexpr.h:22

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6524 of file ipshell.cc.

6525{
6526 char* ring_name=omStrDup((char*)r->Name());
6527 int t=arg->Typ();
6528 if (t==RING_CMD)
6529 {
6530 sleftv tmp;
6531 tmp.Init();
6532 tmp.rtyp=IDHDL;
6534 tmp.data=(char*)h;
6535 if (h!=NULL)
6536 {
6537 tmp.name=h->id;
6538 BOOLEAN b=iiAssign(&tmp,arg);
6539 if (b) return TRUE;
6542 return FALSE;
6543 }
6544 else
6545 return TRUE;
6546 }
6547 else if (t==CRING_CMD)
6548 {
6549 sleftv tmp;
6550 sleftv n;
6551 n.Init();
6552 n.name=ring_name;
6553 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6554 if (iiAssign(&tmp,arg)) return TRUE;
6555 //Print("create %s\n",r->Name());
6556 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6557 return FALSE;
6558 }
6559 //Print("create %s\n",r->Name());
6560 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6561 return TRUE;// not handled -> error for now
6562}
CanonicalForm b
Definition cfModGcd.cc:4111
Definition idrec.h:35
const char * name
Definition subexpr.h:87
const char * Name()
Definition subexpr.h:120
VAR int myynest
Definition febase.cc:41
@ RING_CMD
Definition grammar.cc:282
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition ipassign.cc:2034
idhdl ggetid(const char *n)
Definition ipid.cc:583
#define IDROOT
Definition ipid.h:19
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition ipshell.cc:1199
idhdl rDefault(const char *s)
Definition ipshell.cc:1645
void rSetHdl(idhdl h)
Definition ipshell.cc:5135
STATIC_VAR Poly * h
Definition janet.cc:971
#define omStrDup(s)
#define IDHDL
Definition tok.h:31
@ CRING_CMD
Definition tok.h:56

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1274 of file ipshell.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1631 of file ipshell.cc.

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

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1587 of file ipshell.cc.

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

6583{
6584 int l=0;
6585 if (args==NULL)
6586 {
6587 if (type_list[0]==0) return TRUE;
6588 }
6589 else l=args->listLength();
6590 if (l!=(int)type_list[0])
6591 {
6592 if (report) iiReportTypes(0,l,type_list);
6593 return FALSE;
6594 }
6595 for(int i=1;i<=l;i++,args=args->next)
6596 {
6597 short t=type_list[i];
6598 if (t!=ANY_TYPE)
6599 {
6600 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6601 || (t!=args->Typ()))
6602 {
6603 if (report) iiReportTypes(i,args->Typ(),type_list);
6604 return FALSE;
6605 }
6606 }
6607 }
6608 return TRUE;
6609}
static void iiReportTypes(int nr, int t, const short *T)
Definition ipshell.cc:6564
#define ANY_TYPE
Definition tok.h:30

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 937 of file ipshell.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1066 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1199 of file ipshell.cc.

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1261 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1512 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1535 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1607 of file ipshell.cc.

1608{
1609 int i;
1610 if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1611 poly po=NULL;
1613 {
1614 scComputeHC(I,currRing->qideal,ak,po);
1615 if (po!=NULL)
1616 {
1617 pGetCoeff(po)=nInit(1);
1618 for (i=rVar(currRing); i>0; i--)
1619 {
1620 if (pGetExp(po, i) > 0) pDecrExp(po,i);
1621 }
1622 pSetComp(po,ak);
1623 pSetm(po);
1624 }
1625 }
1626 else
1627 po=pOne();
1628 return po;
1629}
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition hdegree.cc:1076
static BOOLEAN idIsZeroDim(ideal i)
Definition ideals.h:179
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition monomials.h:44
#define nInit(i)
Definition numbers.h:24
#define pSetm(p)
Definition polys.h:271
#define pSetComp(p, v)
Definition polys.h:38
#define pGetExp(p, i)
Exponent.
Definition polys.h:41
#define pOne()
Definition polys.h:315
#define pDecrExp(p, i)
Definition polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition ring.h:597
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition ring.h:767

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1413 of file ipshell.cc.

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

◆ iiInternalExport() [2/2]

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

Definition at line 1466 of file ipshell.cc.

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

849{
850 lists L=liMakeResolv(r,length,rlen,typ0,weights);
851 int i=0;
852 idhdl h;
853 size_t len=strlen(name)+5;
854 char * s=(char *)omAlloc(len);
855
856 while (i<=L->nr)
857 {
858 snprintf(s,len,"%s(%d)",name,i+1);
859 if (i==0)
860 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
861 else
863 if (h!=NULL)
864 {
865 h->data.uideal=(ideal)L->m[i].data;
866 h->attribute=L->m[i].attribute;
867 if (BVERBOSE(V_DEF_RES))
868 Print("//defining: %s as %d-th syzygy module\n",s,i+1);
869 }
870 else
871 {
872 idDelete((ideal *)&(L->m[i].data));
873 Warn("cannot define %s",s);
874 }
875 //L->m[i].data=NULL;
876 //L->m[i].rtyp=0;
877 //L->m[i].attribute=NULL;
878 i++;
879 }
880 omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
883}
attr attribute
Definition subexpr.h:89
int nr
Definition lists.h:44
#define idDelete(H)
delete an ideal
Definition ideals.h:29
static BOOLEAN length(leftv result, leftv arg)
Definition interval.cc:257
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition lists.cc:239
#define omFreeSize(addr, size)
#define V_DEF_RES
Definition options.h:50

◆ iiMap()

leftv iiMap ( map  theMap,
const char what 
)

Definition at line 615 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1377 of file ipshell.cc.

1378{
1379 if (iiCurrArgs==NULL)
1380 {
1381 if (strcmp(p->name,"#")==0)
1382 return iiDefaultParameter(p);
1383 Werror("not enough arguments for proc %s",VoiceName());
1384 p->CleanUp();
1385 return TRUE;
1386 }
1388 leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1390 if (strcmp(p->name,"#")==0)
1391 {
1393 rest=NULL;
1394 }
1395 else
1396 {
1397 h->next=NULL;
1398 }
1400 if (is_default_list)
1401 {
1403 }
1404 else
1405 {
1407 }
1408 h->CleanUp();
1410 return res;
1411}
BOOLEAN iiDefaultParameter(leftv p)
Definition ipshell.cc:1261

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1038 of file ipshell.cc.

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

◆ iiReportTypes()

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

Definition at line 6564 of file ipshell.cc.

6565{
6566 char buf[250];
6567 buf[0]='\0';
6568 if (nr==0)
6569 snprintf(buf,250,"wrong length of parameters(%d), expected ",t);
6570 else
6571 snprintf(buf,250,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6572 for(int i=1;i<=T[0];i++)
6573 {
6574 strcat(buf,"`");
6576 strcat(buf,"`");
6577 if (i<T[0]) strcat(buf,",");
6578 }
6579 WerrorS(buf);
6580}
STATIC_VAR jList * T
Definition janet.cc:30
int status int void * buf
Definition si_signals.h:59

◆ iiSetReturn()

void iiSetReturn ( const leftv  source)

Definition at line 6640 of file ipshell.cc.

6641{
6642 if ((source->next==NULL)&&(source->e==NULL))
6643 {
6644 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6645 {
6646 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6647 source->Init();
6648 return;
6649 }
6650 if (source->rtyp==IDHDL)
6651 {
6652 if ((IDLEV((idhdl)source->data)==myynest)
6653 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6654 {
6660 IDATTR((idhdl)source->data)=NULL;
6661 IDDATA((idhdl)source->data)=NULL;
6662 source->name=NULL;
6663 source->attribute=NULL;
6664 return;
6665 }
6666 }
6667 }
6669}
void Copy(leftv e)
Definition subexpr.cc:690
BITSET flag
Definition subexpr.h:90
#define IDATTR(a)
Definition ipid.h:123
@ ALIAS_CMD
Definition tok.h:34

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6462 of file ipshell.cc.

6463{
6464 // assume a: level
6465 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6466 {
6467 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6468 char assume_yylinebuf[80];
6470 int lev=(long)a->Data();
6471 int startlev=0;
6472 idhdl h=ggetid("assumeLevel");
6473 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6474 if(lev <=startlev)
6475 {
6476 BOOLEAN bo=b->Eval();
6477 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6478 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6479 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6480 }
6481 }
6482 b->CleanUp();
6483 a->CleanUp();
6484 return FALSE;
6485}
#define IDINT(a)
Definition ipid.h:125

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  v 
)

Definition at line 588 of file ipshell.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 968 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1002 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 981 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3356 of file ipshell.cc.

3357{
3359 return (res->data==NULL);
3360}
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 6297 of file ipshell.cc.

6298{
6299 if (n==0) n=1;
6300 ideal l=idInit(n,1);
6301 int i;
6302 poly p;
6303 for(i=rVar(currRing);i>0;i--)
6304 {
6305 if (e[i]>0)
6306 {
6307 n--;
6308 p=pOne();
6309 pSetExp(p,i,1);
6310 pSetm(p);
6311 l->m[n]=p;
6312 if (n==0) break;
6313 }
6314 }
6315 res->data=(char*)l;
6317 omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6318}
#define setFlag(A, F)
Definition ipid.h:113
#define FLAG_STD
Definition ipid.h:106
#define pSetExp(p, i, v)
Definition polys.h:42

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 947 of file ipshell.cc.

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

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

◆ jjRESULTANT()

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

Definition at line 3349 of file ipshell.cc.

3350{
3351 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3352 (poly)w->CopyD(), currRing);
3353 return errorreported;
3354}
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition clapsing.cc:345
void * CopyD(int t)
Definition subexpr.cc:715
VAR short errorreported
Definition feFopen.cc:23

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6327 of file ipshell.cc.

6328{
6329 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6330 ideal I=(ideal)u->Data();
6331 int i;
6332 int n=0;
6333 for(i=I->nrows*I->ncols-1;i>=0;i--)
6334 {
6335 int n0=pGetVariables(I->m[i],e);
6336 if (n0>n) n=n0;
6337 }
6338 jjINT_S_TO_ID(n,e,res);
6339 return FALSE;
6340}
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition ipshell.cc:6297
#define pGetVariables(p, e)
Definition polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6319 of file ipshell.cc.

6320{
6321 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6322 int n=pGetVariables((poly)u->Data(),e);
6323 jjINT_S_TO_ID(n,e,res);
6324 return FALSE;
6325}

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

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

◆ killlocals0()

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

Definition at line 295 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 366 of file ipshell.cc.

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

◆ killlocals_rec()

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

Definition at line 330 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3332 of file ipshell.cc.

3333{
3334 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3335 if (res->data==NULL)
3336 res->data=(char *)new intvec(rVar(currRing));
3337 return FALSE;
3338}
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3310 of file ipshell.cc.

3311{
3312 ideal F=(ideal)id->Data();
3313 intvec * iv = new intvec(rVar(currRing));
3314 polyset s;
3315 int sl, n, i;
3316 int *x;
3317
3318 res->data=(char *)iv;
3319 s = F->m;
3320 sl = IDELEMS(F) - 1;
3321 n = rVar(currRing);
3322 double wNsqr = (double)2.0 / (double)n;
3324 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3325 wCall(s, sl, x, wNsqr, currRing);
3326 for (i = n; i!=0; i--)
3327 (*iv)[i-1] = x[i + n + 1];
3328 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3329 return FALSE;
3330}
Variable x
Definition cfModGcd.cc:4090
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition weight0.cc:78

◆ list1()

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

Definition at line 149 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ list_error()

void list_error ( semicState  state)

Definition at line 3477 of file ipshell.cc.

3478{
3479 switch( state )
3480 {
3481 case semicListTooShort:
3482 WerrorS( "the list is too short" );
3483 break;
3484 case semicListTooLong:
3485 WerrorS( "the list is too long" );
3486 break;
3487
3489 WerrorS( "first element of the list should be int" );
3490 break;
3492 WerrorS( "second element of the list should be int" );
3493 break;
3495 WerrorS( "third element of the list should be int" );
3496 break;
3498 WerrorS( "fourth element of the list should be intvec" );
3499 break;
3501 WerrorS( "fifth element of the list should be intvec" );
3502 break;
3504 WerrorS( "sixth element of the list should be intvec" );
3505 break;
3506
3507 case semicListNNegative:
3508 WerrorS( "first element of the list should be positive" );
3509 break;
3511 WerrorS( "wrong number of numerators" );
3512 break;
3514 WerrorS( "wrong number of denominators" );
3515 break;
3517 WerrorS( "wrong number of multiplicities" );
3518 break;
3519
3521 WerrorS( "the Milnor number should be positive" );
3522 break;
3524 WerrorS( "the geometrical genus should be nonnegative" );
3525 break;
3527 WerrorS( "all numerators should be positive" );
3528 break;
3530 WerrorS( "all denominators should be positive" );
3531 break;
3533 WerrorS( "all multiplicities should be positive" );
3534 break;
3535
3537 WerrorS( "it is not symmetric" );
3538 break;
3540 WerrorS( "it is not monotonous" );
3541 break;
3542
3544 WerrorS( "the Milnor number is wrong" );
3545 break;
3546 case semicListPGWrong:
3547 WerrorS( "the geometrical genus is wrong" );
3548 break;
3549
3550 default:
3551 WerrorS( "unspecific error" );
3552 break;
3553 }
3554}

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4262 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5088 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4572 of file ipshell.cc.

4573{
4574 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4575 return FALSE;
4576}
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 4578 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3078 of file ipshell.cc.

3079{
3080 int i,j;
3081 matrix result;
3082 ideal id=(ideal)a->Data();
3083
3085 for (i=1; i<=IDELEMS(id); i++)
3086 {
3087 for (j=1; j<=rVar(currRing); j++)
3088 {
3089 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3090 }
3091 }
3092 res->data=(char *)result;
3093 return FALSE;
3094}
return result
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition matpol.cc:37
#define MATELEM(mat, i, j)
1-based access to matrix
Definition matpol.h:29
#define pDiff(a, b)
Definition polys.h:296

◆ mpKoszul()

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

Definition at line 3100 of file ipshell.cc.

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

◆ nuLagSolve()

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

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

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

Definition at line 4687 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4664 of file ipshell.cc.

4665{
4666 ideal gls = (ideal)(arg1->Data());
4667 int imtype= (int)(long)arg2->Data();
4668
4670
4671 // check input ideal ( = polynomial system )
4672 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4673 {
4674 return TRUE;
4675 }
4676
4677 uResultant *resMat= new uResultant( gls, mtype, false );
4678 if (resMat!=NULL)
4679 {
4680 res->rtyp = MODUL_CMD;
4681 res->data= (void*)resMat->accessResMat()->getMatrix();
4682 if (!errorreported) delete resMat;
4683 }
4684 return errorreported;
4685}
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 4931 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4830 of file ipshell.cc.

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

6343{
6344 Print(" %s (",n);
6345 switch (p->language)
6346 {
6347 case LANG_SINGULAR: PrintS("S"); break;
6348 case LANG_C: PrintS("C"); break;
6349 case LANG_TOP: PrintS("T"); break;
6350 case LANG_MAX: PrintS("M"); break;
6351 case LANG_NONE: PrintS("N"); break;
6352 default: PrintS("U");
6353 }
6354 if(p->libname!=NULL)
6355 Print(",%s", p->libname);
6356 PrintS(")");
6357}
@ 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 2792 of file ipshell.cc.

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

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2261 of file ipshell.cc.

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

◆ rComposeOrder()

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

Definition at line 2493 of file ipshell.cc.

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

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2313 of file ipshell.cc.

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

◆ rComposeVar()

static BOOLEAN rComposeVar ( const lists  L,
ring  R 
)
inlinestatic

Definition at line 2448 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2162 of file ipshell.cc.

2163{
2164 assume( r != NULL );
2165 const coeffs C = r->cf;
2166 assume( C != NULL );
2167
2168 // sanity check: require currRing==r for rings with polynomial data
2169 if ( (r!=currRing) && (
2170 (nCoeff_is_algExt(C) && (C != currRing->cf))
2171 || (r->qideal != NULL)
2173 || (rIsPluralRing(r))
2174#endif
2175 )
2176 )
2177 {
2178 WerrorS("ring with polynomial data must be the base ring or compatible");
2179 return NULL;
2180 }
2181 // 0: char/ cf - ring
2182 // 1: list (var)
2183 // 2: list (ord)
2184 // 3: qideal
2185 // possibly:
2186 // 4: C
2187 // 5: D
2189 if (rIsPluralRing(r))
2190 L->Init(6);
2191 else
2192 L->Init(4);
2193 // ----------------------------------------
2194 // 0: char/ cf - ring
2195 if (rField_is_numeric(r))
2196 {
2197 rDecomposeC(&(L->m[0]),r);
2198 }
2199 else if (rField_is_Ring(r))
2200 {
2201 rDecomposeRing(&(L->m[0]),r);
2202 }
2203 else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2204 {
2205 rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2206 }
2207 else if(rField_is_GF(r))
2208 {
2210 Lc->Init(4);
2211 // char:
2212 Lc->m[0].rtyp=INT_CMD;
2213 Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2214 // var:
2216 Lv->Init(1);
2217 Lv->m[0].rtyp=STRING_CMD;
2218 Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2219 Lc->m[1].rtyp=LIST_CMD;
2220 Lc->m[1].data=(void*)Lv;
2221 // ord:
2223 Lo->Init(1);
2225 Loo->Init(2);
2226 Loo->m[0].rtyp=STRING_CMD;
2227 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2228
2229 intvec *iv=new intvec(1); (*iv)[0]=1;
2230 Loo->m[1].rtyp=INTVEC_CMD;
2231 Loo->m[1].data=(void *)iv;
2232
2233 Lo->m[0].rtyp=LIST_CMD;
2234 Lo->m[0].data=(void*)Loo;
2235
2236 Lc->m[2].rtyp=LIST_CMD;
2237 Lc->m[2].data=(void*)Lo;
2238 // q-ideal:
2239 Lc->m[3].rtyp=IDEAL_CMD;
2240 Lc->m[3].data=(void *)idInit(1,1);
2241 // ----------------------
2242 L->m[0].rtyp=LIST_CMD;
2243 L->m[0].data=(void*)Lc;
2244 }
2245 else if (rField_is_Zp(r) || rField_is_Q(r))
2246 {
2247 L->m[0].rtyp=INT_CMD;
2248 L->m[0].data=(void *)(long)r->cf->ch;
2249 }
2250 else
2251 {
2252 L->m[0].rtyp=CRING_CMD;
2253 L->m[0].data=(void *)r->cf;
2254 r->cf->ref++;
2255 }
2256 // ----------------------------------------
2257 rDecompose_23456(r,L);
2258 return L;
2259}
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:914
static void rDecomposeC(leftv h, const ring R)
Definition ipshell.cc:1854
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition ipshell.cc:1730
void rDecomposeRing(leftv h, const ring R)
Definition ipshell.cc:1918
static void rDecompose_23456(const ring r, lists L)
Definition ipshell.cc:2022
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition ring.h:405
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition ring.h:630
static BOOLEAN rField_is_numeric(const ring r)
Definition ring.h:520
static BOOLEAN rField_is_GF(const ring r)
Definition ring.h:526
#define rField_is_Ring(R)
Definition ring.h:490

◆ rDecompose_23456()

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

Definition at line 2022 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1950 of file ipshell.cc.

1951{
1952 assume( C != NULL );
1953
1954 // sanity check: require currRing==r for rings with polynomial data
1955 if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1956 {
1957 WerrorS("ring with polynomial data must be the base ring or compatible");
1958 return TRUE;
1959 }
1960 if (nCoeff_is_numeric(C))
1961 {
1963 }
1964#ifdef HAVE_RINGS
1965 else if (nCoeff_is_Ring(C))
1966 {
1968 }
1969#endif
1970 else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1971 {
1972 rDecomposeCF(res, C->extRing, currRing);
1973 }
1974 else if(nCoeff_is_GF(C))
1975 {
1977 Lc->Init(4);
1978 // char:
1979 Lc->m[0].rtyp=INT_CMD;
1980 Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1981 // var:
1983 Lv->Init(1);
1984 Lv->m[0].rtyp=STRING_CMD;
1985 Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1986 Lc->m[1].rtyp=LIST_CMD;
1987 Lc->m[1].data=(void*)Lv;
1988 // ord:
1990 Lo->Init(1);
1992 Loo->Init(2);
1993 Loo->m[0].rtyp=STRING_CMD;
1994 Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1995
1996 intvec *iv=new intvec(1); (*iv)[0]=1;
1997 Loo->m[1].rtyp=INTVEC_CMD;
1998 Loo->m[1].data=(void *)iv;
1999
2000 Lo->m[0].rtyp=LIST_CMD;
2001 Lo->m[0].data=(void*)Loo;
2002
2003 Lc->m[2].rtyp=LIST_CMD;
2004 Lc->m[2].data=(void*)Lo;
2005 // q-ideal:
2006 Lc->m[3].rtyp=IDEAL_CMD;
2007 Lc->m[3].data=(void *)idInit(1,1);
2008 // ----------------------
2009 res->rtyp=LIST_CMD;
2010 res->data=(void*)Lc;
2011 }
2012 else
2013 {
2014 res->rtyp=INT_CMD;
2015 res->data=(void *)(long)C->ch;
2016 }
2017 // ----------------------------------------
2018 return FALSE;
2019}
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition coeffs.h:843
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition coeffs.h:836
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition coeffs.h:782
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition coeffs.h:734
static void rDecomposeC_41(leftv h, const coeffs C)
Definition ipshell.cc:1820
static void rDecomposeRing_41(leftv h, const coeffs C)
Definition ipshell.cc:1890

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2123 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1854 of file ipshell.cc.

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

◆ rDecomposeC_41()

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

Definition at line 1820 of file ipshell.cc.

1822{
1824 if (nCoeff_is_long_C(C)) L->Init(3);
1825 else L->Init(2);
1826 h->rtyp=LIST_CMD;
1827 h->data=(void *)L;
1828 // 0: char/ cf - ring
1829 // 1: list (var)
1830 // 2: list (ord)
1831 // ----------------------------------------
1832 // 0: char/ cf - ring
1833 L->m[0].rtyp=INT_CMD;
1834 L->m[0].data=(void *)0;
1835 // ----------------------------------------
1836 // 1:
1838 LL->Init(2);
1839 LL->m[0].rtyp=INT_CMD;
1840 LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1841 LL->m[1].rtyp=INT_CMD;
1842 LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1843 L->m[1].rtyp=LIST_CMD;
1844 L->m[1].data=(void *)LL;
1845 // ----------------------------------------
1846 // 2: list (par)
1847 if (nCoeff_is_long_C(C))
1848 {
1849 L->m[2].rtyp=STRING_CMD;
1850 L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1851 }
1852 // ----------------------------------------
1853}
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition coeffs.h:898

◆ rDecomposeCF()

void rDecomposeCF ( leftv  h,
const ring  r,
const ring  R 
)

Definition at line 1730 of file ipshell.cc.

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

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1918 of file ipshell.cc.

1920{
1921#ifdef HAVE_RINGS
1923 if (rField_is_Z(R)) L->Init(1);
1924 else L->Init(2);
1925 h->rtyp=LIST_CMD;
1926 h->data=(void *)L;
1927 // 0: char/ cf - ring
1928 // 1: list (module)
1929 // ----------------------------------------
1930 // 0: char/ cf - ring
1931 L->m[0].rtyp=STRING_CMD;
1932 L->m[0].data=(void *)omStrDup("integer");
1933 // ----------------------------------------
1934 // 1: module
1935 if (rField_is_Z(R)) return;
1937 LL->Init(2);
1938 LL->m[0].rtyp=BIGINT_CMD;
1939 LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1940 LL->m[1].rtyp=INT_CMD;
1941 LL->m[1].data=(void *) R->cf->modExponent;
1942 L->m[1].rtyp=LIST_CMD;
1943 L->m[1].data=(void *)LL;
1944#else
1945 WerrorS("rDecomposeRing");
1946#endif
1947}
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition coeffs.h:546
static BOOLEAN rField_is_Z(const ring r)
Definition ring.h:514

◆ rDecomposeRing_41()

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

Definition at line 1890 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char s)

Definition at line 1645 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1702 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5634 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6235 of file ipshell.cc.

6236{
6237 ring r = IDRING(h);
6238 int ref=0;
6239 if (r!=NULL)
6240 {
6241 // avoid, that sLastPrinted is the last reference to the base ring:
6242 // clean up before killing the last "named" refrence:
6244 && (sLastPrinted.data==(void*)r))
6245 {
6247 }
6248 ref=r->ref;
6249 if ((ref<=0)&&(r==currRing))
6250 {
6251 // cleanup DENOMINATOR_LIST
6253 {
6255 if (TEST_V_ALLWARN)
6256 Warn("deleting denom_list for ring change from %s",IDID(h));
6257 do
6258 {
6259 n_Delete(&(dd->n),currRing->cf);
6260 dd=dd->next;
6263 } while(DENOMINATOR_LIST!=NULL);
6264 }
6265 }
6266 rKill(r);
6267 }
6268 if (h==currRingHdl)
6269 {
6270 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6271 else
6272 {
6274 }
6275 }
6276}
void rKill(ring r)
Definition ipshell.cc:6189
VAR denominator_list DENOMINATOR_LIST
Definition kutil.cc:84

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6189 of file ipshell.cc.

6190{
6191 if ((r->ref<=0)&&(r->order!=NULL))
6192 {
6193#ifdef RDEBUG
6194 if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6195#endif
6196 int j;
6197 for (j=0;j<myynest;j++)
6198 {
6199 if (iiLocalRing[j]==r)
6200 {
6201 if (j==0) WarnS("killing the basering for level 0");
6203 }
6204 }
6205// any variables depending on r ?
6206 while (r->idroot!=NULL)
6207 {
6208 r->idroot->lev=myynest; // avoid warning about kill global objects
6209 killhdl2(r->idroot,&(r->idroot),r);
6210 }
6211 if (r==currRing)
6212 {
6213 // all dependend stuff is done, clean global vars:
6214 if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6216 {
6218 }
6219 //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6220 //{
6221 // WerrorS("return value depends on local ring variable (export missing ?)");
6222 // iiRETURNEXPR.CleanUp();
6223 //}
6224 currRing=NULL;
6226 }
6227
6228 /* nKillChar(r); will be called from inside of rDelete */
6229 rDelete(r);
6230 return;
6231 }
6232 rDecRefCnt(r);
6233}
#define pDelete(p_ptr)
Definition polys.h:186

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5195 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2406 of file ipshell.cc.

2407{
2408 int i,j;
2409 BOOLEAN ch;
2410 do
2411 {
2412 ch=0;
2413 for(i=0;i<R->N-1;i++)
2414 {
2415 for(j=i+1;j<R->N;j++)
2416 {
2417 if (strcmp(R->names[i],R->names[j])==0)
2418 {
2419 ch=TRUE;
2420 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);
2421 omFree(R->names[j]);
2422 size_t len=2+strlen(R->names[i]);
2423 R->names[j]=(char *)omAlloc(len);
2424 snprintf(R->names[j],len,"@%s",R->names[i]);
2425 }
2426 }
2427 }
2428 }
2429 while (ch);
2430 for(i=0;i<rPar(R); i++)
2431 {
2432 for(j=0;j<R->N;j++)
2433 {
2434 if (strcmp(rParameter(R)[i],R->names[j])==0)
2435 {
2436 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);
2437// omFree(rParameter(R)[i]);
2438// rParameter(R)[i]=(char *)omAlloc(10);
2439// sprintf(rParameter(R)[i],"@@(%d)",i+1);
2440 omFree(R->names[j]);
2441 R->names[j]=(char *)omAlloc(10);
2442 snprintf(R->names[j],10,"@@(%d)",i+1);
2443 }
2444 }
2445 }
2446}

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5135 of file ipshell.cc.

5136{
5137 ring rg = NULL;
5138 if (h!=NULL)
5139 {
5140// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5141 rg = IDRING(h);
5142 if (rg==NULL) return; //id <>NULL, ring==NULL
5143 omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5144 if (IDID(h)) // OB: ????
5146 rTest(rg);
5147 }
5148 else return;
5149
5150 // clean up history
5151 if (currRing!=NULL)
5152 {
5154 {
5156 }
5157
5158 if (rg!=currRing)/*&&(currRing!=NULL)*/
5159 {
5160 if (rg->cf!=currRing->cf)
5161 {
5164 {
5165 if (TEST_V_ALLWARN)
5166 Warn("deleting denom_list for ring change to %s",IDID(h));
5167 do
5168 {
5169 n_Delete(&(dd->n),currRing->cf);
5170 dd=dd->next;
5173 } while(DENOMINATOR_LIST!=NULL);
5174 }
5175 }
5176 }
5177 }
5178
5179 // test for valid "currRing":
5180 if ((rg!=NULL) && (rg->idroot==NULL))
5181 {
5182 ring old=rg;
5184 if (old!=rg)
5185 {
5186 rKill(old);
5187 IDRING(h)=rg;
5188 }
5189 }
5190 /*------------ change the global ring -----------------------*/
5192 currRingHdl = h;
5193}
#define omCheckAddr(addr)
#define omCheckAddrSize(addr, size)
ring rAssure_HasComp(const ring r)
Definition ring.cc:4657

◆ rSimpleFindHdl()

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

Definition at line 6278 of file ipshell.cc.

6279{
6280 idhdl h=root;
6281 while (h!=NULL)
6282 {
6283 if ((IDTYP(h)==RING_CMD)
6284 && (h!=n)
6285 && (IDRING(h)==r)
6286 )
6287 {
6288 return h;
6289 }
6290 h=IDNEXT(h);
6291 }
6292 return NULL;
6293}

◆ rSleftvList2StringArray()

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

Definition at line 5586 of file ipshell.cc.

5587{
5588
5589 while(sl!=NULL)
5590 {
5591 if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5592 {
5593 *p = omStrDup(sl->Name());
5594 }
5595 else if (sl->name!=NULL)
5596 {
5597 *p = (char*)sl->name;
5598 sl->name=NULL;
5599 }
5600 else if (sl->rtyp==POLY_CMD)
5601 {
5602 sleftv s_sl;
5604 if (s_sl.name != NULL)
5605 {
5606 *p = (char*)s_sl.name; s_sl.name=NULL;
5607 }
5608 else
5609 *p = NULL;
5610 sl->next = s_sl.next;
5611 s_sl.next = NULL;
5612 s_sl.CleanUp();
5613 if (*p == NULL) return TRUE;
5614 }
5615 else return TRUE;
5616 p++;
5617 sl=sl->next;
5618 }
5619 return FALSE;
5620}

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5314 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 6027 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1104 of file ipshell.cc.

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

4561{
4562 sleftv tmp;
4563 tmp.Init();
4564 tmp.rtyp=INT_CMD;
4565 /* tmp.data = (void *)0; -- done by Init */
4566
4567 return semicProc3(res,u,v,&tmp);
4568}
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition ipshell.cc:4520

◆ semicProc3()

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

Definition at line 4520 of file ipshell.cc.

4521{
4522 semicState state;
4523 BOOLEAN qh=(((int)(long)w->Data())==1);
4524
4525 // -----------------
4526 // check arguments
4527 // -----------------
4528
4529 lists l1 = (lists)u->Data( );
4530 lists l2 = (lists)v->Data( );
4531
4532 if( (state=list_is_spectrum( l1 ))!=semicOK )
4533 {
4534 WerrorS( "first argument is not a spectrum" );
4535 list_error( state );
4536 }
4537 else if( (state=list_is_spectrum( l2 ))!=semicOK )
4538 {
4539 WerrorS( "second argument is not a spectrum" );
4540 list_error( state );
4541 }
4542 else
4543 {
4546
4547 res->rtyp = INT_CMD;
4548 if (qh)
4549 res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4550 else
4551 res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4552 }
4553
4554 // -----------------
4555 // check status
4556 // -----------------
4557
4558 return (state!=semicOK);
4559}
void list_error(semicState state)
Definition ipshell.cc:3477
spectrum spectrumFromList(lists l)
Definition ipshell.cc:3393
semicState list_is_spectrum(lists l)
Definition ipshell.cc:4262

◆ spaddProc()

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

Definition at line 4437 of file ipshell.cc.

4438{
4439 semicState state;
4440
4441 // -----------------
4442 // check arguments
4443 // -----------------
4444
4445 lists l1 = (lists)first->Data( );
4446 lists l2 = (lists)second->Data( );
4447
4448 if( (state=list_is_spectrum( l1 )) != semicOK )
4449 {
4450 WerrorS( "first argument is not a spectrum:" );
4451 list_error( state );
4452 }
4453 else if( (state=list_is_spectrum( l2 )) != semicOK )
4454 {
4455 WerrorS( "second argument is not a spectrum:" );
4456 list_error( state );
4457 }
4458 else
4459 {
4462 spectrum sum( s1+s2 );
4463
4464 result->rtyp = LIST_CMD;
4465 result->data = (char*)(getList(sum));
4466 }
4467
4468 return (state!=semicOK);
4469}
lists getList(spectrum &spec)
Definition ipshell.cc:3405

◆ spectrumCompute()

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

Definition at line 3819 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4193 of file ipshell.cc.

4194{
4195 spectrumState state = spectrumOK;
4196
4197 // -------------------
4198 // check consistency
4199 // -------------------
4200
4201 // check for a local polynomial ring
4202
4203 if( currRing->OrdSgn != -1 )
4204 // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4205 // or should we use:
4206 //if( !ringIsLocal( ) )
4207 {
4208 WerrorS( "only works for local orderings" );
4209 state = spectrumWrongRing;
4210 }
4211 else if( currRing->qideal != NULL )
4212 {
4213 WerrorS( "does not work in quotient rings" );
4214 state = spectrumWrongRing;
4215 }
4216 else
4217 {
4218 lists L = (lists)NULL;
4219 int flag = 2; // symmetric optimization
4220
4221 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4222
4223 if( state==spectrumOK )
4224 {
4225 result->rtyp = LIST_CMD;
4226 result->data = (char*)L;
4227 }
4228 else
4229 {
4230 spectrumPrintError(state);
4231 }
4232 }
4233
4234 return (state!=spectrumOK);
4235}
spectrumState
Definition ipshell.cc:3560
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition ipshell.cc:3819
void spectrumPrintError(spectrumState state)
Definition ipshell.cc:4111

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3393 of file ipshell.cc.

3394{
3396 copy_deep( result, l );
3397 return result;
3398}
void copy_deep(spectrum &spec, lists l)
Definition ipshell.cc:3369

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4111 of file ipshell.cc.

4112{
4113 switch( state )
4114 {
4115 case spectrumZero:
4116 WerrorS( "polynomial is zero" );
4117 break;
4118 case spectrumBadPoly:
4119 WerrorS( "polynomial has constant term" );
4120 break;
4122 WerrorS( "not a singularity" );
4123 break;
4125 WerrorS( "the singularity is not isolated" );
4126 break;
4127 case spectrumNoHC:
4128 WerrorS( "highest corner cannot be computed" );
4129 break;
4130 case spectrumDegenerate:
4131 WerrorS( "principal part is degenerate" );
4132 break;
4133 case spectrumOK:
4134 break;
4135
4136 default:
4137 WerrorS( "unknown error occurred" );
4138 break;
4139 }
4140}

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4142 of file ipshell.cc.

4143{
4144 spectrumState state = spectrumOK;
4145
4146 // -------------------
4147 // check consistency
4148 // -------------------
4149
4150 // check for a local ring
4151
4152 if( !ringIsLocal(currRing ) )
4153 {
4154 WerrorS( "only works for local orderings" );
4155 state = spectrumWrongRing;
4156 }
4157
4158 // no quotient rings are allowed
4159
4160 else if( currRing->qideal != NULL )
4161 {
4162 WerrorS( "does not work in quotient rings" );
4163 state = spectrumWrongRing;
4164 }
4165 else
4166 {
4167 lists L = (lists)NULL;
4168 int flag = 1; // weight corner optimization is safe
4169
4170 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4171
4172 if( state==spectrumOK )
4173 {
4174 result->rtyp = LIST_CMD;
4175 result->data = (char*)L;
4176 }
4177 else
4178 {
4179 spectrumPrintError(state);
4180 }
4181 }
4182
4183 return (state!=spectrumOK);
4184}
BOOLEAN ringIsLocal(const ring r)
Definition spectrum.cc:461

◆ spectrumStateFromList()

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

Definition at line 3578 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4479 of file ipshell.cc.

4480{
4481 semicState state;
4482
4483 // -----------------
4484 // check arguments
4485 // -----------------
4486
4487 lists l = (lists)first->Data( );
4488 int k = (int)(long)second->Data( );
4489
4490 if( (state=list_is_spectrum( l ))!=semicOK )
4491 {
4492 WerrorS( "first argument is not a spectrum" );
4493 list_error( state );
4494 }
4495 else if( k < 0 )
4496 {
4497 WerrorS( "second argument should be positive" );
4498 state = semicMulNegative;
4499 }
4500 else
4501 {
4503 spectrum product( k*s );
4504
4505 result->rtyp = LIST_CMD;
4506 result->data = (char*)getList(product);
4507 }
4508
4509 return (state!=semicOK);
4510}

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3179 of file ipshell.cc.

3180{
3181 sleftv tmp;
3182 tmp.Init();
3183 tmp.rtyp=INT_CMD;
3184 tmp.data=(void *)1;
3185 return syBetti2(res,u,&tmp);
3186}
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition ipshell.cc:3156

◆ syBetti2()

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

Definition at line 3156 of file ipshell.cc.

3157{
3159
3160 BOOLEAN minim=(int)(long)w->Data();
3161 int row_shift=0;
3162 int add_row_shift=0;
3163 intvec *weights=NULL;
3164 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3165 if (ww!=NULL)
3166 {
3167 weights=ivCopy(ww);
3168 add_row_shift = ww->min_in();
3169 (*weights) -= add_row_shift;
3170 }
3171
3172 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3173 //row_shift += add_row_shift;
3174 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3175 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3176
3177 return FALSE;
3178}
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 3263 of file ipshell.cc.

3264{
3265 int typ0;
3267
3268 resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3269 if (fr != NULL)
3270 {
3271
3272 result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3273 for (int i=result->length-1;i>=0;i--)
3274 {
3275 if (fr[i]!=NULL)
3276 result->fullres[i] = idCopy(fr[i]);
3277 }
3278 result->list_length=result->length;
3279 omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3280 }
3281 else
3282 {
3283 omFreeSize(result, sizeof(ssyStrategy));
3284 result = NULL;
3285 }
3286 return result;
3287}

◆ syConvRes()

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

Definition at line 3191 of file ipshell.cc.

3192{
3193 resolvente fullres = syzstr->fullres;
3194 resolvente minres = syzstr->minres;
3195
3196 const int length = syzstr->length;
3197
3198 if ((fullres==NULL) && (minres==NULL))
3199 {
3200 if (syzstr->hilb_coeffs==NULL)
3201 { // La Scala
3202 fullres = syReorder(syzstr->res, length, syzstr);
3203 }
3204 else
3205 { // HRES
3206 minres = syReorder(syzstr->orderedRes, length, syzstr);
3207 syKillEmptyEntres(minres, length);
3208 }
3209 }
3210
3211 resolvente tr;
3212 int typ0=IDEAL_CMD;
3213
3214 if (minres!=NULL)
3215 tr = minres;
3216 else
3217 tr = fullres;
3218
3220 intvec ** w=NULL;
3221
3222 if (length>0)
3223 {
3224 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3225 for (int i=length-1;i>=0;i--)
3226 {
3227 if (tr[i]!=NULL)
3228 {
3229 trueres[i] = idCopy(tr[i]);
3230 }
3231 }
3232 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3233 typ0 = MODUL_CMD;
3234 if (syzstr->weights!=NULL)
3235 {
3236 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3237 for (int i=length-1;i>=0;i--)
3238 {
3239 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3240 }
3241 }
3242 }
3243
3244 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3245 w, add_row_shift);
3246
3247 if (toDel)
3249 else
3250 {
3251 if( fullres != NULL && syzstr->fullres == NULL )
3252 syzstr->fullres = fullres;
3253
3254 if( minres != NULL && syzstr->minres == NULL )
3255 syzstr->minres = minres;
3256 }
3257 return li;
3258}
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition syz1.cc:1641
void syKillEmptyEntres(resolvente res, int length)
Definition syz1.cc:2199

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

Variable Documentation

◆ iiCurrArgs

VAR leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

◆ iiCurrProc

VAR idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

◆ iiDebugMarker

VAR BOOLEAN iiDebugMarker =TRUE

Definition at line 1064 of file ipshell.cc.

◆ iiNoKeepRing

STATIC_VAR BOOLEAN iiNoKeepRing =TRUE

Definition at line 84 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5622 of file ipshell.cc.