My Project  UNKNOWN_GIT_VERSION
Macros | Enumerations | Functions | Variables
ipshell.cc File Reference
#include "kernel/mod2.h"
#include "omalloc/omalloc.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/ring.h"
#include "polys/monomials/maps.h"
#include "polys/prCopy.h"
#include "polys/matpol.h"
#include "polys/weight.h"
#include "polys/clapsing.h"
#include "polys/ext_fields/algext.h"
#include "polys/ext_fields/transext.h"
#include "kernel/polys.h"
#include "kernel/ideals.h"
#include "kernel/numeric/mpr_base.h"
#include "kernel/numeric/mpr_numeric.h"
#include "kernel/GBEngine/syz.h"
#include "kernel/GBEngine/kstd1.h"
#include "kernel/GBEngine/kutil.h"
#include "kernel/combinatorics/stairc.h"
#include "kernel/combinatorics/hutil.h"
#include "kernel/spectrum/semic.h"
#include "kernel/spectrum/splist.h"
#include "kernel/spectrum/spectrum.h"
#include "kernel/oswrapper/feread.h"
#include "Singular/lists.h"
#include "Singular/attrib.h"
#include "Singular/ipconv.h"
#include "Singular/links/silink.h"
#include "Singular/ipshell.h"
#include "Singular/maps_ip.h"
#include "Singular/tok.h"
#include "Singular/ipid.h"
#include "Singular/subexpr.h"
#include "Singular/fevoices.h"
#include "Singular/sdb.h"
#include <cmath>
#include <ctype.h>
#include "kernel/maps/gen_maps.h"
#include "libparse.h"

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
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)
 
void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
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)
 
syStrategy syForceMin (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 More...
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
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) More...
 
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. More...
 
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. More...
 
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). More...
 
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)
 
idhdl rSimpleFindHdl (ring r, idhdl root, idhdl n)
 
BOOLEAN jjPROC (leftv res, leftv u, leftv v)
 
ideal kGroebner (ideal F, ideal Q)
 
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 More...
 

Variables

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

Macro Definition Documentation

◆ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 988 of file ipshell.cc.

Enumeration Type Documentation

◆ semicState

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

Definition at line 3403 of file ipshell.cc.

3404 {
3405  semicOK,
3407 
3410 
3417 
3422 
3428 
3431 
3434 
3435 } semicState;
semicState
Definition: ipshell.cc:3403

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3519 of file ipshell.cc.

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3329 of file ipshell.cc.

3330 {
3331  spec.mu = (int)(long)(l->m[0].Data( ));
3332  spec.pg = (int)(long)(l->m[1].Data( ));
3333  spec.n = (int)(long)(l->m[2].Data( ));
3334 
3335  spec.copy_new( spec.n );
3336 
3337  intvec *num = (intvec*)l->m[3].Data( );
3338  intvec *den = (intvec*)l->m[4].Data( );
3339  intvec *mul = (intvec*)l->m[5].Data( );
3340 
3341  for( int i=0; i<spec.n; i++ )
3342  {
3343  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3344  spec.w[i] = (*mul)[i];
3345  }
3346 }
CanonicalForm num(const CanonicalForm &f)
Rational * s
Definition: semic.h:70
int pg
Definition: semic.h:68
Definition: intvec.h:17
int i
Definition: cfEzgcd.cc:125
int n
Definition: semic.h:69
int mu
Definition: semic.h:67
CanonicalForm den(const CanonicalForm &f)
void copy_new(int)
Definition: semic.cc:54
int * w
Definition: semic.h:71
int l
Definition: cfEzgcd.cc:93

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 549 of file ipshell.cc.

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

◆ getList()

lists getList ( spectrum spec)

Definition at line 3365 of file ipshell.cc.

3366 {
3368 
3369  L->Init( 6 );
3370 
3371  intvec *num = new intvec( spec.n );
3372  intvec *den = new intvec( spec.n );
3373  intvec *mult = new intvec( spec.n );
3374 
3375  for( int i=0; i<spec.n; i++ )
3376  {
3377  (*num) [i] = spec.s[i].get_num_si( );
3378  (*den) [i] = spec.s[i].get_den_si( );
3379  (*mult)[i] = spec.w[i];
3380  }
3381 
3382  L->m[0].rtyp = INT_CMD; // milnor number
3383  L->m[1].rtyp = INT_CMD; // geometrical genus
3384  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3385  L->m[3].rtyp = INTVEC_CMD; // numerators
3386  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3387  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3388 
3389  L->m[0].data = (void*)(long)spec.mu;
3390  L->m[1].data = (void*)(long)spec.pg;
3391  L->m[2].data = (void*)(long)spec.n;
3392  L->m[3].data = (void*)num;
3393  L->m[4].data = (void*)den;
3394  L->m[5].data = (void*)mult;
3395 
3396  return L;
3397 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
Definition: lists.h:22
CanonicalForm num(const CanonicalForm &f)
Rational * s
Definition: semic.h:70
int pg
Definition: semic.h:68
int get_den_si()
Definition: GMPrat.cc:155
int get_num_si()
Definition: GMPrat.cc:141
void * data
Definition: subexpr.h:88
Definition: intvec.h:17
int i
Definition: cfEzgcd.cc:125
int n
Definition: semic.h:69
INLINE_THIS void Init(int l=0)
int mu
Definition: semic.h:67
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
slists * lists
Definition: mpr_numeric.h:146
CanonicalForm den(const CanonicalForm &f)
int rtyp
Definition: subexpr.h:91
int * w
Definition: semic.h:71
omBin slists_bin
Definition: lists.cc:23

◆ iiApply()

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

Definition at line 6407 of file ipshell.cc.

6408 {
6409  memset(res,0,sizeof(sleftv));
6410  res->rtyp=a->Typ();
6411  switch (res->rtyp /*a->Typ()*/)
6412  {
6413  case INTVEC_CMD:
6414  case INTMAT_CMD:
6415  return iiApplyINTVEC(res,a,op,proc);
6416  case BIGINTMAT_CMD:
6417  return iiApplyBIGINTMAT(res,a,op,proc);
6418  case IDEAL_CMD:
6419  case MODUL_CMD:
6420  case MATRIX_CMD:
6421  return iiApplyIDEAL(res,a,op,proc);
6422  case LIST_CMD:
6423  return iiApplyLIST(res,a,op,proc);
6424  }
6425  WerrorS("first argument to `apply` must allow an index");
6426  return TRUE;
6427 }
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1039
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6365
CanonicalForm res
Definition: facAbsFact.cc:64
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6375
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6370
Definition: tok.h:118
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6333

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6365 of file ipshell.cc.

6366 {
6367  WerrorS("not implemented");
6368  return TRUE;
6369 }
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6370 of file ipshell.cc.

6371 {
6372  WerrorS("not implemented");
6373  return TRUE;
6374 }
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ iiApplyINTVEC()

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

Definition at line 6333 of file ipshell.cc.

6334 {
6335  intvec *aa=(intvec*)a->Data();
6336  sleftv tmp_out;
6337  sleftv tmp_in;
6338  leftv curr=res;
6339  BOOLEAN bo=FALSE;
6340  for(int i=0;i<aa->length(); i++)
6341  {
6342  memset(&tmp_in,0,sizeof(tmp_in));
6343  tmp_in.rtyp=INT_CMD;
6344  tmp_in.data=(void*)(long)(*aa)[i];
6345  if (proc==NULL)
6346  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6347  else
6348  bo=jjPROC(&tmp_out,proc,&tmp_in);
6349  if (bo)
6350  {
6351  res->CleanUp(currRing);
6352  Werror("apply fails at index %d",i+1);
6353  return TRUE;
6354  }
6355  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6356  else
6357  {
6358  curr->next=(leftv)omAllocBin(sleftv_bin);
6359  curr=curr->next;
6360  memcpy(curr,&tmp_out,sizeof(tmp_out));
6361  }
6362  }
6363  return FALSE;
6364 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8448
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1618
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void * data
Definition: subexpr.h:88
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
omBin sleftv_bin
Definition: subexpr.cc:47
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:92
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiApplyLIST()

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

Definition at line 6375 of file ipshell.cc.

6376 {
6377  lists aa=(lists)a->Data();
6378  sleftv tmp_out;
6379  sleftv tmp_in;
6380  leftv curr=res;
6381  BOOLEAN bo=FALSE;
6382  for(int i=0;i<=aa->nr; i++)
6383  {
6384  memset(&tmp_in,0,sizeof(tmp_in));
6385  tmp_in.Copy(&(aa->m[i]));
6386  if (proc==NULL)
6387  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6388  else
6389  bo=jjPROC(&tmp_out,proc,&tmp_in);
6390  tmp_in.CleanUp();
6391  if (bo)
6392  {
6393  res->CleanUp(currRing);
6394  Werror("apply fails at index %d",i+1);
6395  return TRUE;
6396  }
6397  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6398  else
6399  {
6400  curr->next=(leftv)omAllocBin(sleftv_bin);
6401  curr=curr->next;
6402  memcpy(curr,&tmp_out,sizeof(tmp_out));
6403  }
6404  }
6405  return FALSE;
6406 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:22
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8448
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1618
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
CanonicalForm res
Definition: facAbsFact.cc:64
void Copy(leftv e)
Definition: subexpr.cc:720
omBin sleftv_bin
Definition: subexpr.cc:47
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiARROW()

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

Definition at line 6456 of file ipshell.cc.

6457 {
6458  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6459  // find end of s:
6460  int end_s=strlen(s);
6461  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6462  s[end_s+1]='\0';
6463  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6464  sprintf(name,"%s->%s",a,s);
6465  // find start of last expression
6466  int start_s=end_s-1;
6467  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6468  if (start_s<0) // ';' not found
6469  {
6470  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6471  }
6472  else // s[start_s] is ';'
6473  {
6474  s[start_s]='\0';
6475  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6476  }
6477  memset(r,0,sizeof(*r));
6478  // now produce procinfo for PROC_CMD:
6479  r->data = (void *)omAlloc0Bin(procinfo_bin);
6480  ((procinfo *)(r->data))->language=LANG_NONE;
6481  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6482  ((procinfo *)r->data)->data.s.body=ss;
6483  omFree(name);
6484  r->rtyp=PROC_CMD;
6485  //r->rtyp=STRING_CMD;
6486  //r->data=ss;
6487  return FALSE;
6488 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:991
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:48
void * data
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
char name(const Variable &v)
Definition: factory.h:180
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int rtyp
Definition: subexpr.h:91

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6490 of file ipshell.cc.

6491 {
6492  char* ring_name=omStrDup((char*)r->Name());
6493  int t=arg->Typ();
6494  if (t==RING_CMD)
6495  {
6496  sleftv tmp;
6497  memset(&tmp,0,sizeof(tmp));
6498  tmp.rtyp=IDHDL;
6499  tmp.data=(char*)rDefault(ring_name);
6500  if (tmp.data!=NULL)
6501  {
6502  BOOLEAN b=iiAssign(&tmp,arg);
6503  if (b) return TRUE;
6504  rSetHdl(ggetid(ring_name));
6505  omFree(ring_name);
6506  return FALSE;
6507  }
6508  else
6509  return TRUE;
6510  }
6511  else if (t==CRING_CMD)
6512  {
6513  sleftv tmp;
6514  sleftv n;
6515  memset(&n,0,sizeof(n));
6516  n.name=ring_name;
6517  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6518  if (iiAssign(&tmp,arg)) return TRUE;
6519  //Print("create %s\n",r->Name());
6520  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6521  return FALSE;
6522  }
6523  //Print("create %s\n",r->Name());
6524  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6525  return TRUE;// not handled -> error for now
6526 }
idhdl ggetid(const char *n)
Definition: ipid.cc:523
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:1039
const char * Name()
Definition: subexpr.h:120
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1555
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
CanonicalForm b
Definition: cfModGcd.cc:4044
Definition: tok.h:56
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1127
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
void rSetHdl(idhdl h)
Definition: ipshell.cc:5081
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1819
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  ,
leftv  args 
)

Definition at line 1184 of file ipshell.cc.

1185 {
1186  // must be inside a proc, as we simultae an proc_end at the end
1187  if (myynest==0)
1188  {
1189  WerrorS("branchTo can only occur in a proc");
1190  return TRUE;
1191  }
1192  // <string1...stringN>,<proc>
1193  // known: args!=NULL, l>=1
1194  int l=args->listLength();
1195  int ll=0;
1196  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1197  if (ll!=(l-1)) return FALSE;
1198  leftv h=args;
1199  // set up the table for type test:
1200  short *t=(short*)omAlloc(l*sizeof(short));
1201  t[0]=l-1;
1202  int b;
1203  int i;
1204  for(i=1;i<l;i++,h=h->next)
1205  {
1206  if (h->Typ()!=STRING_CMD)
1207  {
1208  omFree(t);
1209  Werror("arg %d is not a string",i);
1210  return TRUE;
1211  }
1212  int tt;
1213  b=IsCmd((char *)h->Data(),tt);
1214  if(b) t[i]=tt;
1215  else
1216  {
1217  omFree(t);
1218  Werror("arg %d is not a type name",i);
1219  return TRUE;
1220  }
1221  }
1222  if (h->Typ()!=PROC_CMD)
1223  {
1224  omFree(t);
1225  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1226  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1227  return TRUE;
1228  }
1229  b=iiCheckTypes(iiCurrArgs,t,0);
1230  omFree(t);
1231  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1232  {
1233  // get the proc:
1234  iiCurrProc=(idhdl)h->data;
1236  // already loaded ?
1237  if( pi->data.s.body==NULL )
1238  {
1240  if (pi->data.s.body==NULL) return TRUE;
1241  }
1242  // set currPackHdl/currPack
1243  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1244  {
1245  currPack=pi->pack;
1248  //Print("set pack=%s\n",IDID(currPackHdl));
1249  }
1250  // see iiAllStart:
1251  BITSET save1=si_opt_1;
1252  BITSET save2=si_opt_2;
1253  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1254  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1255  BOOLEAN err=yyparse();
1256  si_opt_1=save1;
1257  si_opt_2=save2;
1258  // now save the return-expr.
1260  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1261  iiRETURNEXPR.Init();
1262  // warning about args.:
1263  if (iiCurrArgs!=NULL)
1264  {
1265  if (err==0) Warn("too many arguments for %s",IDID(iiCurrProc));
1266  iiCurrArgs->CleanUp();
1268  iiCurrArgs=NULL;
1269  }
1270  // similate proc_end:
1271  // - leave input
1272  void myychangebuffer();
1273  myychangebuffer();
1274  // - set the current buffer to its end (this is a pointer in a buffer,
1275  // not a file ptr) "branchTo" is only valid in proc)
1277  // - kill local vars
1279  // - return
1280  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1281  return (err!=0);
1282  }
1283  return FALSE;
1284 }
long fptr
Definition: fevoices.h:70
void myychangebuffer()
Definition: scanner.cc:2330
unsigned si_opt_1
Definition: options.c:5
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
idhdl currPackHdl
Definition: ipid.cc:57
char * buffer
Definition: fevoices.h:69
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:455
int listLength()
Definition: subexpr.cc:57
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
void * ADDRESS
Definition: auxiliary.h:133
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define BITSET
Definition: structs.h:18
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:79
int myynest
Definition: febase.cc:41
CanonicalForm b
Definition: cfModGcd.cc:4044
#define omFree(addr)
Definition: omAllocDecl.h:261
void killlocals(int v)
Definition: ipshell.cc:383
idrec * idhdl
Definition: ring.h:22
omBin sleftv_bin
Definition: subexpr.cc:47
int i
Definition: cfEzgcd.cc:125
int yyparse(void)
Definition: grammar.cc:2111
#define IDPROC(a)
Definition: ipid.h:135
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
Voice * currentVoice
Definition: fevoices.cc:48
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:6546
package currPack
Definition: ipid.cc:59
leftv iiCurrArgs
Definition: ipshell.cc:78
sleftv sLastPrinted
Definition: subexpr.cc:52
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:157
idhdl packFindHdl(package r)
Definition: ipid.cc:752
void iiCheckPack(package &p)
Definition: ipshell.cc:1541
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
unsigned si_opt_2
Definition: options.c:6
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:192
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:93
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8860
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1541 of file ipshell.cc.

1542 {
1543  if (p!=basePack)
1544  {
1545  idhdl t=basePack->idroot;
1546  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1547  if (t==NULL)
1548  {
1549  WarnS("package not found\n");
1550  p=basePack;
1551  }
1552  }
1553 }
#define WarnS
Definition: emacs.cc:78
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:60
int p
Definition: cfModGcd.cc:4019

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1497 of file ipshell.cc.

1498 {
1499  if (currRing==NULL)
1500  {
1501  #ifdef SIQ
1502  if (siq<=0)
1503  {
1504  #endif
1505  if (RingDependend(i))
1506  {
1507  WerrorS("no ring active");
1508  return TRUE;
1509  }
1510  #ifdef SIQ
1511  }
1512  #endif
1513  }
1514  return FALSE;
1515 }
#define FALSE
Definition: auxiliary.h:94
BOOLEAN siq
Definition: subexpr.cc:54
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int RingDependend(int t)
Definition: gentable.cc:28
int i
Definition: cfEzgcd.cc:125
#define NULL
Definition: omList.c:10
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13

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

6547 {
6548  int l=0;
6549  if (args==NULL)
6550  {
6551  if (type_list[0]==0) return TRUE;
6552  }
6553  else l=args->listLength();
6554  if (l!=(int)type_list[0])
6555  {
6556  if (report) iiReportTypes(0,l,type_list);
6557  return FALSE;
6558  }
6559  for(int i=1;i<=l;i++,args=args->next)
6560  {
6561  short t=type_list[i];
6562  if (t!=ANY_TYPE)
6563  {
6564  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6565  || (t!=args->Typ()))
6566  {
6567  if (report) iiReportTypes(i,args->Typ(),type_list);
6568  return FALSE;
6569  }
6570  }
6571  }
6572  return TRUE;
6573 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:57
#define TRUE
Definition: auxiliary.h:98
#define IDHDL
Definition: tok.h:31
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6528
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:93

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 860 of file ipshell.cc.

861 {
862  int i;
863  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
864 
865  for (i=0; i<l; i++)
866  if (r[i]!=NULL) res[i]=idCopy(r[i]);
867  return res;
868 }
CanonicalForm res
Definition: facAbsFact.cc:64
int i
Definition: cfEzgcd.cc:125
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93

◆ iiDebug()

void iiDebug ( )

Definition at line 989 of file ipshell.cc.

990 {
991 #ifdef HAVE_SDB
992  sdb_flags=1;
993 #endif
994  Print("\n-- break point in %s --\n",VoiceName());
996  char * s;
998  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
999  loop
1000  {
1001  memset(s,0,80);
1003  if (s[BREAK_LINE_LENGTH-1]!='\0')
1004  {
1005  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1006  }
1007  else
1008  break;
1009  }
1010  if (*s=='\n')
1011  {
1013  }
1014 #if MDEBUG
1015  else if(strncmp(s,"cont;",5)==0)
1016  {
1018  }
1019 #endif /* MDEBUG */
1020  else
1021  {
1022  strcat( s, "\n;~\n");
1024  }
1025 }
void VoiceBackTrack()
Definition: fevoices.cc:68
const CanonicalForm int s
Definition: facAbsFact.cc:55
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
int sdb_flags
Definition: sdb.cc:32
#define Print
Definition: emacs.cc:80
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
#define loop
Definition: structs.h:78
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:987
const char * VoiceName()
Definition: fevoices.cc:57
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:988
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:157

◆ iiDeclCommand()

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

Definition at line 1127 of file ipshell.cc.

1128 {
1129  BOOLEAN res=FALSE;
1130  const char *id = name->name;
1131 
1132  memset(sy,0,sizeof(sleftv));
1133  if ((name->name==NULL)||(isdigit(name->name[0])))
1134  {
1135  WerrorS("object to declare is not a name");
1136  res=TRUE;
1137  }
1138  else
1139  {
1140  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1141 
1142  if (TEST_V_ALLWARN
1143  && (name->rtyp!=0)
1144  && (name->rtyp!=IDHDL)
1145  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1146  {
1147  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1149  }
1150  {
1151  sy->data = (char *)enterid(id,lev,t,root,init_b);
1152  }
1153  if (sy->data!=NULL)
1154  {
1155  sy->rtyp=IDHDL;
1156  currid=sy->name=IDID((idhdl)sy->data);
1157  // name->name=NULL; /* used in enterid */
1158  //sy->e = NULL;
1159  if (name->next!=NULL)
1160  {
1162  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1163  }
1164  }
1165  else res=TRUE;
1166  }
1167  name->CleanUp();
1168  return res;
1169 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
int yylineno
Definition: febase.cc:40
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
char * filename
Definition: fevoices.h:63
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
const char * currid
Definition: grammar.cc:171
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:267
char my_yylinebuf[80]
Definition: febase.cc:43
CanonicalForm res
Definition: facAbsFact.cc:64
const char * name
Definition: subexpr.h:87
idhdl currRingHdl
Definition: ipid.cc:61
omBin sleftv_bin
Definition: subexpr.cc:47
char name(const Variable &v)
Definition: factory.h:180
#define IDLEV(a)
Definition: ipid.h:116
leftv next
Definition: subexpr.h:86
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1127
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
Voice * currentVoice
Definition: fevoices.cc:48
int rtyp
Definition: subexpr.h:91
Definition: tok.h:158
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1171 of file ipshell.cc.

1172 {
1173  attr at=NULL;
1174  if (iiCurrProc!=NULL)
1175  at=iiCurrProc->attribute->get("default_arg");
1176  if (at==NULL)
1177  return FALSE;
1178  sleftv tmp;
1179  memset(&tmp,0,sizeof(sleftv));
1180  tmp.rtyp=at->atyp;
1181  tmp.data=at->CopyA();
1182  return iiAssign(p,&tmp);
1183 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: attrib.h:17
#define FALSE
Definition: auxiliary.h:94
idhdl iiCurrProc
Definition: ipshell.cc:79
void * data
Definition: subexpr.h:88
void * CopyA()
Definition: subexpr.cc:2031
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
int rtyp
Definition: subexpr.h:91
attr get(const char *s)
Definition: attrib.cc:92
int p
Definition: cfModGcd.cc:4019
int atyp
Definition: attrib.h:27
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1819

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1419 of file ipshell.cc.

1420 {
1421  BOOLEAN nok=FALSE;
1422  leftv r=v;
1423  while (v!=NULL)
1424  {
1425  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1426  {
1427  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1428  nok=TRUE;
1429  }
1430  else
1431  {
1432  if(iiInternalExport(v, toLev))
1433  {
1434  r->CleanUp();
1435  return TRUE;
1436  }
1437  }
1438  v=v->next;
1439  }
1440  r->CleanUp();
1441  return nok;
1442 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Variable next() const
Definition: factory.h:137
char name() const
Definition: variable.cc:122
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1321
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiExport() [2/2]

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

Definition at line 1445 of file ipshell.cc.

1446 {
1447 // if ((pack==basePack)&&(pack!=currPack))
1448 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1449  BOOLEAN nok=FALSE;
1450  leftv rv=v;
1451  while (v!=NULL)
1452  {
1453  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1454  )
1455  {
1456  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1457  nok=TRUE;
1458  }
1459  else
1460  {
1461  idhdl old=pack->idroot->get( v->name,toLev);
1462  if (old!=NULL)
1463  {
1464  if ((pack==currPack) && (old==(idhdl)v->data))
1465  {
1466  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1467  break;
1468  }
1469  else if (IDTYP(old)==v->Typ())
1470  {
1471  if (BVERBOSE(V_REDEFINE))
1472  {
1473  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1474  }
1475  v->name=omStrDup(v->name);
1476  killhdl2(old,&(pack->idroot),currRing);
1477  }
1478  else
1479  {
1480  rv->CleanUp();
1481  return TRUE;
1482  }
1483  }
1484  //Print("iiExport: pack=%s\n",IDID(root));
1485  if(iiInternalExport(v, toLev, pack))
1486  {
1487  rv->CleanUp();
1488  return TRUE;
1489  }
1490  }
1491  v=v->next;
1492  }
1493  rv->CleanUp();
1494  return nok;
1495 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:86
#define IDTYP(a)
Definition: ipid.h:114
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:417
char my_yylinebuf[80]
Definition: febase.cc:43
Variable next() const
Definition: factory.h:137
char name() const
Definition: variable.cc:122
#define BVERBOSE(a)
Definition: options.h:35
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1321
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:59
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
int BOOLEAN
Definition: auxiliary.h:85
#define V_REDEFINE
Definition: options.h:45
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1517 of file ipshell.cc.

1518 {
1519  int i;
1520  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1521  poly po=NULL;
1523  {
1524  scComputeHC(I,currRing->qideal,ak,po);
1525  if (po!=NULL)
1526  {
1527  pGetCoeff(po)=nInit(1);
1528  for (i=rVar(currRing); i>0; i--)
1529  {
1530  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1531  }
1532  pSetComp(po,ak);
1533  pSetm(po);
1534  }
1535  }
1536  else
1537  po=pOne();
1538  return po;
1539 }
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:751
#define pSetm(p)
Definition: polys.h:265
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:45
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:178
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:125
#define pOne()
Definition: polys.h:309
#define NULL
Definition: omList.c:10
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
#define nInit(i)
Definition: numbers.h:25

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1321 of file ipshell.cc.

1322 {
1323  idhdl h=(idhdl)v->data;
1324  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1325  if (IDLEV(h)==0)
1326  {
1327  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1328  }
1329  else
1330  {
1331  h=IDROOT->get(v->name,toLev);
1332  idhdl *root=&IDROOT;
1333  if ((h==NULL)&&(currRing!=NULL))
1334  {
1335  h=currRing->idroot->get(v->name,toLev);
1336  root=&currRing->idroot;
1337  }
1338  BOOLEAN keepring=FALSE;
1339  if ((h!=NULL)&&(IDLEV(h)==toLev))
1340  {
1341  if (IDTYP(h)==v->Typ())
1342  {
1343  if ((IDTYP(h)==RING_CMD)
1344  && (v->Data()==IDDATA(h)))
1345  {
1346  IDRING(h)->ref++;
1347  keepring=TRUE;
1348  IDLEV(h)=toLev;
1349  //WarnS("keepring");
1350  return FALSE;
1351  }
1352  if (BVERBOSE(V_REDEFINE))
1353  {
1354  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1355  }
1356  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1357  killhdl2(h,root,currRing);
1358  }
1359  else
1360  {
1361  return TRUE;
1362  }
1363  }
1364  h=(idhdl)v->data;
1365  IDLEV(h)=toLev;
1366  if (keepring) IDRING(h)->ref--;
1368  //Print("export %s\n",IDID(h));
1369  }
1370  return FALSE;
1371 }
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:114
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:417
char my_yylinebuf[80]
Definition: febase.cc:43
if(yy_init)
Definition: libparse.cc:1418
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
idrec * idhdl
Definition: ring.h:22
char name() const
Definition: variable.cc:122
#define IDLEV(a)
Definition: ipid.h:116
#define BVERBOSE(a)
Definition: options.h:35
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
ring * iiLocalRing
Definition: iplib.cc:454
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:122
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
#define IDDATA(a)
Definition: ipid.h:121
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
#define V_REDEFINE
Definition: options.h:45
#define Warn
Definition: emacs.cc:77

◆ iiInternalExport() [2/2]

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

Definition at line 1373 of file ipshell.cc.

1374 {
1375  idhdl h=(idhdl)v->data;
1376  if(h==NULL)
1377  {
1378  Warn("'%s': no such identifier\n", v->name);
1379  return FALSE;
1380  }
1381  package frompack=v->req_packhdl;
1382  if (frompack==NULL) frompack=currPack;
1383  if ((RingDependend(IDTYP(h)))
1384  || ((IDTYP(h)==LIST_CMD)
1385  && (lRingDependend(IDLIST(h)))
1386  )
1387  )
1388  {
1389  //Print("// ==> Ringdependent set nesting to 0\n");
1390  return (iiInternalExport(v, toLev));
1391  }
1392  else
1393  {
1394  IDLEV(h)=toLev;
1395  v->req_packhdl=rootpack;
1396  if (h==frompack->idroot)
1397  {
1398  frompack->idroot=h->next;
1399  }
1400  else
1401  {
1402  idhdl hh=frompack->idroot;
1403  while ((hh!=NULL) && (hh->next!=h))
1404  hh=hh->next;
1405  if ((hh!=NULL) && (hh->next==h))
1406  hh->next=h->next;
1407  else
1408  {
1409  Werror("`%s` not found",v->Name());
1410  return TRUE;
1411  }
1412  }
1413  h->next=rootpack->idroot;
1414  rootpack->idroot=h;
1415  }
1416  return FALSE;
1417 }
#define IDLIST(a)
Definition: ipid.h:132
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:114
int RingDependend(int t)
Definition: gentable.cc:28
idrec * idhdl
Definition: ring.h:22
idhdl next
Definition: idrec.h:38
char name() const
Definition: variable.cc:122
#define IDLEV(a)
Definition: ipid.h:116
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1321
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:59
Definition: tok.h:118
static Poly * h
Definition: janet.cc:972
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:77

◆ iiMakeResolv()

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

Definition at line 771 of file ipshell.cc.

773 {
774  lists L=liMakeResolv(r,length,rlen,typ0,weights);
775  int i=0;
776  idhdl h;
777  char * s=(char *)omAlloc(strlen(name)+5);
778 
779  while (i<=L->nr)
780  {
781  sprintf(s,"%s(%d)",name,i+1);
782  if (i==0)
783  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
784  else
785  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
786  if (h!=NULL)
787  {
788  h->data.uideal=(ideal)L->m[i].data;
789  h->attribute=L->m[i].attribute;
791  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
792  }
793  else
794  {
795  idDelete((ideal *)&(L->m[i].data));
796  Warn("cannot define %s",s);
797  }
798  //L->m[i].data=NULL;
799  //L->m[i].rtyp=0;
800  //L->m[i].attribute=NULL;
801  i++;
802  }
803  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
805  omFreeSize((ADDRESS)s,strlen(name)+5);
806 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define Print
Definition: emacs.cc:80
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define V_DEF_RES
Definition: options.h:50
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:267
if(yy_init)
Definition: libparse.cc:1418
int i
Definition: cfEzgcd.cc:125
char name(const Variable &v)
Definition: factory.h:180
#define BVERBOSE(a)
Definition: options.h:35
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
attr attribute
Definition: subexpr.h:89
omBin slists_bin
Definition: lists.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:972
#define Warn
Definition: emacs.cc:77

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 612 of file ipshell.cc.

613 {
614  idhdl w,r;
615  leftv v;
616  int i;
617  nMapFunc nMap;
618 
619  r=IDROOT->get(theMap->preimage,myynest);
620  if ((currPack!=basePack)
621  &&((r==NULL) || ((r->typ != RING_CMD) )))
622  r=basePack->idroot->get(theMap->preimage,myynest);
623  if ((r==NULL) && (currRingHdl!=NULL)
624  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
625  {
626  r=currRingHdl;
627  }
628  if ((r!=NULL) && (r->typ == RING_CMD))
629  {
630  ring src_ring=IDRING(r);
631  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
632  {
633  Werror("can not map from ground field of %s to current ground field",
634  theMap->preimage);
635  return NULL;
636  }
637  if (IDELEMS(theMap)<src_ring->N)
638  {
639  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
640  IDELEMS(theMap)*sizeof(poly),
641  (src_ring->N)*sizeof(poly));
642  for(i=IDELEMS(theMap);i<src_ring->N;i++)
643  theMap->m[i]=NULL;
644  IDELEMS(theMap)=src_ring->N;
645  }
646  if (what==NULL)
647  {
648  WerrorS("argument of a map must have a name");
649  }
650  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
651  {
652  char *save_r=NULL;
654  sleftv tmpW;
655  memset(&tmpW,0,sizeof(sleftv));
656  tmpW.rtyp=IDTYP(w);
657  if (tmpW.rtyp==MAP_CMD)
658  {
659  tmpW.rtyp=IDEAL_CMD;
660  save_r=IDMAP(w)->preimage;
661  IDMAP(w)->preimage=0;
662  }
663  tmpW.data=IDDATA(w);
664  // check overflow
665  BOOLEAN overflow=FALSE;
666  if ((tmpW.rtyp==IDEAL_CMD)
667  || (tmpW.rtyp==MODUL_CMD)
668  || (tmpW.rtyp==MAP_CMD))
669  {
670  ideal id=(ideal)tmpW.data;
671  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
672  for(int i=IDELEMS(id)-1;i>=0;i--)
673  {
674  poly p=id->m[i];
675  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
676  else degs[i]=0;
677  }
678  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
679  {
680  if (theMap->m[j]!=NULL)
681  {
682  long deg_monexp=pTotaldegree(theMap->m[j]);
683 
684  for(int i=IDELEMS(id)-1;i>=0;i--)
685  {
686  poly p=id->m[i];
687  if ((p!=NULL) && (degs[i]!=0) &&
688  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
689  {
690  overflow=TRUE;
691  break;
692  }
693  }
694  }
695  }
696  omFreeSize(degs,IDELEMS(id)*sizeof(long));
697  }
698  else if (tmpW.rtyp==POLY_CMD)
699  {
700  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
701  {
702  if (theMap->m[j]!=NULL)
703  {
704  long deg_monexp=pTotaldegree(theMap->m[j]);
705  poly p=(poly)tmpW.data;
706  long deg=0;
707  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
708  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
709  {
710  overflow=TRUE;
711  break;
712  }
713  }
714  }
715  }
716  if (overflow)
717  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
718 #if 0
719  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
720  {
721  v->rtyp=tmpW.rtyp;
722  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
723  }
724  else
725 #endif
726  {
727  if ((tmpW.rtyp==IDEAL_CMD)
728  ||(tmpW.rtyp==MODUL_CMD)
729  ||(tmpW.rtyp==MATRIX_CMD)
730  ||(tmpW.rtyp==MAP_CMD))
731  {
732  v->rtyp=tmpW.rtyp;
733  char *tmp = theMap->preimage;
734  theMap->preimage=(char*)1L;
735  // map gets 1 as its rank (as an ideal)
736  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
737  theMap->preimage=tmp; // map gets its preimage back
738  }
739  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
740  {
741  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
742  {
743  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
745  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
746  return NULL;
747  }
748  }
749  }
750  if (save_r!=NULL)
751  {
752  IDMAP(w)->preimage=save_r;
753  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
754  v->rtyp=MAP_CMD;
755  }
756  return v;
757  }
758  else
759  {
760  Werror("%s undefined in %s",what,theMap->preimage);
761  }
762  }
763  else
764  {
765  Werror("cannot find preimage %s",theMap->preimage);
766  }
767  return NULL;
768 }
int j
Definition: facHensel.cc:105
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
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:46
#define IDIDEAL(a)
Definition: ipid.h:128
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1444
void * ADDRESS
Definition: auxiliary.h:133
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
#define IDTYP(a)
Definition: ipid.h:114
if(yy_init)
Definition: libparse.cc:1418
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:88
static long pTotaldegree(poly p)
Definition: polys.h:276
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
idhdl currRingHdl
Definition: ipid.cc:61
poly * polyset
Definition: polys.h:254
omBin sleftv_bin
Definition: subexpr.cc:47
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:24
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:721
#define IDMAP(a)
Definition: ipid.h:130
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
package basePack
Definition: ipid.cc:60
#define IDRING(a)
Definition: ipid.h:122
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:59
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
int typ
Definition: idrec.h:43
int p
Definition: cfModGcd.cc:4019
#define IDDATA(a)
Definition: ipid.h:121
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 119 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1285 of file ipshell.cc.

1286 {
1287  if (iiCurrArgs==NULL)
1288  {
1289  if (strcmp(p->name,"#")==0)
1290  return iiDefaultParameter(p);
1291  Werror("not enough arguments for proc %s",VoiceName());
1292  p->CleanUp();
1293  return TRUE;
1294  }
1295  leftv h=iiCurrArgs;
1296  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1297  BOOLEAN is_default_list=FALSE;
1298  if (strcmp(p->name,"#")==0)
1299  {
1300  is_default_list=TRUE;
1301  rest=NULL;
1302  }
1303  else
1304  {
1305  h->next=NULL;
1306  }
1307  BOOLEAN res=iiAssign(p,h);
1308  if (is_default_list)
1309  {
1310  iiCurrArgs=NULL;
1311  }
1312  else
1313  {
1314  iiCurrArgs=rest;
1315  }
1316  h->CleanUp();
1318  return res;
1319 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
CanonicalForm res
Definition: facAbsFact.cc:64
omBin sleftv_bin
Definition: subexpr.cc:47
const char * VoiceName()
Definition: fevoices.cc:57
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1171
leftv iiCurrArgs
Definition: ipshell.cc:78
int p
Definition: cfModGcd.cc:4019
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1819

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 961 of file ipshell.cc.

962 {
963  int len,reg,typ0;
964 
965  resolvente r=liFindRes(L,&len,&typ0);
966 
967  if (r==NULL)
968  return -2;
969  intvec *weights=NULL;
970  int add_row_shift=0;
971  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
972  if (ww!=NULL)
973  {
974  weights=ivCopy(ww);
975  add_row_shift = ww->min_in();
976  (*weights) -= add_row_shift;
977  }
978  //Print("attr:%x\n",weights);
979 
980  intvec *dummy=syBetti(r,len,&reg,weights);
981  if (weights!=NULL) delete weights;
982  delete dummy;
983  omFreeSize((ADDRESS)r,len*sizeof(ideal));
984  return reg+1+add_row_shift;
985 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:119
Definition: intvec.h:17
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:131
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:771

◆ iiReportTypes()

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

Definition at line 6528 of file ipshell.cc.

6529 {
6530  char buf[250];
6531  buf[0]='\0';
6532  if (nr==0)
6533  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6534  else
6535  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6536  for(int i=1;i<=T[0];i++)
6537  {
6538  strcat(buf,"`");
6539  strcat(buf,Tok2Cmdname(T[i]));
6540  strcat(buf,"`");
6541  if (i<T[0]) strcat(buf,",");
6542  }
6543  WerrorS(buf);
6544 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
int status int void * buf
Definition: si_signals.h:59
int i
Definition: cfEzgcd.cc:125
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
static jList * T
Definition: janet.cc:31

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6429 of file ipshell.cc.

6430 {
6431  // assume a: level
6432  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6433  {
6434  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6435  char assume_yylinebuf[80];
6436  strncpy(assume_yylinebuf,my_yylinebuf,79);
6437  int lev=(long)a->Data();
6438  int startlev=0;
6439  idhdl h=ggetid("assumeLevel");
6440  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6441  if(lev <=startlev)
6442  {
6443  BOOLEAN bo=b->Eval();
6444  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6445  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6446  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6447  }
6448  }
6449  b->CleanUp();
6450  a->CleanUp();
6451  return FALSE;
6452 }
idhdl ggetid(const char *n)
Definition: ipid.cc:523
Definition: tok.h:96
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:78
int Typ()
Definition: subexpr.cc:1039
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
#define IDTYP(a)
Definition: ipid.h:114
CanonicalForm b
Definition: cfModGcd.cc:4044
char my_yylinebuf[80]
Definition: febase.cc:43
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:120
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
void * Data()
Definition: subexpr.cc:1182
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define TEST_V_ALLWARN
Definition: options.h:140

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 86 of file ipshell.cc.

87 {
88  if (t<127)
89  {
90  static char ch[2];
91  switch (t)
92  {
93  case '&':
94  return "and";
95  case '|':
96  return "or";
97  default:
98  ch[0]=t;
99  ch[1]='\0';
100  return ch;
101  }
102  }
103  switch (t)
104  {
105  case COLONCOLON: return "::";
106  case DOTDOT: return "..";
107  //case PLUSEQUAL: return "+=";
108  //case MINUSEQUAL: return "-=";
109  case MINUSMINUS: return "--";
110  case PLUSPLUS: return "++";
111  case EQUAL_EQUAL: return "==";
112  case LE: return "<=";
113  case GE: return ">=";
114  case NOTEQUAL: return "<>";
115  default: return Tok2Cmdname(t);
116  }
117 }
Definition: grammar.cc:270
Definition: grammar.cc:269
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 585 of file ipshell.cc.

586 {
587  sleftv vf;
588  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
589  {
590  WerrorS("link expected");
591  return TRUE;
592  }
593  si_link l=(si_link)vf.Data();
594  if (vf.next == NULL)
595  {
596  WerrorS("write: need at least two arguments");
597  return TRUE;
598  }
599 
600  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
601  if (b)
602  {
603  const char *s;
604  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
605  else s=sNoName_fe;
606  Werror("cannot write to %s",s);
607  }
608  vf.CleanUp();
609  return b;
610 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:436
const char sNoName_fe[]
Definition: fevoices.cc:56
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
CanonicalForm b
Definition: cfModGcd.cc:4044
leftv next
Definition: subexpr.h:86
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
Definition: tok.h:117
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
void * Data()
Definition: subexpr.cc:1182
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:93

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 891 of file ipshell.cc.

892 {
893  sleftv tmp;
894  memset(&tmp,0,sizeof(tmp));
895  tmp.rtyp=INT_CMD;
896  tmp.data=(void *)1;
897  if ((u->Typ()==IDEAL_CMD)
898  || (u->Typ()==MODUL_CMD))
899  return jjBETTI2_ID(res,u,&tmp);
900  else
901  return jjBETTI2(res,u,&tmp);
902 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:925
int Typ()
Definition: subexpr.cc:1039
void * data
Definition: subexpr.h:88
CanonicalForm res
Definition: facAbsFact.cc:64
int rtyp
Definition: subexpr.h:91
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:904

◆ jjBETTI2()

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

Definition at line 925 of file ipshell.cc.

926 {
927  resolvente r;
928  int len;
929  int reg,typ0;
930  lists l=(lists)u->Data();
931 
932  intvec *weights=NULL;
933  int add_row_shift=0;
934  intvec *ww=NULL;
935  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
936  if (ww!=NULL)
937  {
938  weights=ivCopy(ww);
939  add_row_shift = ww->min_in();
940  (*weights) -= add_row_shift;
941  }
942  //Print("attr:%x\n",weights);
943 
944  r=liFindRes(l,&len,&typ0);
945  if (r==NULL) return TRUE;
946  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
947  res->data=(void*)res_im;
948  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
949  //Print("rowShift: %d ",add_row_shift);
950  for(int i=1;i<=res_im->rows();i++)
951  {
952  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
953  else break;
954  }
955  //Print(" %d\n",add_row_shift);
956  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
957  if (weights!=NULL) delete weights;
958  return FALSE;
959 }
Definition: tok.h:96
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
int rows() const
Definition: intvec.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:119
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:152
int i
Definition: cfEzgcd.cc:125
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:131
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1182
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:771
#define IMATELEM(M, I, J)
Definition: intvec.h:83
int l
Definition: cfEzgcd.cc:93
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ jjBETTI2_ID()

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

Definition at line 904 of file ipshell.cc.

905 {
907  l->Init(1);
908  l->m[0].rtyp=u->Typ();
909  l->m[0].data=u->Data();
910  attr *a=u->Attribute();
911  if (a!=NULL)
912  l->m[0].attribute=*a;
913  sleftv tmp2;
914  memset(&tmp2,0,sizeof(tmp2));
915  tmp2.rtyp=LIST_CMD;
916  tmp2.data=(void *)l;
917  BOOLEAN r=jjBETTI2(res,&tmp2,v);
918  l->m[0].data=NULL;
919  l->m[0].attribute=NULL;
920  l->m[0].rtyp=DEF_CMD;
921  l->Clean();
922  return r;
923 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: attrib.h:17
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1476
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:925
int Typ()
Definition: subexpr.cc:1039
CanonicalForm res
Definition: facAbsFact.cc:64
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:85
int l
Definition: cfEzgcd.cc:93

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3316 of file ipshell.cc.

3317 {
3318  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3319  return (res->data==NULL);
3320 }
CanonicalForm res
Definition: facAbsFact.cc:64
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1449
#define NULL
Definition: omList.c:10
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182

◆ jjINT_S_TO_ID()

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

Definition at line 6271 of file ipshell.cc.

6272 {
6273  if (n==0) n=1;
6274  ideal l=idInit(n,1);
6275  int i;
6276  poly p;
6277  for(i=rVar(currRing);i>0;i--)
6278  {
6279  if (e[i]>0)
6280  {
6281  n--;
6282  p=pOne();
6283  pSetExp(p,i,1);
6284  pSetm(p);
6285  l->m[n]=p;
6286  if (n==0) break;
6287  }
6288  }
6289  res->data=(char*)l;
6290  setFlag(res,FLAG_STD);
6291  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6292 }
#define pSetm(p)
Definition: polys.h:265
#define pSetExp(p, i, v)
Definition: polys.h:42
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
void * ADDRESS
Definition: auxiliary.h:133
CanonicalForm res
Definition: facAbsFact.cc:64
#define setFlag(A, F)
Definition: ipid.h:108
int i
Definition: cfEzgcd.cc:125
#define pOne()
Definition: polys.h:309
#define FLAG_STD
Definition: ipid.h:104
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
int p
Definition: cfModGcd.cc:4019
int l
Definition: cfEzgcd.cc:93

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 870 of file ipshell.cc.

871 {
872  int len=0;
873  int typ0;
874  lists L=(lists)v->Data();
875  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
876  int add_row_shift = 0;
877  if (weights==NULL)
878  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
879  if (weights!=NULL) add_row_shift=weights->min_in();
880  resolvente rr=liFindRes(L,&len,&typ0);
881  if (rr==NULL) return TRUE;
882  resolvente r=iiCopyRes(rr,len);
883 
884  syMinimizeResolvente(r,len,0);
885  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
886  len++;
887  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
888  return FALSE;
889 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:356
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:119
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:860
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:131
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
ideal * resolvente
Definition: ideals.h:18

◆ jjPROC()

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

Definition at line 1618 of file iparith.cc.

1619 {
1620  void *d;
1621  Subexpr e;
1622  int typ;
1623  BOOLEAN t=FALSE;
1624  idhdl tmp_proc=NULL;
1625  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1626  {
1627  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1628  tmp_proc->id="_auto";
1629  tmp_proc->typ=PROC_CMD;
1630  tmp_proc->data.pinf=(procinfo *)u->Data();
1631  tmp_proc->ref=1;
1632  d=u->data; u->data=(void *)tmp_proc;
1633  e=u->e; u->e=NULL;
1634  t=TRUE;
1635  typ=u->rtyp; u->rtyp=IDHDL;
1636  }
1637  BOOLEAN sl;
1638  if (u->req_packhdl==currPack)
1639  sl = iiMake_proc((idhdl)u->data,NULL,v);
1640  else
1641  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1642  if (t)
1643  {
1644  u->rtyp=typ;
1645  u->data=d;
1646  u->e=e;
1647  omFreeSize(tmp_proc,sizeof(idrec));
1648  }
1649  if (sl) return TRUE;
1650  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1651  iiRETURNEXPR.Init();
1652  return FALSE;
1653 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Subexpr e
Definition: subexpr.h:105
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:455
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
CanonicalForm res
Definition: facAbsFact.cc:64
short ref
Definition: idrec.h:46
idrec * idhdl
Definition: ring.h:22
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:485
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:106
package currPack
Definition: ipid.cc:59
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1182
int typ
Definition: idrec.h:43
const char * id
Definition: idrec.h:39
int BOOLEAN
Definition: auxiliary.h:85
#define omAlloc0(size)
Definition: omAllocDecl.h:211
utypes data
Definition: idrec.h:40

◆ jjRESULTANT()

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

Definition at line 3309 of file ipshell.cc.

3310 {
3311  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3312  (poly)w->CopyD(), currRing);
3313  return errorreported;
3314 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:278
CanonicalForm res
Definition: facAbsFact.cc:64
short errorreported
Definition: feFopen.cc:23
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
const CanonicalForm & w
Definition: facAbsFact.cc:55
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * CopyD(int t)
Definition: subexpr.cc:745

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6301 of file ipshell.cc.

6302 {
6303  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6304  ideal I=(ideal)u->Data();
6305  int i;
6306  int n=0;
6307  for(i=I->nrows*I->ncols-1;i>=0;i--)
6308  {
6309  int n0=pGetVariables(I->m[i],e);
6310  if (n0>n) n=n0;
6311  }
6312  jjINT_S_TO_ID(n,e,res);
6313  return FALSE;
6314 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6271
#define pGetVariables(p, e)
Definition: polys.h:246
CanonicalForm res
Definition: facAbsFact.cc:64
int i
Definition: cfEzgcd.cc:125
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6293 of file ipshell.cc.

6294 {
6295  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6296  int n=pGetVariables((poly)u->Data(),e);
6297  jjINT_S_TO_ID(n,e,res);
6298  return FALSE;
6299 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6271
#define pGetVariables(p, e)
Definition: polys.h:246
CanonicalForm res
Definition: facAbsFact.cc:64
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6226 of file ipshell.cc.

6227 {
6228  //test|=Sy_bit(OPT_PROT);
6229  idhdl save_ringhdl=currRingHdl;
6230  ideal resid;
6231  idhdl new_ring=NULL;
6232  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6233  {
6234  currRingHdl=enterid(" GROEBNERring",0,RING_CMD,&IDROOT,FALSE);
6235  new_ring=currRingHdl;
6237  }
6238  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6239  idhdl h=ggetid("groebner");
6240  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6241  u.name=IDID(h);
6242 
6243  sleftv res; memset(&res,0,sizeof(res));
6244  if(jjPROC(&res,&u,&v))
6245  {
6246  resid=kStd(F,Q,testHomog,NULL);
6247  }
6248  else
6249  {
6250  //printf("typ:%d\n",res.rtyp);
6251  resid=(ideal)(res.data);
6252  }
6253  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6254  if (new_ring!=NULL)
6255  {
6256  idhdl h=IDROOT;
6257  if (h==new_ring) IDROOT=h->next;
6258  else
6259  {
6260  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6261  if (h!=NULL) h->next=h->next->next;
6262  }
6263  if (h!=NULL) omFreeSize(h,sizeof(*h));
6264  }
6265  currRingHdl=save_ringhdl;
6266  u.CleanUp();
6267  v.CleanUp();
6268  return resid;
6269 }
idhdl ggetid(const char *n)
Definition: ipid.cc:523
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1618
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:18
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:2087
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:267
CanonicalForm res
Definition: facAbsFact.cc:64
const char * name
Definition: subexpr.h:87
idhdl currRingHdl
Definition: ipid.cc:61
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:122
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
static Poly * h
Definition: janet.cc:972

◆ killlocals()

void killlocals ( int  v)

Definition at line 383 of file ipshell.cc.

384 {
385  BOOLEAN changed=FALSE;
386  idhdl sh=currRingHdl;
387  ring cr=currRing;
388  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
389  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
390 
391  killlocals_rec(&(basePack->idroot),v,currRing);
392 
394  {
395  int t=iiRETURNEXPR.Typ();
396  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
397  {
399  if (((ring)h->data)->idroot!=NULL)
400  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
401  }
402  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
403  {
405  changed |=killlocals_list(v,(lists)h->data);
406  }
407  }
408  if (changed)
409  {
411  if (currRingHdl==NULL)
412  currRing=NULL;
413  else if(cr!=currRing)
414  rChangeCurrRing(cr);
415  }
416 
417  if (myynest<=1) iiNoKeepRing=TRUE;
418  //Print("end killlocals >= %d\n",v);
419  //listall();
420 }
int iiRETURNEXPR_len
Definition: iplib.cc:456
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:455
#define TRUE
Definition: auxiliary.h:98
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:327
int Typ()
Definition: subexpr.cc:1039
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:363
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
idhdl currRingHdl
Definition: ipid.cc:61
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1612
#define IDLEV(a)
Definition: ipid.h:116
void rChangeCurrRing(ring r)
Definition: polys.cc:15
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:60
#define IDRING(a)
Definition: ipid.h:122
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:292

◆ killlocals0()

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

Definition at line 292 of file ipshell.cc.

293 {
294  idhdl h = *localhdl;
295  while (h!=NULL)
296  {
297  int vv;
298  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
299  if ((vv=IDLEV(h))>0)
300  {
301  if (vv < v)
302  {
303  if (iiNoKeepRing)
304  {
305  //PrintS(" break\n");
306  return;
307  }
308  h = IDNEXT(h);
309  //PrintLn();
310  }
311  else //if (vv >= v)
312  {
313  idhdl nexth = IDNEXT(h);
314  killhdl2(h,localhdl,r);
315  h = nexth;
316  //PrintS("kill\n");
317  }
318  }
319  else
320  {
321  h = IDNEXT(h);
322  //PrintLn();
323  }
324  }
325 }
#define IDNEXT(a)
Definition: ipid.h:113
Definition: idrec.h:34
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:417
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
#define IDLEV(a)
Definition: ipid.h:116
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
static Poly * h
Definition: janet.cc:972

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 363 of file ipshell.cc.

364 {
365  if (L==NULL) return FALSE;
366  BOOLEAN changed=FALSE;
367  int n=L->nr;
368  for(;n>=0;n--)
369  {
370  leftv h=&(L->m[n]);
371  void *d=h->data;
372  if ((h->rtyp==RING_CMD)
373  && (((ring)d)->idroot!=NULL))
374  {
375  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
376  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
377  }
378  else if (h->rtyp==LIST_CMD)
379  changed|=killlocals_list(v,(lists)d);
380  }
381  return changed;
382 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:363
void rChangeCurrRing(ring r)
Definition: polys.cc:15
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:292

◆ killlocals_rec()

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

Definition at line 327 of file ipshell.cc.

328 {
329  idhdl h=*root;
330  while (h!=NULL)
331  {
332  if (IDLEV(h)>=v)
333  {
334 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
335  idhdl n=IDNEXT(h);
336  killhdl2(h,root,r);
337  h=n;
338  }
339  else if (IDTYP(h)==PACKAGE_CMD)
340  {
341  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
342  if (IDPACKAGE(h)!=basePack)
343  killlocals_rec(&(IDRING(h)->idroot),v,r);
344  h=IDNEXT(h);
345  }
346  else if (IDTYP(h)==RING_CMD)
347  {
348  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
349  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
350  {
351  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
352  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
353  }
354  h=IDNEXT(h);
355  }
356  else
357  {
358 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
359  h=IDNEXT(h);
360  }
361  }
362 }
#define IDNEXT(a)
Definition: ipid.h:113
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:327
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:417
#define IDLEV(a)
Definition: ipid.h:116
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:60
#define IDRING(a)
Definition: ipid.h:122
static Poly * h
Definition: janet.cc:972

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3292 of file ipshell.cc.

3293 {
3294  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3295  if (res->data==NULL)
3296  res->data=(char *)new intvec(rVar(currRing));
3297  return FALSE;
3298 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
intvec * id_QHomWeight(ideal id, const ring r)
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3270 of file ipshell.cc.

3271 {
3272  ideal F=(ideal)id->Data();
3273  intvec * iv = new intvec(rVar(currRing));
3274  polyset s;
3275  int sl, n, i;
3276  int *x;
3277 
3278  res->data=(char *)iv;
3279  s = F->m;
3280  sl = IDELEMS(F) - 1;
3281  n = rVar(currRing);
3282  double wNsqr = (double)2.0 / (double)n;
3284  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3285  wCall(s, sl, x, wNsqr, currRing);
3286  for (i = n; i!=0; i--)
3287  (*iv)[i-1] = x[i + n + 1];
3288  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3289  return FALSE;
3290 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
void * ADDRESS
Definition: auxiliary.h:133
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:26
poly * polyset
Definition: polys.h:254
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:24
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:114
Variable x
Definition: cfModGcd.cc:4023
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:78

◆ list1()

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

Definition at line 147 of file ipshell.cc.

148 {
149  char buffer[22];
150  int l;
151  char buf2[128];
152 
153  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
154  else sprintf(buf2, "%s", IDID(h));
155 
156  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
157  if (h == currRingHdl) PrintS("*");
158  PrintS(Tok2Cmdname((int)IDTYP(h)));
159 
160  ipListFlag(h);
161  switch(IDTYP(h))
162  {
163  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
164  case INT_CMD: Print(" %d",IDINT(h)); break;
165  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
166  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
167  break;
168  case POLY_CMD:
169  case VECTOR_CMD:if (c)
170  {
171  PrintS(" ");wrp(IDPOLY(h));
172  if(IDPOLY(h) != NULL)
173  {
174  Print(", %d monomial(s)",pLength(IDPOLY(h)));
175  }
176  }
177  break;
178  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));
179  case IDEAL_CMD: Print(", %u generator(s)",
180  IDELEMS(IDIDEAL(h))); break;
181  case MAP_CMD:
182  Print(" from %s",IDMAP(h)->preimage); break;
183  case MATRIX_CMD:Print(" %u x %u"
184  ,MATROWS(IDMATRIX(h))
185  ,MATCOLS(IDMATRIX(h))
186  );
187  break;
188  case SMATRIX_CMD:Print(" %u x %u"
189  ,(int)(IDIDEAL(h)->rank)
190  ,IDELEMS(IDIDEAL(h))
191  );
192  break;
193  case PACKAGE_CMD:
194  paPrint(IDID(h),IDPACKAGE(h));
195  break;
196  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
197  && (strlen(IDPROC(h)->libname)>0))
198  Print(" from %s",IDPROC(h)->libname);
199  if(IDPROC(h)->language==LANG_C)
200  PrintS(" (C)");
201  if(IDPROC(h)->is_static)
202  PrintS(" (static)");
203  break;
204  case STRING_CMD:
205  {
206  char *s;
207  l=strlen(IDSTRING(h));
208  memset(buffer,0,22);
209  strncpy(buffer,IDSTRING(h),si_min(l,20));
210  if ((s=strchr(buffer,'\n'))!=NULL)
211  {
212  *s='\0';
213  }
214  PrintS(" ");
215  PrintS(buffer);
216  if((s!=NULL) ||(l>20))
217  {
218  Print("..., %d char(s)",l);
219  }
220  break;
221  }
222  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
223  break;
224  case RING_CMD:
225  if ((IDRING(h)==currRing) && (currRingHdl!=h))
226  PrintS("(*)"); /* this is an alias to currRing */
227 #ifdef RDEBUG
229  Print(" <%lx>",(long)(IDRING(h)));
230 #endif
231  break;
232 #ifdef SINGULAR_4_2
233  case CNUMBER_CMD:
234  { number2 n=(number2)IDDATA(h);
235  Print(" (%s)",nCoeffName(n->cf));
236  break;
237  }
238  case CMATRIX_CMD:
239  { bigintmat *b=(bigintmat*)IDDATA(h);
240  Print(" %d x %d (%s)",
241  b->rows(),b->cols(),
242  nCoeffName(b->basecoeffs()));
243  break;
244  }
245 #endif
246  /*default: break;*/
247  }
248  PrintLn();
249 }
#define IDLIST(a)
Definition: ipid.h:132
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
Definition: tok.h:96
#define IDINTVEC(a)
Definition: ipid.h:123
#define IDID(a)
Definition: ipid.h:117
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
Matrices of numbers.
Definition: bigintmat.h:51
#define IDIDEAL(a)
Definition: ipid.h:128
int traceit
Definition: febase.cc:42
Definition: idrec.h:34
void ipListFlag(idhdl h)
Definition: ipid.cc:538
Definition: subexpr.h:22
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
CanonicalForm b
Definition: cfModGcd.cc:4044
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:985
#define IDSTRING(a)
Definition: ipid.h:131
idhdl currRingHdl
Definition: ipid.cc:61
void PrintS(const char *s)
Definition: reporter.cc:284
static unsigned pLength(poly a)
Definition: p_polys.h:193
#define IDELEMS(i)
Definition: simpleideals.h:24
#define IDLEV(a)
Definition: ipid.h:116
#define IDMAP(a)
Definition: ipid.h:130
CanonicalForm buf2
Definition: facFqBivar.cc:71
Definition: tok.h:34
#define IDPROC(a)
Definition: ipid.h:135
void paPrint(const char *n, package p)
Definition: ipshell.cc:6316
#define MATCOLS(i)
Definition: matpol.h:27
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:120
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
#define IDPOLY(a)
Definition: ipid.h:125
#define IDRING(a)
Definition: ipid.h:122
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
#define MATROWS(i)
Definition: matpol.h:26
void wrp(poly p)
Definition: polys.h:304
#define IDDATA(a)
Definition: ipid.h:121
static Poly * h
Definition: janet.cc:972
int l
Definition: cfEzgcd.cc:93
#define IDMATRIX(a)
Definition: ipid.h:129

◆ list_cmd()

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

Definition at line 422 of file ipshell.cc.

423 {
424  package savePack=currPack;
425  idhdl h,start;
426  BOOLEAN all = typ<0;
427  BOOLEAN really_all=FALSE;
428 
429  if ( typ==0 )
430  {
431  if (strcmp(what,"all")==0)
432  {
433  if (currPack!=basePack)
434  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
435  really_all=TRUE;
436  h=basePack->idroot;
437  }
438  else
439  {
440  h = ggetid(what);
441  if (h!=NULL)
442  {
443  if (iterate) list1(prefix,h,TRUE,fullname);
444  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
445  if ((IDTYP(h)==RING_CMD)
446  //|| (IDTYP(h)==PACKAGE_CMD)
447  )
448  {
449  h=IDRING(h)->idroot;
450  }
451  else if(IDTYP(h)==PACKAGE_CMD)
452  {
454  //Print("list_cmd:package\n");
455  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
456  h=IDPACKAGE(h)->idroot;
457  }
458  else
459  {
460  currPack=savePack;
461  return;
462  }
463  }
464  else
465  {
466  Werror("%s is undefined",what);
467  currPack=savePack;
468  return;
469  }
470  }
471  all=TRUE;
472  }
473  else if (RingDependend(typ))
474  {
475  h = currRing->idroot;
476  }
477  else
478  h = IDROOT;
479  start=h;
480  while (h!=NULL)
481  {
482  if ((all
483  && (IDTYP(h)!=PROC_CMD)
484  &&(IDTYP(h)!=PACKAGE_CMD)
485  &&(IDTYP(h)!=CRING_CMD)
486  )
487  || (typ == IDTYP(h))
488  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
489  )
490  {
491  list1(prefix,h,start==currRingHdl, fullname);
492  if ((IDTYP(h)==RING_CMD)
493  && (really_all || (all && (h==currRingHdl)))
494  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
495  {
496  list_cmd(0,IDID(h),"// ",FALSE);
497  }
498  if (IDTYP(h)==PACKAGE_CMD && really_all)
499  {
500  package save_p=currPack;
502  list_cmd(0,IDID(h),"// ",FALSE);
503  currPack=save_p;
504  }
505  }
506  h = IDNEXT(h);
507  }
508  currPack=savePack;
509 }
idhdl ggetid(const char *n)
Definition: ipid.cc:523
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define IDNEXT(a)
Definition: ipid.h:113
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:147
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
int myynest
Definition: febase.cc:41
#define IDTYP(a)
Definition: ipid.h:114
Definition: tok.h:56
int RingDependend(int t)
Definition: gentable.cc:28
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:422
idhdl currRingHdl
Definition: ipid.cc:61
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDLEV(a)
Definition: ipid.h:116
Definition: tok.h:34
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:60
#define IDRING(a)
Definition: ipid.h:122
package currPack
Definition: ipid.cc:59
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ list_error()

void list_error ( semicState  state)

Definition at line 3437 of file ipshell.cc.

3438 {
3439  switch( state )
3440  {
3441  case semicListTooShort:
3442  WerrorS( "the list is too short" );
3443  break;
3444  case semicListTooLong:
3445  WerrorS( "the list is too long" );
3446  break;
3447 
3449  WerrorS( "first element of the list should be int" );
3450  break;
3452  WerrorS( "second element of the list should be int" );
3453  break;
3455  WerrorS( "third element of the list should be int" );
3456  break;
3458  WerrorS( "fourth element of the list should be intvec" );
3459  break;
3461  WerrorS( "fifth element of the list should be intvec" );
3462  break;
3464  WerrorS( "sixth element of the list should be intvec" );
3465  break;
3466 
3467  case semicListNNegative:
3468  WerrorS( "first element of the list should be positive" );
3469  break;
3471  WerrorS( "wrong number of numerators" );
3472  break;
3474  WerrorS( "wrong number of denominators" );
3475  break;
3477  WerrorS( "wrong number of multiplicities" );
3478  break;
3479 
3480  case semicListMuNegative:
3481  WerrorS( "the Milnor number should be positive" );
3482  break;
3483  case semicListPgNegative:
3484  WerrorS( "the geometrical genus should be nonnegative" );
3485  break;
3486  case semicListNumNegative:
3487  WerrorS( "all numerators should be positive" );
3488  break;
3489  case semicListDenNegative:
3490  WerrorS( "all denominators should be positive" );
3491  break;
3492  case semicListMulNegative:
3493  WerrorS( "all multiplicities should be positive" );
3494  break;
3495 
3496  case semicListNotSymmetric:
3497  WerrorS( "it is not symmetric" );
3498  break;
3500  WerrorS( "it is not monotonous" );
3501  break;
3502 
3503  case semicListMilnorWrong:
3504  WerrorS( "the Milnor number is wrong" );
3505  break;
3506  case semicListPGWrong:
3507  WerrorS( "the geometrical genus is wrong" );
3508  break;
3509 
3510  default:
3511  WerrorS( "unspecific error" );
3512  break;
3513  }
3514 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4222 of file ipshell.cc.

4223 {
4224  // -------------------
4225  // check list length
4226  // -------------------
4227 
4228  if( l->nr < 5 )
4229  {
4230  return semicListTooShort;
4231  }
4232  else if( l->nr > 5 )
4233  {
4234  return semicListTooLong;
4235  }
4236 
4237  // -------------
4238  // check types
4239  // -------------
4240 
4241  if( l->m[0].rtyp != INT_CMD )
4242  {
4244  }
4245  else if( l->m[1].rtyp != INT_CMD )
4246  {
4248  }
4249  else if( l->m[2].rtyp != INT_CMD )
4250  {
4252  }
4253  else if( l->m[3].rtyp != INTVEC_CMD )
4254  {
4256  }
4257  else if( l->m[4].rtyp != INTVEC_CMD )
4258  {
4260  }
4261  else if( l->m[5].rtyp != INTVEC_CMD )
4262  {
4264  }
4265 
4266  // -------------------------
4267  // check number of entries
4268  // -------------------------
4269 
4270  int mu = (int)(long)(l->m[0].Data( ));
4271  int pg = (int)(long)(l->m[1].Data( ));
4272  int n = (int)(long)(l->m[2].Data( ));
4273 
4274  if( n <= 0 )
4275  {
4276  return semicListNNegative;
4277  }
4278 
4279  intvec *num = (intvec*)l->m[3].Data( );
4280  intvec *den = (intvec*)l->m[4].Data( );
4281  intvec *mul = (intvec*)l->m[5].Data( );
4282 
4283  if( n != num->length( ) )
4284  {
4286  }
4287  else if( n != den->length( ) )
4288  {
4290  }
4291  else if( n != mul->length( ) )
4292  {
4294  }
4295 
4296  // --------
4297  // values
4298  // --------
4299 
4300  if( mu <= 0 )
4301  {
4302  return semicListMuNegative;
4303  }
4304  if( pg < 0 )
4305  {
4306  return semicListPgNegative;
4307  }
4308 
4309  int i;
4310 
4311  for( i=0; i<n; i++ )
4312  {
4313  if( (*num)[i] <= 0 )
4314  {
4315  return semicListNumNegative;
4316  }
4317  if( (*den)[i] <= 0 )
4318  {
4319  return semicListDenNegative;
4320  }
4321  if( (*mul)[i] <= 0 )
4322  {
4323  return semicListMulNegative;
4324  }
4325  }
4326 
4327  // ----------------
4328  // check symmetry
4329  // ----------------
4330 
4331  int j;
4332 
4333  for( i=0, j=n-1; i<=j; i++,j-- )
4334  {
4335  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4336  (*den)[i] != (*den)[j] ||
4337  (*mul)[i] != (*mul)[j] )
4338  {
4339  return semicListNotSymmetric;
4340  }
4341  }
4342 
4343  // ----------------
4344  // check monotony
4345  // ----------------
4346 
4347  for( i=0, j=1; i<n/2; i++,j++ )
4348  {
4349  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4350  {
4351  return semicListNotMonotonous;
4352  }
4353  }
4354 
4355  // ---------------------
4356  // check Milnor number
4357  // ---------------------
4358 
4359  for( mu=0, i=0; i<n; i++ )
4360  {
4361  mu += (*mul)[i];
4362  }
4363 
4364  if( mu != (int)(long)(l->m[0].Data( )) )
4365  {
4366  return semicListMilnorWrong;
4367  }
4368 
4369  // -------------------------
4370  // check geometrical genus
4371  // -------------------------
4372 
4373  for( pg=0, i=0; i<n; i++ )
4374  {
4375  if( (*num)[i]<=(*den)[i] )
4376  {
4377  pg += (*mul)[i];
4378  }
4379  }
4380 
4381  if( pg != (int)(long)(l->m[1].Data( )) )
4382  {
4383  return semicListPGWrong;
4384  }
4385 
4386  return semicOK;
4387 }
int j
Definition: facHensel.cc:105
void mu(int **points, int sizePoints)
Definition: tok.h:96
CanonicalForm num(const CanonicalForm &f)
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
Definition: intvec.h:17
int i
Definition: cfEzgcd.cc:125
int length() const
Definition: intvec.h:92
CanonicalForm den(const CanonicalForm &f)
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
int l
Definition: cfEzgcd.cc:93

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 5034 of file ipshell.cc.

5035 {
5036  int i,j;
5037  int count= self->roots[0]->getAnzRoots(); // number of roots
5038  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5039 
5040  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5041 
5042  if ( self->found_roots )
5043  {
5044  listofroots->Init( count );
5045 
5046  for (i=0; i < count; i++)
5047  {
5048  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5049  onepoint->Init(elem);
5050  for ( j= 0; j < elem; j++ )
5051  {
5052  if ( !rField_is_long_C(currRing) )
5053  {
5054  onepoint->m[j].rtyp=STRING_CMD;
5055  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5056  }
5057  else
5058  {
5059  onepoint->m[j].rtyp=NUMBER_CMD;
5060  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5061  }
5062  onepoint->m[j].next= NULL;
5063  onepoint->m[j].name= NULL;
5064  }
5065  listofroots->m[i].rtyp=LIST_CMD;
5066  listofroots->m[i].data=(void *)onepoint;
5067  listofroots->m[j].next= NULL;
5068  listofroots->m[j].name= NULL;
5069  }
5070 
5071  }
5072  else
5073  {
5074  listofroots->Init( 0 );
5075  }
5076 
5077  return listofroots;
5078 }
int status int void size_t count
Definition: si_signals.h:59
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
Definition: lists.h:22
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
const char * name
Definition: subexpr.h:87
int i
Definition: cfEzgcd.cc:125
bool found_roots
Definition: mpr_numeric.h:172
leftv next
Definition: subexpr.h:86
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:536
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:705
rootContainer ** roots
Definition: mpr_numeric.h:167

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4532 of file ipshell.cc.

4533 {
4534  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4535  return FALSE;
4536 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3192
CanonicalForm res
Definition: facAbsFact.cc:64
void * Data()
Definition: subexpr.cc:1182

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4538 of file ipshell.cc.

4539 {
4540  if ( !(rField_is_long_R(currRing)) )
4541  {
4542  WerrorS("Ground field not implemented!");
4543  return TRUE;
4544  }
4545 
4546  simplex * LP;
4547  matrix m;
4548 
4549  leftv v= args;
4550  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4551  return TRUE;
4552  else
4553  m= (matrix)(v->CopyD());
4554 
4555  LP = new simplex(MATROWS(m),MATCOLS(m));
4556  LP->mapFromMatrix(m);
4557 
4558  v= v->next;
4559  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4560  return TRUE;
4561  else
4562  LP->m= (int)(long)(v->Data());
4563 
4564  v= v->next;
4565  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4566  return TRUE;
4567  else
4568  LP->n= (int)(long)(v->Data());
4569 
4570  v= v->next;
4571  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4572  return TRUE;
4573  else
4574  LP->m1= (int)(long)(v->Data());
4575 
4576  v= v->next;
4577  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4578  return TRUE;
4579  else
4580  LP->m2= (int)(long)(v->Data());
4581 
4582  v= v->next;
4583  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4584  return TRUE;
4585  else
4586  LP->m3= (int)(long)(v->Data());
4587 
4588 #ifdef mprDEBUG_PROT
4589  Print("m (constraints) %d\n",LP->m);
4590  Print("n (columns) %d\n",LP->n);
4591  Print("m1 (<=) %d\n",LP->m1);
4592  Print("m2 (>=) %d\n",LP->m2);
4593  Print("m3 (==) %d\n",LP->m3);
4594 #endif
4595 
4596  LP->compute();
4597 
4598  lists lres= (lists)omAlloc( sizeof(slists) );
4599  lres->Init( 6 );
4600 
4601  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4602  lres->m[0].data=(void*)LP->mapToMatrix(m);
4603 
4604  lres->m[1].rtyp= INT_CMD; // found a solution?
4605  lres->m[1].data=(void*)(long)LP->icase;
4606 
4607  lres->m[2].rtyp= INTVEC_CMD;
4608  lres->m[2].data=(void*)LP->posvToIV();
4609 
4610  lres->m[3].rtyp= INTVEC_CMD;
4611  lres->m[3].data=(void*)LP->zrovToIV();
4612 
4613  lres->m[4].rtyp= INT_CMD;
4614  lres->m[4].data=(void*)(long)LP->m;
4615 
4616  lres->m[5].rtyp= INT_CMD;
4617  lres->m[5].data=(void*)(long)LP->n;
4618 
4619  res->data= (void*)lres;
4620 
4621  return FALSE;
4622 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
matrix mapToMatrix(matrix m)
void compute()
#define Print
Definition: emacs.cc:80
Definition: tok.h:96
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
#define TRUE
Definition: auxiliary.h:98
intvec * zrovToIV()
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
intvec * posvToIV()
CanonicalForm res
Definition: facAbsFact.cc:64
BOOLEAN mapFromMatrix(matrix m)
int m
Definition: cfEzgcd.cc:121
Variable next() const
Definition: factory.h:137
INLINE_THIS void Init(int l=0)
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define MATCOLS(i)
Definition: matpol.h:27
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:533
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
#define MATROWS(i)
Definition: matpol.h:26
int icase
Definition: mpr_numeric.h:201
ip_smatrix * matrix
Definition: matpol.h:31

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3040 of file ipshell.cc.

3041 {
3042  int i,j;
3043  matrix result;
3044  ideal id=(ideal)a->Data();
3045 
3046  result =mpNew(IDELEMS(id),rVar(currRing));
3047  for (i=1; i<=IDELEMS(id); i++)
3048  {
3049  for (j=1; j<=rVar(currRing); j++)
3050  {
3051  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3052  }
3053  }
3054  res->data=(char *)result;
3055  return FALSE;
3056 }
int j
Definition: facHensel.cc:105
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
CanonicalForm res
Definition: facAbsFact.cc:64
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
#define pDiff(a, b)
Definition: polys.h:290
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:28

◆ mpKoszul()

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

Definition at line 3062 of file ipshell.cc.

3063 {
3064  int n=(int)(long)b->Data();
3065  int d=(int)(long)c->Data();
3066  int k,l,sign,row,col;
3067  matrix result;
3068  ideal temp;
3069  BOOLEAN bo;
3070  poly p;
3071 
3072  if ((d>n) || (d<1) || (n<1))
3073  {
3074  res->data=(char *)mpNew(1,1);
3075  return FALSE;
3076  }
3077  int *choise = (int*)omAlloc(d*sizeof(int));
3078  if (id==NULL)
3079  temp=idMaxIdeal(1);
3080  else
3081  temp=(ideal)id->Data();
3082 
3083  k = binom(n,d);
3084  l = k*d;
3085  l /= n-d+1;
3086  result =mpNew(l,k);
3087  col = 1;
3088  idInitChoise(d,1,n,&bo,choise);
3089  while (!bo)
3090  {
3091  sign = 1;
3092  for (l=1;l<=d;l++)
3093  {
3094  if (choise[l-1]<=IDELEMS(temp))
3095  {
3096  p = pCopy(temp->m[choise[l-1]-1]);
3097  if (sign == -1) p = pNeg(p);
3098  sign *= -1;
3099  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3100  MATELEM(result,row,col) = p;
3101  }
3102  }
3103  col++;
3104  idGetNextChoise(d,n,&bo,choise);
3105  }
3106  omFreeSize(choise,d*sizeof(int));
3107  if (id==NULL) idDelete(&temp);
3108 
3109  res->data=(char *)result;
3110  return FALSE;
3111 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define pNeg(p)
Definition: polys.h:193
int k
Definition: cfEzgcd.cc:92
#define omAlloc(size)
Definition: omAllocDecl.h:210
CanonicalForm b
Definition: cfModGcd.cc:4044
CanonicalForm res
Definition: facAbsFact.cc:64
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1182
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
int p
Definition: cfModGcd.cc:4019
int BOOLEAN
Definition: auxiliary.h:85
static int sign(int x)
Definition: ring.cc:3346
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:93
#define pCopy(p)
return a copy of the poly
Definition: polys.h:180
#define MATELEM(mat, i, j)
Definition: matpol.h:28

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

4648 {
4649 
4650  poly gls;
4651  gls= (poly)(arg1->Data());
4652  int howclean= (int)(long)arg3->Data();
4653 
4654  if ( !(rField_is_R(currRing) ||
4655  rField_is_Q(currRing) ||
4658  {
4659  WerrorS("Ground field not implemented!");
4660  return TRUE;
4661  }
4662 
4665  {
4666  unsigned long int ii = (unsigned long int)arg2->Data();
4667  setGMPFloatDigits( ii, ii );
4668  }
4669 
4670  if ( gls == NULL || pIsConstant( gls ) )
4671  {
4672  WerrorS("Input polynomial is constant!");
4673  return TRUE;
4674  }
4675 
4676  int ldummy;
4677  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4678  int i,vpos=0;
4679  poly piter;
4680  lists elist;
4681  lists rlist;
4682 
4683  elist= (lists)omAlloc( sizeof(slists) );
4684  elist->Init( 0 );
4685 
4686  if ( rVar(currRing) > 1 )
4687  {
4688  piter= gls;
4689  for ( i= 1; i <= rVar(currRing); i++ )
4690  if ( pGetExp( piter, i ) )
4691  {
4692  vpos= i;
4693  break;
4694  }
4695  while ( piter )
4696  {
4697  for ( i= 1; i <= rVar(currRing); i++ )
4698  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4699  {
4700  WerrorS("The input polynomial must be univariate!");
4701  return TRUE;
4702  }
4703  pIter( piter );
4704  }
4705  }
4706 
4707  rootContainer * roots= new rootContainer();
4708  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4709  piter= gls;
4710  for ( i= deg; i >= 0; i-- )
4711  {
4712  if ( piter && pTotaldegree(piter) == i )
4713  {
4714  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4715  //nPrint( pcoeffs[i] );PrintS(" ");
4716  pIter( piter );
4717  }
4718  else
4719  {
4720  pcoeffs[i]= nInit(0);
4721  }
4722  }
4723 
4724 #ifdef mprDEBUG_PROT
4725  for (i=deg; i >= 0; i--)
4726  {
4727  nPrint( pcoeffs[i] );PrintS(" ");
4728  }
4729  PrintLn();
4730 #endif
4731 
4732  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4733  roots->solver( howclean );
4734 
4735  int elem= roots->getAnzRoots();
4736  char *dummy;
4737  int j;
4738 
4739  rlist= (lists)omAlloc( sizeof(slists) );
4740  rlist->Init( elem );
4741 
4743  {
4744  for ( j= 0; j < elem; j++ )
4745  {
4746  rlist->m[j].rtyp=NUMBER_CMD;
4747  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4748  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4749  }
4750  }
4751  else
4752  {
4753  for ( j= 0; j < elem; j++ )
4754  {
4755  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4756  rlist->m[j].rtyp=STRING_CMD;
4757  rlist->m[j].data=(void *)dummy;
4758  }
4759  }
4760 
4761  elist->Clean();
4762  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4763 
4764  // this is (via fillContainer) the same data as in root
4765  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4766  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4767 
4768  delete roots;
4769 
4770  res->rtyp= LIST_CMD;
4771  res->data= (void*)rlist;
4772 
4773  return FALSE;
4774 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
void PrintLn()
Definition: reporter.cc:310
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:509
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
#define TRUE
Definition: auxiliary.h:98
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:441
void WerrorS(const char *s)
Definition: feFopen.cc:24
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:45
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:47
void * data
Definition: subexpr.h:88
#define pIter(p)
Definition: monomials.h:38
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
CanonicalForm res
Definition: facAbsFact.cc:64
static long pTotaldegree(poly p)
Definition: polys.h:276
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:233
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:304
int i
Definition: cfEzgcd.cc:125
void PrintS(const char *s)
Definition: reporter.cc:284
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:497
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:536
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int getAnzRoots()
Definition: mpr_numeric.h:97
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:533
int rtyp
Definition: subexpr.h:91
#define nCopy(n)
Definition: numbers.h:16
void Clean(ring r=currRing)
Definition: lists.h:25
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:705
size_t gmp_output_digits
Definition: mpr_complex.cc:43
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...
Definition: mpr_complex.cc:61
#define nInit(i)
Definition: numbers.h:25

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

4625 {
4626  ideal gls = (ideal)(arg1->Data());
4627  int imtype= (int)(long)arg2->Data();
4628 
4629  uResultant::resMatType mtype= determineMType( imtype );
4630 
4631  // check input ideal ( = polynomial system )
4632  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4633  {
4634  return TRUE;
4635  }
4636 
4637  uResultant *resMat= new uResultant( gls, mtype, false );
4638  if (resMat!=NULL)
4639  {
4640  res->rtyp = MODUL_CMD;
4641  res->data= (void*)resMat->accessResMat()->getMatrix();
4642  if (!errorreported) delete resMat;
4643  }
4644  return errorreported;
4645 }
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define TRUE
Definition: auxiliary.h:98
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:120
Definition: mpr_base.h:98
CanonicalForm res
Definition: facAbsFact.cc:64
virtual ideal getMatrix()
Definition: mpr_base.h:31
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
short errorreported
Definition: feFopen.cc:23
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1182

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

4878 {
4879  leftv v= args;
4880 
4881  ideal gls;
4882  int imtype;
4883  int howclean;
4884 
4885  // get ideal
4886  if ( v->Typ() != IDEAL_CMD )
4887  return TRUE;
4888  else gls= (ideal)(v->Data());
4889  v= v->next;
4890 
4891  // get resultant matrix type to use (0,1)
4892  if ( v->Typ() != INT_CMD )
4893  return TRUE;
4894  else imtype= (int)(long)v->Data();
4895  v= v->next;
4896 
4897  if (imtype==0)
4898  {
4899  ideal test_id=idInit(1,1);
4900  int j;
4901  for(j=IDELEMS(gls)-1;j>=0;j--)
4902  {
4903  if (gls->m[j]!=NULL)
4904  {
4905  test_id->m[0]=gls->m[j];
4906  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4907  if (dummy_w!=NULL)
4908  {
4909  WerrorS("Newton polytope not of expected dimension");
4910  delete dummy_w;
4911  return TRUE;
4912  }
4913  }
4914  }
4915  }
4916 
4917  // get and set precision in digits ( > 0 )
4918  if ( v->Typ() != INT_CMD )
4919  return TRUE;
4920  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4922  {
4923  unsigned long int ii=(unsigned long int)v->Data();
4924  setGMPFloatDigits( ii, ii );
4925  }
4926  v= v->next;
4927 
4928  // get interpolation steps (0,1,2)
4929  if ( v->Typ() != INT_CMD )
4930  return TRUE;
4931  else howclean= (int)(long)v->Data();
4932 
4933  uResultant::resMatType mtype= determineMType( imtype );
4934  int i,count;
4935  lists listofroots= NULL;
4936  number smv= NULL;
4937  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4938 
4939  //emptylist= (lists)omAlloc( sizeof(slists) );
4940  //emptylist->Init( 0 );
4941 
4942  //res->rtyp = LIST_CMD;
4943  //res->data= (void *)emptylist;
4944 
4945  // check input ideal ( = polynomial system )
4946  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4947  {
4948  return TRUE;
4949  }
4950 
4951  uResultant * ures;
4952  rootContainer ** iproots;
4953  rootContainer ** muiproots;
4954  rootArranger * arranger;
4955 
4956  // main task 1: setup of resultant matrix
4957  ures= new uResultant( gls, mtype );
4958  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4959  {
4960  WerrorS("Error occurred during matrix setup!");
4961  return TRUE;
4962  }
4963 
4964  // if dense resultant, check if minor nonsingular
4965  if ( mtype == uResultant::denseResMat )
4966  {
4967  smv= ures->accessResMat()->getSubDet();
4968 #ifdef mprDEBUG_PROT
4969  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4970 #endif
4971  if ( nIsZero(smv) )
4972  {
4973  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4974  return TRUE;
4975  }
4976  }
4977 
4978  // main task 2: Interpolate specialized resultant polynomials
4979  if ( interpolate_det )
4980  iproots= ures->interpolateDenseSP( false, smv );
4981  else
4982  iproots= ures->specializeInU( false, smv );
4983 
4984  // main task 3: Interpolate specialized resultant polynomials
4985  if ( interpolate_det )
4986  muiproots= ures->interpolateDenseSP( true, smv );
4987  else
4988  muiproots= ures->specializeInU( true, smv );
4989 
4990 #ifdef mprDEBUG_PROT
4991  int c= iproots[0]->getAnzElems();
4992  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4993  c= muiproots[0]->getAnzElems();
4994  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4995 #endif
4996 
4997  // main task 4: Compute roots of specialized polys and match them up
4998  arranger= new rootArranger( iproots, muiproots, howclean );
4999  arranger->solve_all();
5000 
5001  // get list of roots
5002  if ( arranger->success() )
5003  {
5004  arranger->arrange();
5005  listofroots= listOfRoots(arranger, gmp_output_digits );
5006  }
5007  else
5008  {
5009  WerrorS("Solver was unable to find any roots!");
5010  return TRUE;
5011  }
5012 
5013  // free everything
5014  count= iproots[0]->getAnzElems();
5015  for (i=0; i < count; i++) delete iproots[i];
5016  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5017  count= muiproots[0]->getAnzElems();
5018  for (i=0; i < count; i++) delete muiproots[i];
5019  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5020 
5021  delete ures;
5022  delete arranger;
5023  nDelete( &smv );
5024 
5025  res->data= (void *)listofroots;
5026 
5027  //emptylist->Clean();
5028  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5029 
5030  return FALSE;
5031 }
int status int void size_t count
Definition: si_signals.h:59
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
int j
Definition: facHensel.cc:105
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
void PrintLn()
Definition: reporter.cc:310
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:96
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:509
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * id_QHomWeight(ideal id, const ring r)
#define TRUE
Definition: auxiliary.h:98
uResultant::resMatType determineMType(int imtype)
void * ADDRESS
Definition: auxiliary.h:133
void pWrite(poly p)
Definition: polys.h:302
void WerrorS(const char *s)
Definition: feFopen.cc:24
int getAnzElems()
Definition: mpr_numeric.h:95
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3061
const char * Name()
Definition: subexpr.h:120
Definition: mpr_base.h:98
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:47
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:887
int i
Definition: cfEzgcd.cc:125
void PrintS(const char *s)
Definition: reporter.cc:284
void solve_all()
Definition: mpr_numeric.cc:862
Variable next() const
Definition: factory.h:137
#define IDELEMS(i)
Definition: simpleideals.h:24
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2923
#define nDelete(n)
Definition: numbers.h:17
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:536
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define nIsZero(n)
Definition: numbers.h:20
#define NULL
Definition: omList.c:10
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:533
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
size_t gmp_output_digits
Definition: mpr_complex.cc:43
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...
Definition: mpr_complex.cc:61
virtual IStateType initState() const
Definition: mpr_base.h:41
int BOOLEAN
Definition: auxiliary.h:85
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5034
virtual number getSubDet()
Definition: mpr_base.h:37

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

4777 {
4778  int i;
4779  ideal p,w;
4780  p= (ideal)arg1->Data();
4781  w= (ideal)arg2->Data();
4782 
4783  // w[0] = f(p^0)
4784  // w[1] = f(p^1)
4785  // ...
4786  // p can be a vector of numbers (multivariate polynom)
4787  // or one number (univariate polynom)
4788  // tdg = deg(f)
4789 
4790  int n= IDELEMS( p );
4791  int m= IDELEMS( w );
4792  int tdg= (int)(long)arg3->Data();
4793 
4794  res->data= (void*)NULL;
4795 
4796  // check the input
4797  if ( tdg < 1 )
4798  {
4799  WerrorS("Last input parameter must be > 0!");
4800  return TRUE;
4801  }
4802  if ( n != rVar(currRing) )
4803  {
4804  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4805  return TRUE;
4806  }
4807  if ( m != (int)pow((double)tdg+1,(double)n) )
4808  {
4809  Werror("Size of second input ideal must be equal to %d!",
4810  (int)pow((double)tdg+1,(double)n));
4811  return TRUE;
4812  }
4813  if ( !(rField_is_Q(currRing) /* ||
4814  rField_is_R() || rField_is_long_R() ||
4815  rField_is_long_C()*/ ) )
4816  {
4817  WerrorS("Ground field not implemented!");
4818  return TRUE;
4819  }
4820 
4821  number tmp;
4822  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4823  for ( i= 0; i < n; i++ )
4824  {
4825  pevpoint[i]=nInit(0);
4826  if ( (p->m)[i] )
4827  {
4828  tmp = pGetCoeff( (p->m)[i] );
4829  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4830  {
4831  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4832  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4833  return TRUE;
4834  }
4835  } else tmp= NULL;
4836  if ( !nIsZero(tmp) )
4837  {
4838  if ( !pIsConstant((p->m)[i]))
4839  {
4840  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4841  WerrorS("Elements of first input ideal must be numbers!");
4842  return TRUE;
4843  }
4844  pevpoint[i]= nCopy( tmp );
4845  }
4846  }
4847 
4848  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4849  for ( i= 0; i < m; i++ )
4850  {
4851  wresults[i]= nInit(0);
4852  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4853  {
4854  if ( !pIsConstant((w->m)[i]))
4855  {
4856  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4857  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4858  WerrorS("Elements of second input ideal must be numbers!");
4859  return TRUE;
4860  }
4861  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4862  }
4863  }
4864 
4865  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4866  number *ncpoly= vm.interpolateDense( wresults );
4867  // do not free ncpoly[]!!
4868  poly rpoly= vm.numvec2poly( ncpoly );
4869 
4870  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4871  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4872 
4873  res->data= (void*)rpoly;
4874  return FALSE;
4875 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
#define TRUE
Definition: auxiliary.h:98
#define nIsOne(n)
Definition: numbers.h:26
void * ADDRESS
Definition: auxiliary.h:133
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define nIsMOne(n)
Definition: numbers.h:27
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:45
#define omAlloc(size)
Definition: omAllocDecl.h:210
CanonicalForm res
Definition: facAbsFact.cc:64
int m
Definition: cfEzgcd.cc:121
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:233
int i
Definition: cfEzgcd.cc:125
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:497
#define IDELEMS(i)
Definition: simpleideals.h:24
#define nIsZero(n)
Definition: numbers.h:20
#define NULL
Definition: omList.c:10
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define nCopy(n)
Definition: numbers.h:16
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
int p
Definition: cfModGcd.cc:4019
#define nInit(i)
Definition: numbers.h:25
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:414
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6316 of file ipshell.cc.

6317 {
6318  Print(" %s (",n);
6319  switch (p->language)
6320  {
6321  case LANG_SINGULAR: PrintS("S"); break;
6322  case LANG_C: PrintS("C"); break;
6323  case LANG_TOP: PrintS("T"); break;
6324  case LANG_MAX: PrintS("M"); break;
6325  case LANG_NONE: PrintS("N"); break;
6326  default: PrintS("U");
6327  }
6328  if(p->libname!=NULL)
6329  Print(",%s", p->libname);
6330  PrintS(")");
6331 }
#define Print
Definition: emacs.cc:80
Definition: subexpr.h:22
void PrintS(const char *s)
Definition: reporter.cc:284
#define NULL
Definition: omList.c:10
int p
Definition: cfModGcd.cc:4019

◆ rCompose()

ring rCompose ( const lists  L,
const BOOLEAN  check_comp,
const long  bitmask,
const int  isLetterplace 
)

Definition at line 2760 of file ipshell.cc.

2761 {
2762  if ((L->nr!=3)
2763 #ifdef HAVE_PLURAL
2764  &&(L->nr!=5)
2765 #endif
2766  )
2767  return NULL;
2768  int is_gf_char=0;
2769  // 0: char/ cf - ring
2770  // 1: list (var)
2771  // 2: list (ord)
2772  // 3: qideal
2773  // possibly:
2774  // 4: C
2775  // 5: D
2776 
2777  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2778 
2779  // ------------------------------------------------------------------
2780  // 0: char:
2781  if (L->m[0].Typ()==CRING_CMD)
2782  {
2783  R->cf=(coeffs)L->m[0].Data();
2784  R->cf->ref++;
2785  }
2786  else if (L->m[0].Typ()==INT_CMD)
2787  {
2788  int ch = (int)(long)L->m[0].Data();
2789  assume( ch >= 0 );
2790 
2791  if (ch == 0) // Q?
2792  R->cf = nInitChar(n_Q, NULL);
2793  else
2794  {
2795  int l = IsPrime(ch); // Zp?
2796  if( l != ch )
2797  {
2798  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2799  ch = l;
2800  }
2801  #ifndef TEST_ZN_AS_ZP
2802  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2803  #else
2804  mpz_t modBase;
2805  mpz_init_set_ui(modBase,(long) ch);
2806  ZnmInfo info;
2807  info.base= modBase;
2808  info.exp= 1;
2809  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2810  R->cf->is_field=1;
2811  R->cf->is_domain=1;
2812  R->cf->has_simple_Inverse=1;
2813  #endif
2814  }
2815  }
2816  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2817  {
2818  lists LL=(lists)L->m[0].Data();
2819 
2820 #ifdef HAVE_RINGS
2821  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2822  {
2823  rComposeRing(LL, R); // Ring!?
2824  }
2825  else
2826 #endif
2827  if (LL->nr < 3)
2828  rComposeC(LL,R); // R, long_R, long_C
2829  else
2830  {
2831  if (LL->m[0].Typ()==INT_CMD)
2832  {
2833  int ch = (int)(long)LL->m[0].Data();
2834  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2835  if (fftable[is_gf_char]==0) is_gf_char=-1;
2836 
2837  if(is_gf_char!= -1)
2838  {
2839  GFInfo param;
2840 
2841  param.GFChar = ch;
2842  param.GFDegree = 1;
2843  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2844 
2845  // nfInitChar should be able to handle the case when ch is in fftables!
2846  R->cf = nInitChar(n_GF, (void*)&param);
2847  }
2848  }
2849 
2850  if( R->cf == NULL )
2851  {
2852  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2853 
2854  if (extRing==NULL)
2855  {
2856  WerrorS("could not create the specified coefficient field");
2857  goto rCompose_err;
2858  }
2859 
2860  if( extRing->qideal != NULL ) // Algebraic extension
2861  {
2862  AlgExtInfo extParam;
2863 
2864  extParam.r = extRing;
2865 
2866  R->cf = nInitChar(n_algExt, (void*)&extParam);
2867  }
2868  else // Transcendental extension
2869  {
2870  TransExtInfo extParam;
2871  extParam.r = extRing;
2872  assume( extRing->qideal == NULL );
2873 
2874  R->cf = nInitChar(n_transExt, &extParam);
2875  }
2876  }
2877  }
2878  }
2879  else
2880  {
2881  WerrorS("coefficient field must be described by `int` or `list`");
2882  goto rCompose_err;
2883  }
2884 
2885  if( R->cf == NULL )
2886  {
2887  WerrorS("could not create coefficient field described by the input!");
2888  goto rCompose_err;
2889  }
2890 
2891  // ------------------------- VARS ---------------------------
2892  if (rComposeVar(L,R)) goto rCompose_err;
2893  // ------------------------ ORDER ------------------------------
2894  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2895 
2896  // ------------------------ ??????? --------------------
2897 
2898  if (!isLetterplace) rRenameVars(R);
2899  else R->isLPring=isLetterplace;
2900  if (bitmask!=0x7fff) R->bitmask=bitmask*2;
2901  rComplete(R);
2902 
2903  // ------------------------ Q-IDEAL ------------------------
2904 
2905  if (L->m[3].Typ()==IDEAL_CMD)
2906  {
2907  ideal q=(ideal)L->m[3].Data();
2908  if (q->m[0]!=NULL)
2909  {
2910  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2911  {
2912  #if 0
2913  WerrorS("coefficient fields must be equal if q-ideal !=0");
2914  goto rCompose_err;
2915  #else
2916  ring orig_ring=currRing;
2917  rChangeCurrRing(R);
2918  int *perm=NULL;
2919  int *par_perm=NULL;
2920  int par_perm_size=0;
2921  nMapFunc nMap;
2922 
2923  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2924  {
2925  if (rEqual(orig_ring,currRing))
2926  {
2927  nMap=n_SetMap(currRing->cf, currRing->cf);
2928  }
2929  else
2930  // Allow imap/fetch to be make an exception only for:
2931  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2935  ||
2936  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2937  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2938  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2939  {
2940  par_perm_size=rPar(orig_ring);
2941 
2942 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2943 // naSetChar(rInternalChar(orig_ring),orig_ring);
2944 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2945 
2946  nSetChar(currRing->cf);
2947  }
2948  else
2949  {
2950  WerrorS("coefficient fields must be equal if q-ideal !=0");
2951  goto rCompose_err;
2952  }
2953  }
2954  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2955  if (par_perm_size!=0)
2956  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2957  int i;
2958  #if 0
2959  // use imap:
2960  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2961  currRing->names,currRing->N,currRing->parameter, currRing->P,
2962  perm,par_perm, currRing->ch);
2963  #else
2964  // use fetch
2965  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2966  {
2967  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2968  }
2969  else if (par_perm_size!=0)
2970  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2971  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2972  #endif
2973  ideal dest_id=idInit(IDELEMS(q),1);
2974  for(i=IDELEMS(q)-1; i>=0; i--)
2975  {
2976  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2977  par_perm,par_perm_size);
2978  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2979  pTest(dest_id->m[i]);
2980  }
2981  R->qideal=dest_id;
2982  if (perm!=NULL)
2983  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2984  if (par_perm!=NULL)
2985  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2986  rChangeCurrRing(orig_ring);
2987  #endif
2988  }
2989  else
2990  R->qideal=idrCopyR(q,currRing,R);
2991  }
2992  }
2993  else
2994  {
2995  WerrorS("q-ideal must be given as `ideal`");
2996  goto rCompose_err;
2997  }
2998 
2999 
3000  // ---------------------------------------------------------------
3001  #ifdef HAVE_PLURAL
3002  if (L->nr==5)
3003  {
3004  if (nc_CallPlural((matrix)L->m[4].Data(),
3005  (matrix)L->m[5].Data(),
3006  NULL,NULL,
3007  R,
3008  true, // !!!
3009  true, false,
3010  currRing, FALSE)) goto rCompose_err;
3011  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3012  }
3013  #endif
3014  return R;
3015 
3016 rCompose_err:
3017  if (R->N>0)
3018  {
3019  int i;
3020  if (R->names!=NULL)
3021  {
3022  i=R->N-1;
3023  while (i>=0) { omfree(R->names[i]); i--; }
3024  omFree(R->names);
3025  }
3026  }
3027  omfree(R->order);
3028  omfree(R->block0);
3029  omfree(R->block1);
3030  omfree(R->wvhdl);
3031  omFree(R);
3032  return NULL;
3033 }
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:96
ring r
Definition: algext.h:37
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:520
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2449
Definition: lists.h:22
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:39
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
#define FALSE
Definition: auxiliary.h:94
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:589
#define pTest(p)
Definition: polys.h:409
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
\F{p < 2^31}
Definition: coeffs.h:30
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:530
void * ADDRESS
Definition: auxiliary.h:133
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:503
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1039
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2244
Creation data needed for finite fields.
Definition: coeffs.h:92
Definition: tok.h:56
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:4028
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2494
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:3369
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:390
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
const ExtensionInfo & info
< [in] sqrfree poly
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
#define omfree(addr)
Definition: omAllocDecl.h:237
omBin sip_sring_bin
Definition: ring.cc:44
const unsigned short fftable[]
Definition: ffields.cc:31
struct for passing initialization parameters to naInitChar
Definition: transext.h:88
int i
Definition: cfEzgcd.cc:125
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:497
int IsPrime(int p)
Definition: prime.cc:61
#define IDELEMS(i)
Definition: simpleideals.h:24
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1635
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:721
static void rRenameVars(ring R)
Definition: ipshell.cc:2408
void rChangeCurrRing(ring r)
Definition: polys.cc:15
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:491
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:94
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
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,...
Definition: old.gring.cc:2682
int nr
Definition: lists.h:43
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:165
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2315
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
\GF{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:36
#define R
Definition: sirandom.c:26
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
#define nSetMap(R)
Definition: numbers.h:44
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:192
static int rInternalChar(const ring r)
Definition: ring.h:679
Definition: tok.h:118
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2760
ip_smatrix * matrix
Definition: matpol.h:31
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:350
#define Warn
Definition: emacs.cc:77

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2244 of file ipshell.cc.

2246 {
2247  // ----------------------------------------
2248  // 0: char/ cf - ring
2249  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2250  {
2251  WerrorS("invalid coeff. field description, expecting 0");
2252  return;
2253  }
2254 // R->cf->ch=0;
2255  // ----------------------------------------
2256  // 1:
2257  if (L->m[1].rtyp!=LIST_CMD)
2258  {
2259  WerrorS("invalid coeff. field description, expecting precision list");
2260  return;
2261  }
2262  lists LL=(lists)L->m[1].data;
2263  if (((LL->nr!=2)
2264  || (LL->m[0].rtyp!=INT_CMD)
2265  || (LL->m[1].rtyp!=INT_CMD))
2266  && ((LL->nr!=1)
2267  || (LL->m[0].rtyp!=INT_CMD)))
2268  {
2269  WerrorS("invalid coeff. field description list");
2270  return;
2271  }
2272  int r1=(int)(long)LL->m[0].data;
2273  int r2=(int)(long)LL->m[1].data;
2274  if (L->nr==2) // complex
2275  R->cf = nInitChar(n_long_C, NULL);
2276  else if ((r1<=SHORT_REAL_LENGTH)
2277  && (r2=SHORT_REAL_LENGTH))
2278  R->cf = nInitChar(n_R, NULL);
2279  else
2280  {
2282  p->float_len=r1;
2283  p->float_len2=r2;
2284  R->cf = nInitChar(n_long_R, NULL);
2285  }
2286 
2287  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2288  && (r2=SHORT_REAL_LENGTH))
2289  {
2290  R->cf->float_len=SHORT_REAL_LENGTH/2;
2291  R->cf->float_len2=SHORT_REAL_LENGTH;
2292  }
2293  else
2294  {
2295  R->cf->float_len=si_min(r1,32767);
2296  R->cf->float_len2=si_min(r2,32767);
2297  }
2298  // ----------------------------------------
2299  // 2: list (par)
2300  if (L->nr==2)
2301  {
2302  //R->cf->extRing->N=1;
2303  if (L->m[2].rtyp!=STRING_CMD)
2304  {
2305  WerrorS("invalid coeff. field description, expecting parameter name");
2306  return;
2307  }
2308  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2309  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2310  }
2311  // ----------------------------------------
2312 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
#define SHORT_REAL_LENGTH
Definition: numbers.h:58
Definition: lists.h:22
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
void WerrorS(const char *s)
Definition: feFopen.cc:24
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:615
real floating point (GMP) numbers
Definition: coeffs.h:34
void * data
Definition: subexpr.h:88
single prescision (6,6) real numbers
Definition: coeffs.h:32
if(yy_init)
Definition: libparse.cc:1418
complex floating point (GMP) numbers
Definition: coeffs.h:42
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
int p
Definition: cfModGcd.cc:4019
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:350
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rComposeOrder()

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

Definition at line 2494 of file ipshell.cc.

2495 {
2496  assume(R!=NULL);
2497  long bitmask=0L;
2498  if (L->m[2].Typ()==LIST_CMD)
2499  {
2500  lists v=(lists)L->m[2].Data();
2501  int n= v->nr+2;
2502  int j_in_R,j_in_L;
2503  // do we have an entry "L",... ?: set bitmask
2504  for (int j=0; j < n-1; j++)
2505  {
2506  if (v->m[j].Typ()==LIST_CMD)
2507  {
2508  lists vv=(lists)v->m[j].Data();
2509  if ((vv->nr==1)
2510  &&(vv->m[0].Typ()==STRING_CMD)
2511  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2512  {
2513  number nn=(number)vv->m[1].Data();
2514  if (vv->m[1].Typ()==BIGINT_CMD)
2515  bitmask=n_Int(nn,coeffs_BIGINT);
2516  else if (vv->m[1].Typ()==INT_CMD)
2517  bitmask=(long)nn;
2518  else
2519  {
2520  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2521  return TRUE;
2522  }
2523  break;
2524  }
2525  }
2526  }
2527  if (bitmask!=0) n--;
2528 
2529  // initialize fields of R
2530  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
2531  R->block0=(int *)omAlloc0(n*sizeof(int));
2532  R->block1=(int *)omAlloc0(n*sizeof(int));
2533  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2534  // init order, so that rBlocks works correctly
2535  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2536  R->order[j_in_R] = ringorder_unspec;
2537  // orderings
2538  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2539  {
2540  // todo: a(..), M
2541  if (v->m[j_in_L].Typ()!=LIST_CMD)
2542  {
2543  WerrorS("ordering must be list of lists");
2544  return TRUE;
2545  }
2546  lists vv=(lists)v->m[j_in_L].Data();
2547  if ((vv->nr==1)
2548  && (vv->m[0].Typ()==STRING_CMD))
2549  {
2550  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2551  {
2552  j_in_R--;
2553  continue;
2554  }
2555  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD))
2556  {
2557  PrintS(lString(vv));
2558  WerrorS("ordering name must be a (string,intvec)(1)");
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  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2586  else
2587  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2588  int iv_len=iv->length();
2589  if ((R->order[j_in_R]!=ringorder_s)
2590  &&(R->order[j_in_R]!=ringorder_c)
2591  &&(R->order[j_in_R]!=ringorder_C))
2592  {
2593  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2594  if (R->block1[j_in_R]>R->N)
2595  {
2596  if (R->block0[j_in_R]>R->N)
2597  {
2598  Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
2599  return TRUE;
2600  }
2601  R->block1[j_in_R]=R->N;
2602  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2603  }
2604  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2605  }
2606  int i;
2607  switch (R->order[j_in_R])
2608  {
2609  case ringorder_ws:
2610  case ringorder_Ws:
2611  R->OrdSgn=-1;
2612  case ringorder_aa:
2613  case ringorder_a:
2614  case ringorder_wp:
2615  case ringorder_Wp:
2616  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2617  for (i=0; i<iv_len;i++)
2618  {
2619  R->wvhdl[j_in_R][i]=(*iv)[i];
2620  }
2621  break;
2622  case ringorder_am:
2623  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2624  for (i=0; i<iv_len;i++)
2625  {
2626  R->wvhdl[j_in_R][i]=(*iv)[i];
2627  }
2628  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2629  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2630  for (; i<iv->length(); i++)
2631  {
2632  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2633  }
2634  break;
2635  case ringorder_M:
2636  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2637  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2638  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length()-1)));
2639  if (R->block1[j_in_R]>R->N)
2640  {
2641  WerrorS("ordering matrix too big");
2642  return TRUE;
2643  }
2644  break;
2645  case ringorder_ls:
2646  case ringorder_ds:
2647  case ringorder_Ds:
2648  case ringorder_rs:
2649  R->OrdSgn=-1;
2650  case ringorder_lp:
2651  case ringorder_dp:
2652  case ringorder_Dp:
2653  case ringorder_rp:
2654  break;
2655  case ringorder_S:
2656  break;
2657  case ringorder_c:
2658  case ringorder_C:
2659  R->block1[j_in_R]=R->block0[j_in_R]=0;
2660  break;
2661 
2662  case ringorder_s:
2663  R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2664  rSetSyzComp(R->block0[j_in_R],R);
2665  break;
2666 
2667  case ringorder_IS:
2668  {
2669  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2670  if( iv->length() > 0 )
2671  {
2672  const int s = (*iv)[0];
2673  assume( -2 < s && s < 2 );
2674  R->block1[j_in_R] = R->block0[j_in_R] = s;
2675  }
2676  break;
2677  }
2678  case 0:
2679  case ringorder_unspec:
2680  break;
2681  case ringorder_L: /* cannot happen */
2682  case ringorder_a64: /*not implemented */
2683  WerrorS("ring order not implemented");
2684  return TRUE;
2685  }
2686  delete iv;
2687  }
2688  else
2689  {
2690  PrintS(lString(vv));
2691  WerrorS("ordering name must be a (string,intvec)");
2692  return TRUE;
2693  }
2694  }
2695  // sanity check
2696  j_in_R=n-2;
2697  if ((R->order[j_in_R]==ringorder_c)
2698  || (R->order[j_in_R]==ringorder_C)
2699  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2700  if (R->block1[j_in_R] != R->N)
2701  {
2702  if (((R->order[j_in_R]==ringorder_dp) ||
2703  (R->order[j_in_R]==ringorder_ds) ||
2704  (R->order[j_in_R]==ringorder_Dp) ||
2705  (R->order[j_in_R]==ringorder_Ds) ||
2706  (R->order[j_in_R]==ringorder_rp) ||
2707  (R->order[j_in_R]==ringorder_rs) ||
2708  (R->order[j_in_R]==ringorder_lp) ||
2709  (R->order[j_in_R]==ringorder_ls))
2710  &&
2711  R->block0[j_in_R] <= R->N)
2712  {
2713  R->block1[j_in_R] = R->N;
2714  }
2715  else
2716  {
2717  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2718  return TRUE;
2719  }
2720  }
2721  if (R->block0[j_in_R]>R->N)
2722  {
2723  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2724  for(int ii=0;ii<=j_in_R;ii++)
2725  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2726  return TRUE;
2727  }
2728  if (check_comp)
2729  {
2730  BOOLEAN comp_order=FALSE;
2731  int jj;
2732  for(jj=0;jj<n;jj++)
2733  {
2734  if ((R->order[jj]==ringorder_c) ||
2735  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2736  }
2737  if (!comp_order)
2738  {
2739  R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2740  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2741  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2742  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2743  R->order[n-1]=ringorder_C;
2744  R->block0[n-1]=0;
2745  R->block1[n-1]=0;
2746  R->wvhdl[n-1]=NULL;
2747  n++;
2748  }
2749  }
2750  }
2751  else
2752  {
2753  WerrorS("ordering must be given as `list`");
2754  return TRUE;
2755  }
2756  if (bitmask!=0) R->bitmask=bitmask*2;
2757  return FALSE;
2758 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:92
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
for int64 weights
Definition: ring.h:72
Definition: tok.h:96
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:38
opposite of ls
Definition: ring.h:93
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:380
coeffs coeffs_BIGINT
Definition: ipid.cc:52
int Typ()
Definition: subexpr.cc:1039
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: intvec.h:17
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:547
#define assume(x)
Definition: mod2.h:390
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
rRingOrder_t
order stuff
Definition: ring.h:68
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:328
static int si_max(const int a, const int b)
Definition: auxiliary.h:138
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:94
void PrintS(const char *s)
Definition: reporter.cc:284
S?
Definition: ring.h:76
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:4991
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int length() const
Definition: intvec.h:92
#define R
Definition: sirandom.c:26
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
rRingOrder_t rOrderName(char *ordername)
Definition: ring.cc:497
int * int_ptr
Definition: structs.h:57
int BOOLEAN
Definition: auxiliary.h:85
s?
Definition: ring.h:77
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2315 of file ipshell.cc.

2317 {
2318  // ----------------------------------------
2319  // 0: string: integer
2320  // no further entries --> Z
2321  mpz_t modBase;
2322  unsigned int modExponent = 1;
2323 
2324  if (L->nr == 0)
2325  {
2326  mpz_init_set_ui(modBase,0);
2327  modExponent = 1;
2328  }
2329  // ----------------------------------------
2330  // 1:
2331  else
2332  {
2333  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2334  lists LL=(lists)L->m[1].data;
2335  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2336  {
2337  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2338  // assume that tmp is integer, not rational
2339  mpz_init(modBase);
2340  n_MPZ (modBase, tmp, coeffs_BIGINT);
2341  }
2342  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2343  {
2344  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2345  }
2346  else
2347  {
2348  mpz_init_set_ui(modBase,0);
2349  }
2350  if (LL->nr >= 1)
2351  {
2352  modExponent = (unsigned long) LL->m[1].data;
2353  }
2354  else
2355  {
2356  modExponent = 1;
2357  }
2358  }
2359  // ----------------------------------------
2360  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
2361  {
2362  WerrorS("Wrong ground ring specification (module is 1)");
2363  return;
2364  }
2365  if (modExponent < 1)
2366  {
2367  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2368  return;
2369  }
2370  // module is 0 ---> integers
2371  if (mpz_sgn1(modBase) == 0)
2372  {
2373  R->cf=nInitChar(n_Z,NULL);
2374  }
2375  // we have an exponent
2376  else if (modExponent > 1)
2377  {
2378  //R->cf->ch = R->cf->modExponent;
2379  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2380  {
2381  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2382  depending on the size of a long on the respective platform */
2383  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2384  }
2385  else
2386  {
2387  //ringtype 3
2388  ZnmInfo info;
2389  info.base= modBase;
2390  info.exp= modExponent;
2391  R->cf=nInitChar(n_Znm,(void*) &info);
2392  }
2393  }
2394  // just a module m > 1
2395  else
2396  {
2397  //ringtype = 2;
2398  //const int ch = mpz_get_ui(modBase);
2399  ZnmInfo info;
2400  info.base= modBase;
2401  info.exp= modExponent;
2402  R->cf=nInitChar(n_Zn,(void*) &info);
2403  }
2404  mpz_clear(modBase);
2405 }
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:96
#define mpz_sgn1(A)
Definition: si_gmp.h:13
Definition: lists.h:22
only used if HAVE_RINGS is defined
Definition: coeffs.h:47
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:52
void * data
Definition: subexpr.h:88
if(yy_init)
Definition: libparse.cc:1418
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
const ExtensionInfo & info
< [in] sqrfree poly
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
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:551
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:350

◆ rComposeVar()

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

Definition at line 2449 of file ipshell.cc.

2450 {
2451  assume(R!=NULL);
2452  if (L->m[1].Typ()==LIST_CMD)
2453  {
2454  lists v=(lists)L->m[1].Data();
2455  R->N = v->nr+1;
2456  if (R->N<=0)
2457  {
2458  WerrorS("no ring variables");
2459  return TRUE;
2460  }
2461  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2462  int i;
2463  for(i=0;i<R->N;i++)
2464  {
2465  if (v->m[i].Typ()==STRING_CMD)
2466  R->names[i]=omStrDup((char *)v->m[i].Data());
2467  else if (v->m[i].Typ()==POLY_CMD)
2468  {
2469  poly p=(poly)v->m[i].Data();
2470  int nr=pIsPurePower(p);
2471  if (nr>0)
2472  R->names[i]=omStrDup(currRing->names[nr-1]);
2473  else
2474  {
2475  Werror("var name %d must be a string or a ring variable",i+1);
2476  return TRUE;
2477  }
2478  }
2479  else
2480  {
2481  Werror("var name %d must be `string`",i+1);
2482  return TRUE;
2483  }
2484  }
2485  }
2486  else
2487  {
2488  WerrorS("variable must be given as `list`");
2489  return TRUE;
2490  }
2491  return FALSE;
2492 }
#define pIsPurePower(p)
Definition: polys.h:243
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1039
char * char_ptr
Definition: structs.h:56
#define assume(x)
Definition: mod2.h:390
int i
Definition: cfEzgcd.cc:125
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
int p
Definition: cfModGcd.cc:4019
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2058 of file ipshell.cc.

2059 {
2060  assume( r != NULL );
2061  const coeffs C = r->cf;
2062  assume( C != NULL );
2063 
2064  // sanity check: require currRing==r for rings with polynomial data
2065  if ( (r!=currRing) && (
2066  (nCoeff_is_algExt(C) && (C != currRing->cf))
2067  || (r->qideal != NULL)
2068 #ifdef HAVE_PLURAL
2069  || (rIsPluralRing(r))
2070 #endif
2071  )
2072  )
2073  {
2074  WerrorS("ring with polynomial data must be the base ring or compatible");
2075  return NULL;
2076  }
2077  // 0: char/ cf - ring
2078  // 1: list (var)
2079  // 2: list (ord)
2080  // 3: qideal
2081  // possibly:
2082  // 4: C
2083  // 5: D
2085  if (rIsPluralRing(r))
2086  L->Init(6);
2087  else
2088  L->Init(4);
2089  // ----------------------------------------
2090  // 0: char/ cf - ring
2091  if (rField_is_numeric(r))
2092  {
2093  rDecomposeC(&(L->m[0]),r);
2094  }
2095  else if (rField_is_Ring(r))
2096  {
2097  rDecomposeRing(&(L->m[0]),r);
2098  }
2099  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2100  {
2101  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2102  }
2103  else if(rField_is_GF(r))
2104  {
2106  Lc->Init(4);
2107  // char:
2108  Lc->m[0].rtyp=INT_CMD;
2109  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2110  // var:
2112  Lv->Init(1);
2113  Lv->m[0].rtyp=STRING_CMD;
2114  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2115  Lc->m[1].rtyp=LIST_CMD;
2116  Lc->m[1].data=(void*)Lv;
2117  // ord:
2119  Lo->Init(1);
2121  Loo->Init(2);
2122  Loo->m[0].rtyp=STRING_CMD;
2123  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2124 
2125  intvec *iv=new intvec(1); (*iv)[0]=1;
2126  Loo->m[1].rtyp=INTVEC_CMD;
2127  Loo->m[1].data=(void *)iv;
2128 
2129  Lo->m[0].rtyp=LIST_CMD;
2130  Lo->m[0].data=(void*)Loo;
2131 
2132  Lc->m[2].rtyp=LIST_CMD;
2133  Lc->m[2].data=(void*)Lo;
2134  // q-ideal:
2135  Lc->m[3].rtyp=IDEAL_CMD;
2136  Lc->m[3].data=(void *)idInit(1,1);
2137  // ----------------------
2138  L->m[0].rtyp=LIST_CMD;
2139  L->m[0].data=(void*)Lc;
2140  }
2141  else
2142  {
2143  L->m[0].rtyp=INT_CMD;
2144  L->m[0].data=(void *)(long)r->cf->ch;
2145  }
2146  // ----------------------------------------
2147  // 1: list (var)
2149  LL->Init(r->N);
2150  int i;
2151  for(i=0; i<r->N; i++)
2152  {
2153  LL->m[i].rtyp=STRING_CMD;
2154  LL->m[i].data=(void *)omStrDup(r->names[i]);
2155  }
2156  L->m[1].rtyp=LIST_CMD;
2157  L->m[1].data=(void *)LL;
2158  // ----------------------------------------
2159  // 2: list (ord)
2161  i=rBlocks(r)-1;
2162  LL->Init(i);
2163  i--;
2164  lists LLL;
2165  for(; i>=0; i--)
2166  {
2167  intvec *iv;
2168  int j;
2169  LL->m[i].rtyp=LIST_CMD;
2171  LLL->Init(2);
2172  LLL->m[0].rtyp=STRING_CMD;
2173  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2174 
2175  if((r->order[i] == ringorder_IS)
2176  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2177  {
2178  assume( r->block0[i] == r->block1[i] );
2179  const int s = r->block0[i];
2180  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2181 
2182  iv=new intvec(1);
2183  (*iv)[0] = s;
2184  }
2185  else if (r->block1[i]-r->block0[i] >=0 )
2186  {
2187  int bl=j=r->block1[i]-r->block0[i];
2188  if (r->order[i]==ringorder_M)
2189  {
2190  j=(j+1)*(j+1)-1;
2191  bl=j+1;
2192  }
2193  else if (r->order[i]==ringorder_am)
2194  {
2195  j+=r->wvhdl[i][bl+1];
2196  }
2197  iv=new intvec(j+1);
2198  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2199  {
2200  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2201  }
2202  else switch (r->order[i])
2203  {
2204  case ringorder_dp:
2205  case ringorder_Dp:
2206  case ringorder_ds:
2207  case ringorder_Ds:
2208  case ringorder_lp:
2209  for(;j>=0; j--) (*iv)[j]=1;
2210  break;
2211  default: /* do nothing */;
2212  }
2213  }
2214  else
2215  {
2216  iv=new intvec(1);
2217  }
2218  LLL->m[1].rtyp=INTVEC_CMD;
2219  LLL->m[1].data=(void *)iv;
2220  LL->m[i].data=(void *)LLL;
2221  }
2222  L->m[2].rtyp=LIST_CMD;
2223  L->m[2].data=(void *)LL;
2224  // ----------------------------------------
2225  // 3: qideal
2226  L->m[3].rtyp=IDEAL_CMD;
2227  if (r->qideal==NULL)
2228  L->m[3].data=(void *)idInit(1,1);
2229  else
2230  L->m[3].data=(void *)idCopy(r->qideal);
2231  // ----------------------------------------
2232 #ifdef HAVE_PLURAL // NC! in rDecompose
2233  if (rIsPluralRing(r))
2234  {
2235  L->m[4].rtyp=MATRIX_CMD;
2236  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2237  L->m[5].rtyp=MATRIX_CMD;
2238  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2239  }
2240 #endif
2241  return L;
2242 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
Definition: tok.h:96
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:512
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:615
CanonicalForm Lc(const CanonicalForm &f)
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1638
static int rBlocks(ring r)
Definition: ring.h:558
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:932
Definition: intvec.h:17
#define assume(x)
Definition: mod2.h:390
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:398
The main handler for Singular numbers which are suitable for Singular polynomials.
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1760
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:94
ideal idCopy(ideal A)
Definition: ideals.h:60
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1824
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:475
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
omBin slists_bin
Definition: lists.cc:23
s?
Definition: ring.h:77
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:506
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1856 of file ipshell.cc.

1857 {
1858  assume( C != NULL );
1859 
1860  // sanity check: require currRing==r for rings with polynomial data
1861  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1862  {
1863  WerrorS("ring with polynomial data must be the base ring or compatible");
1864  return TRUE;
1865  }
1866  if (nCoeff_is_numeric(C))
1867  {
1868  rDecomposeC_41(res,C);
1869  }
1870 #ifdef HAVE_RINGS
1871  else if (nCoeff_is_Ring(C))
1872  {
1874  }
1875 #endif
1876  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1877  {
1878  rDecomposeCF(res, C->extRing, currRing);
1879  }
1880  else if(nCoeff_is_GF(C))
1881  {
1883  Lc->Init(4);
1884  // char:
1885  Lc->m[0].rtyp=INT_CMD;
1886  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1887  // var:
1889  Lv->Init(1);
1890  Lv->m[0].rtyp=STRING_CMD;
1891  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1892  Lc->m[1].rtyp=LIST_CMD;
1893  Lc->m[1].data=(void*)Lv;
1894  // ord:
1896  Lo->Init(1);
1898  Loo->Init(2);
1899  Loo->m[0].rtyp=STRING_CMD;
1900  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1901 
1902  intvec *iv=new intvec(1); (*iv)[0]=1;
1903  Loo->m[1].rtyp=INTVEC_CMD;
1904  Loo->m[1].data=(void *)iv;
1905 
1906  Lo->m[0].rtyp=LIST_CMD;
1907  Lo->m[0].data=(void*)Loo;
1908 
1909  Lc->m[2].rtyp=LIST_CMD;
1910  Lc->m[2].data=(void*)Lo;
1911  // q-ideal:
1912  Lc->m[3].rtyp=IDEAL_CMD;
1913  Lc->m[3].data=(void *)idInit(1,1);
1914  // ----------------------
1915  res->rtyp=LIST_CMD;
1916  res->data=(void*)Lc;
1917  }
1918  else
1919  {
1920  res->rtyp=INT_CMD;
1921  res->data=(void *)(long)C->ch;
1922  }
1923  // ----------------------------------------
1924  return FALSE;
1925 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:800
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:854
Definition: tok.h:96
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:752
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1796
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1638
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:932
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
#define assume(x)
Definition: mod2.h:390
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:861
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1726
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1927 of file ipshell.cc.

1928 {
1929  assume( r != NULL );
1930  const coeffs C = r->cf;
1931  assume( C != NULL );
1932 
1933  // sanity check: require currRing==r for rings with polynomial data
1934  if ( (r!=currRing) && (
1935  (r->qideal != NULL)
1936 #ifdef HAVE_PLURAL
1937  || (rIsPluralRing(r))
1938 #endif
1939  )
1940  )
1941  {
1942  WerrorS("ring with polynomial data must be the base ring or compatible");
1943  return NULL;
1944  }
1945  // 0: char/ cf - ring
1946  // 1: list (var)
1947  // 2: list (ord)
1948  // 3: qideal
1949  // possibly:
1950  // 4: C
1951  // 5: D
1953  if (rIsPluralRing(r))
1954  L->Init(6);
1955  else
1956  L->Init(4);
1957  // ----------------------------------------
1958  // 0: char/ cf - ring
1959  L->m[0].rtyp=CRING_CMD;
1960  L->m[0].data=(char*)r->cf; r->cf->ref++;
1961  // ----------------------------------------
1962  // 1: list (var)
1964  LL->Init(r->N);
1965  int i;
1966  for(i=0; i<r->N; i++)
1967  {
1968  LL->m[i].rtyp=STRING_CMD;
1969  LL->m[i].data=(void *)omStrDup(r->names[i]);
1970  }
1971  L->m[1].rtyp=LIST_CMD;
1972  L->m[1].data=(void *)LL;
1973  // ----------------------------------------
1974  // 2: list (ord)
1976  i=rBlocks(r)-1;
1977  LL->Init(i);
1978  i--;
1979  lists LLL;
1980  for(; i>=0; i--)
1981  {
1982  intvec *iv;
1983  int j;
1984  LL->m[i].rtyp=LIST_CMD;
1986  LLL->Init(2);
1987  LLL->m[0].rtyp=STRING_CMD;
1988  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1989 
1990  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1991  {
1992  assume( r->block0[i] == r->block1[i] );
1993  const int s = r->block0[i];
1994  assume( -2 < s && s < 2);
1995 
1996  iv=new intvec(1);
1997  (*iv)[0] = s;
1998  }
1999  else if (r->block1[i]-r->block0[i] >=0 )
2000  {
2001  int bl=j=r->block1[i]-r->block0[i];
2002  if (r->order[i]==ringorder_M)
2003  {
2004  j=(j+1)*(j+1)-1;
2005  bl=j+1;
2006  }
2007  else if (r->order[i]==ringorder_am)
2008  {
2009  j+=r->wvhdl[i][bl+1];
2010  }
2011  iv=new intvec(j+1);
2012  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2013  {
2014  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2015  }
2016  else switch (r->order[i])
2017  {
2018  case ringorder_dp:
2019  case ringorder_Dp:
2020  case ringorder_ds:
2021  case ringorder_Ds:
2022  case ringorder_lp:
2023  for(;j>=0; j--) (*iv)[j]=1;
2024  break;
2025  default: /* do nothing */;
2026  }
2027  }
2028  else
2029  {
2030  iv=new intvec(1);
2031  }
2032  LLL->m[1].rtyp=INTVEC_CMD;
2033  LLL->m[1].data=(void *)iv;
2034  LL->m[i].data=(void *)LLL;
2035  }
2036  L->m[2].rtyp=LIST_CMD;
2037  L->m[2].data=(void *)LL;
2038  // ----------------------------------------
2039  // 3: qideal
2040  L->m[3].rtyp=IDEAL_CMD;
2041  if (r->qideal==NULL)
2042  L->m[3].data=(void *)idInit(1,1);
2043  else
2044  L->m[3].data=(void *)idCopy(r->qideal);
2045  // ----------------------------------------
2046 #ifdef HAVE_PLURAL // NC! in rDecompose
2047  if (rIsPluralRing(r))
2048  {
2049  L->m[4].rtyp=MATRIX_CMD;
2050  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2051  L->m[5].rtyp=MATRIX_CMD;
2052  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2053  }
2054 #endif
2055  return L;
2056 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
static int rBlocks(ring r)
Definition: ring.h:558
Definition: tok.h:56
Definition: intvec.h:17
#define assume(x)
Definition: mod2.h:390
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:398
The main handler for Singular numbers which are suitable for Singular polynomials.
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:94
ideal idCopy(ideal A)
Definition: ideals.h:60
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeC()

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

Definition at line 1760 of file ipshell.cc.

1762 {
1764  if (rField_is_long_C(R)) L->Init(3);
1765  else L->Init(2);
1766  h->rtyp=LIST_CMD;
1767  h->data=(void *)L;
1768  // 0: char/ cf - ring
1769  // 1: list (var)
1770  // 2: list (ord)
1771  // ----------------------------------------
1772  // 0: char/ cf - ring
1773  L->m[0].rtyp=INT_CMD;
1774  L->m[0].data=(void *)0;
1775  // ----------------------------------------
1776  // 1:
1778  LL->Init(2);
1779  LL->m[0].rtyp=INT_CMD;
1780  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1781  LL->m[1].rtyp=INT_CMD;
1782  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1783  L->m[1].rtyp=LIST_CMD;
1784  L->m[1].data=(void *)LL;
1785  // ----------------------------------------
1786  // 2: list (par)
1787  if (rField_is_long_C(R))
1788  {
1789  L->m[2].rtyp=STRING_CMD;
1790  L->m[2].data=(void *)omStrDup(*rParameter(R));
1791  }
1792  // ----------------------------------------
1793 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
#define SHORT_REAL_LENGTH
Definition: numbers.h:58
Definition: lists.h:22
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:615
void * data
Definition: subexpr.h:88
static int si_max(const int a, const int b)
Definition: auxiliary.h:138
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:536
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:972
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeC_41()

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

Definition at line 1726 of file ipshell.cc.

1728 {
1730  if (nCoeff_is_long_C(C)) L->Init(3);
1731  else L->Init(2);
1732  h->rtyp=LIST_CMD;
1733  h->data=(void *)L;
1734  // 0: char/ cf - ring
1735  // 1: list (var)
1736  // 2: list (ord)
1737  // ----------------------------------------
1738  // 0: char/ cf - ring
1739  L->m[0].rtyp=INT_CMD;
1740  L->m[0].data=(void *)0;
1741  // ----------------------------------------
1742  // 1:
1744  LL->Init(2);
1745  LL->m[0].rtyp=INT_CMD;
1746  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1747  LL->m[1].rtyp=INT_CMD;
1748  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1749  L->m[1].rtyp=LIST_CMD;
1750  L->m[1].data=(void *)LL;
1751  // ----------------------------------------
1752  // 2: list (par)
1753  if (nCoeff_is_long_C(C))
1754  {
1755  L->m[2].rtyp=STRING_CMD;
1756  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1757  }
1758  // ----------------------------------------
1759 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:800
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
#define SHORT_REAL_LENGTH
Definition: numbers.h:58
Definition: lists.h:22
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:916
void * data
Definition: subexpr.h:88
static int si_max(const int a, const int b)
Definition: auxiliary.h:138
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:972
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeCF()

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

Definition at line 1638 of file ipshell.cc.

1639 {
1641  L->Init(4);
1642  h->rtyp=LIST_CMD;
1643  h->data=(void *)L;
1644  // 0: char/ cf - ring
1645  // 1: list (var)
1646  // 2: list (ord)
1647  // 3: qideal
1648  // ----------------------------------------
1649  // 0: char/ cf - ring
1650  L->m[0].rtyp=INT_CMD;
1651  L->m[0].data=(void *)(long)r->cf->ch;
1652  // ----------------------------------------
1653  // 1: list (var)
1655  LL->Init(r->N);
1656  int i;
1657  for(i=0; i<r->N; i++)
1658  {
1659  LL->m[i].rtyp=STRING_CMD;
1660  LL->m[i].data=(void *)omStrDup(r->names[i]);
1661  }
1662  L->m[1].rtyp=LIST_CMD;
1663  L->m[1].data=(void *)LL;
1664  // ----------------------------------------
1665  // 2: list (ord)
1667  i=rBlocks(r)-1;
1668  LL->Init(i);
1669  i--;
1670  lists LLL;
1671  for(; i>=0; i--)
1672  {
1673  intvec *iv;
1674  int j;
1675  LL->m[i].rtyp=LIST_CMD;
1677  LLL->Init(2);
1678  LLL->m[0].rtyp=STRING_CMD;
1679  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1680  if (r->block1[i]-r->block0[i] >=0 )
1681  {
1682  j=r->block1[i]-r->block0[i];
1683  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1684  iv=new intvec(j+1);
1685  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1686  {
1687  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1688  }
1689  else switch (r->order[i])
1690  {
1691  case ringorder_dp:
1692  case ringorder_Dp:
1693  case ringorder_ds:
1694  case ringorder_Ds:
1695  case ringorder_lp:
1696  for(;j>=0; j--) (*iv)[j]=1;
1697  break;
1698  default: /* do nothing */;
1699  }
1700  }
1701  else
1702  {
1703  iv=new intvec(1);
1704  }
1705  LLL->m[1].rtyp=INTVEC_CMD;
1706  LLL->m[1].data=(void *)iv;
1707  LL->m[i].data=(void *)LLL;
1708  }
1709  L->m[2].rtyp=LIST_CMD;
1710  L->m[2].data=(void *)LL;
1711  // ----------------------------------------
1712  // 3: qideal
1713  L->m[3].rtyp=IDEAL_CMD;
1714  if (nCoeff_is_transExt(R->cf))
1715  L->m[3].data=(void *)idInit(1,1);
1716  else
1717  {
1718  ideal q=idInit(IDELEMS(r->qideal));
1719  q->m[0]=p_Init(R);
1720  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1721  L->m[3].data=(void *)q;
1722 // I->m[0] = pNSet(R->minpoly);
1723  }
1724  // ----------------------------------------
1725 }
sleftv * m
Definition: lists.h:45
int j
Definition: facHensel.cc:105
Definition: tok.h:96
Definition: lists.h:22
void * data
Definition: subexpr.h:88
static int rBlocks(ring r)
Definition: ring.h:558
Definition: intvec.h:17
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:940
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:24
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h:91
#define pSetCoeff0(p, n)
Definition: monomials.h:60
Definition: tok.h:118
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:972
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1257
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1824 of file ipshell.cc.

1826 {
1827 #ifdef HAVE_RINGS
1829  if (rField_is_Z(R)) L->Init(1);
1830  else L->Init(2);
1831  h->rtyp=LIST_CMD;
1832  h->data=(void *)L;
1833  // 0: char/ cf - ring
1834  // 1: list (module)
1835  // ----------------------------------------
1836  // 0: char/ cf - ring
1837  L->m[0].rtyp=STRING_CMD;
1838  L->m[0].data=(void *)omStrDup("integer");
1839  // ----------------------------------------
1840  // 1: module
1841  if (rField_is_Z(R)) return;
1843  LL->Init(2);
1844  LL->m[0].rtyp=BIGINT_CMD;
1845  LL->m[0].data=nlMapGMP((number) R->cf->modBase, R->cf, R->cf); // TODO: what is this?? // extern number nlMapGMP(number from, const coeffs src, const coeffs dst); // FIXME: replace with n_InitMPZ(R->cf->modBase, coeffs_BIGINT); ?
1846  LL->m[1].rtyp=INT_CMD;
1847  LL->m[1].data=(void *) R->cf->modExponent;
1848  L->m[1].rtyp=LIST_CMD;
1849  L->m[1].data=(void *)LL;
1850 #else
1851  WerrorS("rDecomposeRing");
1852 #endif
1853 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
Definition: lists.h:22
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:500
void * data
Definition: subexpr.h:88
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
#define R
Definition: sirandom.c:26
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:201
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:972
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1796 of file ipshell.cc.

1798 {
1800  if (nCoeff_is_Ring(C)) L->Init(1);
1801  else L->Init(2);
1802  h->rtyp=LIST_CMD;
1803  h->data=(void *)L;
1804  // 0: char/ cf - ring
1805  // 1: list (module)
1806  // ----------------------------------------
1807  // 0: char/ cf - ring
1808  L->m[0].rtyp=STRING_CMD;
1809  L->m[0].data=(void *)omStrDup("integer");
1810  // ----------------------------------------
1811  // 1: modulo
1812  if (nCoeff_is_Z(C)) return;
1814  LL->Init(2);
1815  LL->m[0].rtyp=BIGINT_CMD;
1816  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1817  LL->m[1].rtyp=INT_CMD;
1818  LL->m[1].data=(void *) C->modExponent;
1819  L->m[1].rtyp=LIST_CMD;
1820  L->m[1].data=(void *)LL;
1821 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:96
Definition: lists.h:22
Definition: tok.h:38
coeffs coeffs_BIGINT
Definition: ipid.cc:52
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:838
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:752
void * data
Definition: subexpr.h:88
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:201
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:972
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1555 of file ipshell.cc.

1556 {
1557  idhdl tmp=NULL;
1558 
1559  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1560  if (tmp==NULL) return NULL;
1561 
1562 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1564  {
1566  memset(&sLastPrinted,0,sizeof(sleftv));
1567  }
1568 
1569  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1570 
1571  #ifndef TEST_ZN_AS_ZP
1572  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1573  #else
1574  mpz_t modBase;
1575  mpz_init_set_ui(modBase, (long)32003);
1576  ZnmInfo info;
1577  info.base= modBase;
1578  info.exp= 1;
1579  r->cf=nInitChar(n_Zn,(void*) &info);
1580  r->cf->is_field=1;
1581  r->cf->is_domain=1;
1582  r->cf->has_simple_Inverse=1;
1583  #endif
1584  r->N = 3;
1585  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1586  /*names*/
1587  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1588  r->names[0] = omStrDup("x");
1589  r->names[1] = omStrDup("y");
1590  r->names[2] = omStrDup("z");
1591  /*weights: entries for 3 blocks: NULL*/
1592  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1593  /*order: dp,C,0*/
1594  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1595  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1596  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1597  /* ringorder dp for the first block: var 1..3 */
1598  r->order[0] = ringorder_dp;
1599  r->block0[0] = 1;
1600  r->block1[0] = 3;
1601  /* ringorder C for the second block: no vars */
1602  r->order[1] = ringorder_C;
1603  /* the last block: everything is 0 */
1604  r->order[2] = (rRingOrder_t)0;
1605 
1606  /* complete ring intializations */
1607  rComplete(r);
1608  rSetHdl(tmp);
1609  return currRingHdl;
1610 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
\F{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:18
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
char * char_ptr
Definition: structs.h:56
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:267
BOOLEAN RingDependend()
Definition: subexpr.cc:424
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:3369
const ExtensionInfo & info
< [in] sqrfree poly
rRingOrder_t
order stuff
Definition: ring.h:68
idhdl currRingHdl
Definition: ipid.cc:61
omBin sip_sring_bin
Definition: ring.cc:44
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:122
sleftv sLastPrinted
Definition: subexpr.cc:52
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
void rSetHdl(idhdl h)
Definition: ipshell.cc:5081
int * int_ptr
Definition: structs.h:57
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:350
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1612 of file ipshell.cc.

1613 {
1615  if (h!=NULL) return h;
1616  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1617  if (h!=NULL) return h;
1619  while(p!=NULL)
1620  {
1621  if ((p->cPack!=basePack)
1622  && (p->cPack!=currPack))
1623  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1624  if (h!=NULL) return h;
1625  p=p->next;
1626  }
1627  idhdl tmp=basePack->idroot;
1628  while (tmp!=NULL)
1629  {
1630  if (IDTYP(tmp)==PACKAGE_CMD)
1631  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1632  if (h!=NULL) return h;
1633  tmp=IDNEXT(tmp);
1634  }
1635  return NULL;
1636 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6208
#define IDNEXT(a)
Definition: ipid.h:113
proclevel * procstack
Definition: ipid.cc:54
#define IDROOT
Definition: ipid.h:18
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
Definition: ipid.h:54
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:60
package currPack
Definition: ipid.cc:59
int p
Definition: cfModGcd.cc:4019
static Poly * h
Definition: janet.cc:972

◆ rInit()

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

Definition at line 5574 of file ipshell.cc.

5575 {
5576  int float_len=0;
5577  int float_len2=0;
5578  ring R = NULL;
5579  //BOOLEAN ffChar=FALSE;
5580 
5581  /* ch -------------------------------------------------------*/
5582  // get ch of ground field
5583 
5584  // allocated ring
5585  R = (ring) omAlloc0Bin(sip_sring_bin);
5586 
5587  coeffs cf = NULL;
5588 
5589  assume( pn != NULL );
5590  const int P = pn->listLength();
5591 
5592  if (pn->Typ()==CRING_CMD)
5593  {
5594  cf=(coeffs)pn->CopyD();
5595  leftv pnn=pn;
5596  if(P>1) /*parameter*/
5597  {
5598  pnn = pnn->next;
5599  const int pars = pnn->listLength();
5600  assume( pars > 0 );
5601  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5602 
5603  if (rSleftvList2StringArray(pnn, names))
5604  {
5605  WerrorS("parameter expected");
5606  goto rInitError;
5607  }
5608 
5609  TransExtInfo extParam;
5610 
5611  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5612  for(int i=pars-1; i>=0;i--)
5613  {
5614  omFree(names[i]);
5615  }
5616  omFree(names);
5617 
5618  cf = nInitChar(n_transExt, &extParam);
5619  }
5620  assume( cf != NULL );
5621  }
5622  else if (pn->Typ()==INT_CMD)
5623  {
5624  int ch = (int)(long)pn->Data();
5625  leftv pnn=pn;
5626 
5627  /* parameter? -------------------------------------------------------*/
5628  pnn = pnn->next;
5629 
5630  if (pnn == NULL) // no params!?
5631  {
5632  if (ch!=0)
5633  {
5634  int ch2=IsPrime(ch);
5635  if ((ch<2)||(ch!=ch2))
5636  {
5637  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5638  ch=32003;
5639  }
5640  #ifndef TEST_ZN_AS_ZP
5641  cf = nInitChar(n_Zp, (void*)(long)ch);
5642  #else
5643  mpz_t modBase;
5644  mpz_init_set_ui(modBase, (long)ch);
5645  ZnmInfo info;
5646  info.base= modBase;
5647  info.exp= 1;
5648  cf=nInitChar(n_Zn,(void*) &info);
5649  cf->is_field=1;
5650  cf->is_domain=1;
5651  cf->has_simple_Inverse=1;
5652  #endif
5653  }
5654  else
5655  cf = nInitChar(n_Q, (void*)(long)ch);
5656  }
5657  else
5658  {
5659  const int pars = pnn->listLength();
5660 
5661  assume( pars > 0 );
5662 
5663  // predefined finite field: (p^k, a)
5664  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5665  {
5666  GFInfo param;
5667 
5668  param.GFChar = ch;
5669  param.GFDegree = 1;
5670  param.GFPar_name = pnn->name;
5671 
5672  cf = nInitChar(n_GF, &param);
5673  }
5674  else // (0/p, a, b, ..., z)
5675  {
5676  if ((ch!=0) && (ch!=IsPrime(ch)))
5677  {
5678  WerrorS("too many parameters");
5679  goto rInitError;
5680  }
5681 
5682  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5683 
5684  if (rSleftvList2StringArray(pnn, names))
5685  {
5686  WerrorS("parameter expected");
5687  goto rInitError;
5688  }
5689 
5690  TransExtInfo extParam;
5691 
5692  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5693  for(int i=pars-1; i>=0;i--)
5694  {
5695  omFree(names[i]);
5696  }
5697  omFree(names);
5698 
5699  cf = nInitChar(n_transExt, &extParam);
5700  }
5701  }
5702 
5703  //if (cf==NULL) ->Error: Invalid ground field specification
5704  }
5705  else if ((pn->name != NULL)
5706  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5707  {
5708  leftv pnn=pn->next;
5709  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5710  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5711  {
5712  float_len=(int)(long)pnn->Data();
5713  float_len2=float_len;
5714  pnn=pnn->next;
5715  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5716  {
5717  float_len2=(int)(long)pnn->Data();
5718  pnn=pnn->next;
5719  }
5720  }
5721 
5722  if (!complex_flag)
5723  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5724  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5725  cf=nInitChar(n_R, NULL);
5726  else // longR or longC?
5727  {
5728  LongComplexInfo param;
5729 
5730  param.float_len = si_min (float_len, 32767);
5731  param.float_len2 = si_min (float_len2, 32767);
5732 
5733  // set the parameter name
5734  if (complex_flag)
5735  {
5736  if (param.float_len < SHORT_REAL_LENGTH)
5737  {
5740  }
5741  if ((pnn == NULL) || (pnn->name == NULL))
5742  param.par_name=(const char*)"i"; //default to i
5743  else
5744  param.par_name = (const char*)pnn->name;
5745  }
5746 
5747  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5748  }
5749  assume( cf != NULL );
5750  }
5751 #ifdef HAVE_RINGS
5752  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5753  {
5754  // TODO: change to use coeffs_BIGINT!?
5755  mpz_t modBase;
5756  unsigned int modExponent = 1;
5757  mpz_init_set_si(modBase, 0);
5758  if (pn->next!=NULL)
5759  {
5760  leftv pnn=pn;
5761  if (pnn->next->Typ()==INT_CMD)
5762  {
5763  pnn=pnn->next;
5764  mpz_set_ui(modBase, (long) pnn->Data());
5765  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5766  {
5767  pnn=pnn->next;
5768  modExponent = (long) pnn->Data();
5769  }
5770  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5771  {
5772  pnn=pnn->next;
5773  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5774  }
5775  }
5776  else if (pnn->next->Typ()==BIGINT_CMD)
5777  {
5778  number p=(number)pnn->next->CopyD();
5779  nlGMP(p,modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, mpz_t n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5781  }
5782  }
5783  else
5784  cf=nInitChar(n_Z,NULL);
5785 
5786  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5787  {
5788  WerrorS("Wrong ground ring specification (module is 1)");
5789  goto rInitError;
5790  }
5791  if (modExponent < 1)
5792  {
5793  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5794  goto rInitError;
5795  }
5796  // module is 0 ---> integers ringtype = 4;
5797  // we have an exponent
5798  if (modExponent > 1 && cf == NULL)
5799  {
5800  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5801  {
5802  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5803  depending on the size of a long on the respective platform */
5804  //ringtype = 1; // Use Z/2^ch
5805  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5806  }
5807  else
5808  {
5809  if (mpz_sgn1(modBase)==0)
5810  {
5811  WerrorS("modulus must not be 0 or parameter not allowed");
5812  goto rInitError;
5813  }
5814  //ringtype = 3;
5815  ZnmInfo info;
5816  info.base= modBase;
5817  info.exp= modExponent;
5818  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5819  }
5820  }
5821  // just a module m > 1
5822  else if (cf == NULL)
5823  {
5824  if (mpz_sgn1(modBase)==0)
5825  {
5826  WerrorS("modulus must not be 0 or parameter not allowed");
5827  goto rInitError;
5828  }
5829  //ringtype = 2;
5830  ZnmInfo info;
5831  info.base= modBase;
5832  info.exp= modExponent;
5833  cf=nInitChar(n_Zn,(void*) &info);
5834  }
5835  assume( cf != NULL );
5836  mpz_clear(modBase);
5837  }
5838 #endif
5839  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5840  else if ((pn->Typ()==RING_CMD) && (P == 1))
5841  {
5842  TransExtInfo extParam;
5843  extParam.r = (ring)pn->Data();
5844  cf = nInitChar(n_transExt, &extParam);
5845  }
5846  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5847  //{
5848  // AlgExtInfo extParam;
5849  // extParam.r = (ring)pn->Data();
5850 
5851  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5852  //}
5853  else
5854  {
5855  WerrorS("Wrong or unknown ground field specification");
5856 #if 0
5857 // debug stuff for unknown cf descriptions:
5858  sleftv* p = pn;
5859  while (p != NULL)
5860  {
5861  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5862  PrintLn();
5863  p = p->next;
5864  }
5865 #endif
5866  goto rInitError;
5867  }
5868 
5869  /*every entry in the new ring is initialized to 0*/
5870 
5871  /* characteristic -----------------------------------------------*/
5872  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5873  * 0 1 : Q(a,...) *names FALSE
5874  * 0 -1 : R NULL FALSE 0
5875  * 0 -1 : R NULL FALSE prec. >6
5876  * 0 -1 : C *names FALSE prec. 0..?
5877  * p p : Fp NULL FALSE
5878  * p -p : Fp(a) *names FALSE
5879  * q q : GF(q=p^n) *names TRUE
5880  */
5881  if (cf==NULL)
5882  {
5883  WerrorS("Invalid ground field specification");
5884  goto rInitError;
5885 // const int ch=32003;
5886 // cf=nInitChar(n_Zp, (void*)(long)ch);
5887  }
5888 
5889  assume( R != NULL );
5890 
5891  R->cf = cf;
5892 
5893  /* names and number of variables-------------------------------------*/
5894  {
5895  int l=rv->listLength();
5896 
5897  if (l>MAX_SHORT)
5898  {
5899  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5900  goto rInitError;
5901  }
5902  R->N = l; /*rv->listLength();*/
5903  }
5904  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5905  if (rSleftvList2StringArray(rv, R->names))
5906  {
5907  WerrorS("name of ring variable expected");
5908  goto rInitError;
5909  }
5910 
5911  /* check names and parameters for conflicts ------------------------- */
5912  rRenameVars(R); // conflicting variables will be renamed
5913  /* ordering -------------------------------------------------------------*/
5914  if (rSleftvOrdering2Ordering(ord, R))
5915  goto rInitError;
5916 
5917  // Complete the initialization
5918  if (rComplete(R,1))
5919  goto rInitError;
5920 
5921 /*#ifdef HAVE_RINGS
5922 // currently, coefficients which are ring elements require a global ordering:
5923  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5924  {
5925  WerrorS("global ordering required for these coefficients");
5926  goto rInitError;
5927  }
5928 #endif*/
5929 
5930  rTest(R);
5931 
5932  // try to enter the ring into the name list
5933  // need to clean up sleftv here, before this ring can be set to
5934  // new currRing or currRing can be killed beacuse new ring has
5935  // same name
5936  pn->CleanUp();
5937  rv->CleanUp();
5938  ord->CleanUp();
5939  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5940  // goto rInitError;
5941 
5942  //memcpy(IDRING(tmp),R,sizeof(*R));
5943  // set current ring
5944  //omFreeBin(R, ip_sring_bin);
5945  //return tmp;
5946  return R;
5947 
5948  // error case:
5949  rInitError:
5950  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5951  pn->CleanUp();
5952  rv->CleanUp();
5953  ord->CleanUp();
5954  return NULL;
5955 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:96
#define SHORT_REAL_LENGTH
Definition: numbers.h:58
const short MAX_SHORT
Definition: ipshell.cc:5562
#define mpz_sgn1(A)
Definition: si_gmp.h:13
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5526
only used if HAVE_RINGS is defined
Definition: coeffs.h:47
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:39
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5254
Definition: tok.h:38
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
\F{p < 2^31}
Definition: coeffs.h:30
int listLength()
Definition: subexpr.cc:57
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:52
int Typ()
Definition: subexpr.cc:1039
Creation data needed for finite fields.
Definition: coeffs.h:92
idhdl rDefault(const char *s)
Definition: ipshell.cc:1555
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
char * char_ptr
Definition: structs.h:56
single prescision (6,6) real numbers
Definition: coeffs.h:32
Definition: tok.h:56
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
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:3369
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:390
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
const ExtensionInfo & info
< [in] sqrfree poly
complex floating point (GMP) numbers
Definition: coeffs.h:42
#define rTest(r)
Definition: ring.h:776
omBin sip_sring_bin
Definition: ring.cc:44
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
struct for passing initialization parameters to naInitChar
Definition: transext.h:88
int i
Definition: cfEzgcd.cc:125
int IsPrime(int p)
Definition: prime.cc:61
void nlGMP(number &i, mpz_t n, const coeffs r)
Definition: longrat.cc:1478
static void rRenameVars(ring R)
Definition: ipshell.cc:2408
leftv next
Definition: subexpr.h:86
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:94
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define NULL
Definition: omList.c:10
\GF{p^n < 2^16}
Definition: coeffs.h:33
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:437
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
#define R
Definition: sirandom.c:26
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
void * Data()
Definition: subexpr.cc:1182
const char * par_name
parameter name
Definition: coeffs.h:103
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
int p
Definition: cfModGcd.cc:4019
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
void * CopyD(int t)
Definition: subexpr.cc:745
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:350
#define Warn
Definition: emacs.cc:77

◆ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6119 of file ipshell.cc.

6120 {
6121  if ((r->ref<=0)&&(r->order!=NULL))
6122  {
6123 #ifdef RDEBUG
6124  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6125 #endif
6126  int j;
6127  for (j=0;j<myynest;j++)
6128  {
6129  if (iiLocalRing[j]==r)
6130  {
6131  if (j==0) WarnS("killing the basering for level 0");
6132  iiLocalRing[j]=NULL;
6133  }
6134  }
6135 // any variables depending on r ?
6136  while (r->idroot!=NULL)
6137  {
6138  r->idroot->lev=myynest; // avoid warning about kill global objects
6139  killhdl2(r->idroot,&(r->idroot),r);
6140  }
6141  if (r==currRing)
6142  {
6143  // all dependend stuff is done, clean global vars:
6144  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6146  {
6148  }
6149  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6150  //{
6151  // WerrorS("return value depends on local ring variable (export missing ?)");
6152  // iiRETURNEXPR.CleanUp();
6153  //}
6154  currRing=NULL;
6155  currRingHdl=NULL;
6156  }
6157 
6158  /* nKillChar(r); will be called from inside of rDelete */
6159  rDelete(r);
6160  return;
6161  }
6162  r->ref--;
6163 }
int j
Definition: facHensel.cc:105
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:80
int traceit
Definition: febase.cc:42
#define WarnS
Definition: emacs.cc:78
int myynest
Definition: febase.cc:41
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:417
BOOLEAN RingDependend()
Definition: subexpr.cc:424
idhdl currRingHdl
Definition: ipid.cc:61
ring * iiLocalRing
Definition: iplib.cc:454
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:437
#define pDelete(p_ptr)
Definition: polys.h:181
sleftv sLastPrinted
Definition: subexpr.cc:52
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13

◆ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6165 of file ipshell.cc.

6166 {
6167  ring r = IDRING(h);
6168  int ref=0;
6169  if (r!=NULL)
6170  {
6171  // avoid, that sLastPrinted is the last reference to the base ring:
6172  // clean up before killing the last "named" refrence:
6173  if ((sLastPrinted.rtyp==RING_CMD)
6174  && (sLastPrinted.data==(void*)r))
6175  {
6176  sLastPrinted.CleanUp(r);
6177  }
6178  ref=r->ref;
6179  if ((ref<=0)&&(r==currRing))
6180  {
6181  // cleanup DENOMINATOR_LIST
6182  if (DENOMINATOR_LIST!=NULL)
6183  {
6185  if (TEST_V_ALLWARN)
6186  Warn("deleting denom_list for ring change from %s",IDID(h));
6187  do
6188  {
6189  n_Delete(&(dd->n),currRing->cf);
6190  dd=dd->next;
6192  DENOMINATOR_LIST=dd;
6193  } while(DENOMINATOR_LIST!=NULL);
6194  }
6195  }
6196  rKill(r);
6197  }
6198  if (h==currRingHdl)
6199  {
6200  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6201  else
6202  {
6204  }
6205  }
6206 }
#define IDID(a)
Definition: ipid.h:117
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:87
void * data
Definition: subexpr.h:88
void rKill(ring r)
Definition: ipshell.cc:6119
#define omFree(addr)
Definition: omAllocDecl.h:261
idhdl currRingHdl
Definition: ipid.cc:61
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1612
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:61
#define IDRING(a)
Definition: ipid.h:122
int rtyp
Definition: subexpr.h:91
sleftv sLastPrinted
Definition: subexpr.cc:52
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
static Poly * h
Definition: janet.cc:972
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5142 of file ipshell.cc.

5143 {
5144  // change some bad orderings/combination into better ones
5145  leftv h=ord;
5146  while(h!=NULL)
5147  {
5148  BOOLEAN change=FALSE;
5149  intvec *iv = (intvec *)(h->data);
5150  // ws(-i) -> wp(i)
5151  if ((*iv)[1]==ringorder_ws)
5152  {
5153  BOOLEAN neg=TRUE;
5154  for(int i=2;i<iv->length();i++)
5155  if((*iv)[i]>=0) { neg=FALSE; break; }
5156  if (neg)
5157  {
5158  (*iv)[1]=ringorder_wp;
5159  for(int i=2;i<iv->length();i++)
5160  (*iv)[i]= - (*iv)[i];
5161  change=TRUE;
5162  }
5163  }
5164  // Ws(-i) -> Wp(i)
5165  if ((*iv)[1]==ringorder_Ws)
5166  {
5167  BOOLEAN neg=TRUE;
5168  for(int i=2;i<iv->length();i++)
5169  if((*iv)[i]>=0) { neg=FALSE; break; }
5170  if (neg)
5171  {
5172  (*iv)[1]=ringorder_Wp;
5173  for(int i=2;i<iv->length();i++)
5174  (*iv)[i]= -(*iv)[i];
5175  change=TRUE;
5176  }
5177  }
5178  // wp(1) -> dp
5179  if ((*iv)[1]==ringorder_wp)
5180  {
5181  BOOLEAN all_one=TRUE;
5182  for(int i=2;i<iv->length();i++)
5183  if((*iv)[i]!=1) { all_one=FALSE; break; }
5184  if (all_one)
5185  {
5186  intvec *iv2=new intvec(3);
5187  (*iv2)[0]=1;
5188  (*iv2)[1]=ringorder_dp;
5189  (*iv2)[2]=iv->length()-2;
5190  delete iv;
5191  iv=iv2;
5192  h->data=iv2;
5193  change=TRUE;
5194  }
5195  }
5196  // Wp(1) -> Dp
5197  if ((*iv)[1]==ringorder_Wp)
5198  {
5199  BOOLEAN all_one=TRUE;
5200  for(int i=2;i<iv->length();i++)
5201  if((*iv)[i]!=1) { all_one=FALSE; break; }
5202  if (all_one)
5203  {
5204  intvec *iv2=new intvec(3);
5205  (*iv2)[0]=1;
5206  (*iv2)[1]=ringorder_Dp;
5207  (*iv2)[2]=iv->length()-2;
5208  delete iv;
5209  iv=iv2;
5210  h->data=iv2;
5211  change=TRUE;
5212  }
5213  }
5214  // dp(1)/Dp(1)/rp(1) -> lp(1)
5215  if (((*iv)[1]==ringorder_dp)
5216  || ((*iv)[1]==ringorder_Dp)
5217  || ((*iv)[1]==ringorder_rp))
5218  {
5219  if (iv->length()==3)
5220  {
5221  if ((*iv)[2]==1)
5222  {
5223  (*iv)[1]=ringorder_lp;
5224  change=TRUE;
5225  }
5226  }
5227  }
5228  // lp(i),lp(j) -> lp(i+j)
5229  if(((*iv)[1]==ringorder_lp)
5230  && (h->next!=NULL))
5231  {
5232  intvec *iv2 = (intvec *)(h->next->data);
5233  if ((*iv2)[1]==ringorder_lp)
5234  {
5235  leftv hh=h->next;
5236  h->next=hh->next;
5237  hh->next=NULL;
5238  if ((*iv2)[0]==1)
5239  (*iv)[2] += 1; // last block unspecified, at least 1
5240  else
5241  (*iv)[2] += (*iv2)[2];
5242  hh->CleanUp();
5243  omFree(hh);
5244  change=TRUE;
5245  }
5246  }
5247  // -------------------
5248  if (!change) h=h->next;
5249  }
5250  return ord;
5251 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: intvec.h:17
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
static Poly * h
Definition: janet.cc:972
int BOOLEAN
Definition: auxiliary.h:85

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2408 of file ipshell.cc.

2409 {
2410  int i,j;
2411  BOOLEAN ch;
2412  do
2413  {
2414  ch=0;
2415  for(i=0;i<R->N-1;i++)
2416  {
2417  for(j=i+1;j<R->N;j++)
2418  {
2419  if (strcmp(R->names[i],R->names[j])==0)
2420  {
2421  ch=TRUE;
2422  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2423  omFree(R->names[j]);
2424  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2425  sprintf(R->names[j],"@%s",R->names[i]);
2426  }
2427  }
2428  }
2429  }
2430  while (ch);
2431  for(i=0;i<rPar(R); i++)
2432  {
2433  for(j=0;j<R->N;j++)
2434  {
2435  if (strcmp(rParameter(R)[i],R->names[j])==0)
2436  {
2437  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2438 // omFree(rParameter(R)[i]);
2439 // rParameter(R)[i]=(char *)omAlloc(10);
2440 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2441  omFree(R->names[j]);
2442  R->names[j]=(char *)omAlloc(10);
2443  sprintf(R->names[j],"@@(%d)",i+1);
2444  }
2445  }
2446  }
2447 }
int j
Definition: facHensel.cc:105
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:589
#define TRUE
Definition: auxiliary.h:98
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:615
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:125
#define R
Definition: sirandom.c:26
int BOOLEAN
Definition: auxiliary.h:85
#define Warn
Definition: emacs.cc:77

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5081 of file ipshell.cc.

5082 {
5083  ring rg = NULL;
5084  if (h!=NULL)
5085  {
5086 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5087  rg = IDRING(h);
5088  if (rg==NULL) return; //id <>NULL, ring==NULL
5089  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5090  if (IDID(h)) // OB: ????
5092  rTest(rg);
5093  }
5094  else return;
5095 
5096  // clean up history
5097  if (currRing!=NULL)
5098  {
5100  {
5102  //memset(&sLastPrinted,0,sizeof(sleftv)); // done by Cleanup,Init
5103  }
5104 
5105  if (rg!=currRing)/*&&(currRing!=NULL)*/
5106  {
5107  if (rg->cf!=currRing->cf)
5108  {
5110  if (DENOMINATOR_LIST!=NULL)
5111  {
5112  if (TEST_V_ALLWARN)
5113  Warn("deleting denom_list for ring change to %s",IDID(h));
5114  do
5115  {
5116  n_Delete(&(dd->n),currRing->cf);
5117  dd=dd->next;
5119  DENOMINATOR_LIST=dd;
5120  } while(DENOMINATOR_LIST!=NULL);
5121  }
5122  }
5123  }
5124  }
5125 
5126  // test for valid "currRing":
5127  if ((rg!=NULL) && (rg->idroot==NULL))
5128  {
5129  ring old=rg;
5130  rg=rAssure_HasComp(rg);
5131  if (old!=rg)
5132  {
5133  rKill(old);
5134  IDRING(h)=rg;
5135  }
5136  }
5137  /*------------ change the global ring -----------------------*/
5138  rChangeCurrRing(rg);
5139  currRingHdl = h;
5140 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
#define IDID(a)
Definition: ipid.h:117
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:87
void * ADDRESS
Definition: auxiliary.h:133
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4558
Definition: idrec.h:34
BOOLEAN RingDependend()
Definition: subexpr.cc:424
void rKill(ring r)
Definition: ipshell.cc:6119
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:776
idhdl currRingHdl
Definition: ipid.cc:61
void rChangeCurrRing(ring r)
Definition: polys.cc:15
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:61
#define IDRING(a)
Definition: ipid.h:122
sleftv sLastPrinted
Definition: subexpr.cc:52
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
static Poly * h
Definition: janet.cc:972
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ rSimpleFindHdl()

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

Definition at line 6208 of file ipshell.cc.

6209 {
6210  idhdl h=root;
6211  while (h!=NULL)
6212  {
6213  if ((IDTYP(h)==RING_CMD)
6214  && (h!=n)
6215  && (IDRING(h)==r)
6216  )
6217  {
6218  return h;
6219  }
6220  h=IDNEXT(h);
6221  }
6222  return NULL;
6223 }
#define IDNEXT(a)
Definition: ipid.h:113
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:114
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:122
static Poly * h
Definition: janet.cc:972

◆ rSleftvList2StringArray()

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

Definition at line 5526 of file ipshell.cc.

5527 {
5528 
5529  while(sl!=NULL)
5530  {
5531  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5532  {
5533  *p = omStrDup(sl->Name());
5534  }
5535  else if (sl->name!=NULL)
5536  {
5537  *p = (char*)sl->name;
5538  sl->name=NULL;
5539  }
5540  else if (sl->rtyp==POLY_CMD)
5541  {
5542  sleftv s_sl;
5543  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5544  if (s_sl.name != NULL)
5545  {
5546  *p = (char*)s_sl.name; s_sl.name=NULL;
5547  }
5548  else
5549  *p = NULL;
5550  sl->next = s_sl.next;
5551  s_sl.next = NULL;
5552  s_sl.CleanUp();
5553  if (*p == NULL) return TRUE;
5554  }
5555  else return TRUE;
5556  p++;
5557  sl=sl->next;
5558  }
5559  return FALSE;
5560 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:436
#define TRUE
Definition: auxiliary.h:98
const char * Name()
Definition: subexpr.h:120
#define IDHDL
Definition: tok.h:31
const char * name
Definition: subexpr.h:87
leftv next
Definition: subexpr.h:86
Definition: tok.h:34
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
int p
Definition: cfModGcd.cc:4019
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5254 of file ipshell.cc.

5255 {
5256  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5257  ord=rOptimizeOrdAsSleftv(ord);
5258  sleftv *sl = ord;
5259 
5260  // determine nBlocks
5261  while (sl!=NULL)
5262  {
5263  intvec *iv = (intvec *)(sl->data);
5264  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5265  i++;
5266  else if ((*iv)[1]==ringorder_L)
5267  {
5268  R->bitmask=(*iv)[2]*2+1;
5269  n--;
5270  }
5271  else if (((*iv)[1]!=ringorder_a)
5272  && ((*iv)[1]!=ringorder_a64)
5273  && ((*iv)[1]!=ringorder_am))
5274  o++;
5275  n++;
5276  sl=sl->next;
5277  }
5278  // check whether at least one real ordering
5279  if (o==0)
5280  {
5281  WerrorS("invalid combination of orderings");
5282  return TRUE;
5283  }
5284  // if no c/C ordering is given, increment n
5285  if (i==0) n++;
5286  else if (i != 1)
5287  {
5288  // throw error if more than one is given
5289  WerrorS("more than one ordering c/C specified");
5290  return TRUE;
5291  }
5292 
5293  // initialize fields of R
5294  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5295  R->block0=(int *)omAlloc0(n*sizeof(int));
5296  R->block1=(int *)omAlloc0(n*sizeof(int));
5297  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5298 
5299  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5300 
5301  // init order, so that rBlocks works correctly
5302  for (j=0; j < n-1; j++)
5303  R->order[j] = ringorder_unspec;
5304  // set last _C order, if no c/C order was given
5305  if (i == 0) R->order[n-2] = ringorder_C;
5306 
5307  /* init orders */
5308  sl=ord;
5309  n=-1;
5310  while (sl!=NULL)
5311  {
5312  intvec *iv;
5313  iv = (intvec *)(sl->data);
5314  if ((*iv)[1]!=ringorder_L)
5315  {
5316  n++;
5317 
5318  /* the format of an ordering:
5319  * iv[0]: factor
5320  * iv[1]: ordering
5321  * iv[2..end]: weights
5322  */
5323  R->order[n] = (rRingOrder_t)((*iv)[1]);
5324  typ=1;
5325  switch ((*iv)[1])
5326  {
5327  case ringorder_ws:
5328  case ringorder_Ws:
5329  typ=-1;
5330  case ringorder_wp:
5331  case ringorder_Wp:
5332  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5333  R->block0[n] = last+1;
5334  for (i=2; i<iv->length(); i++)
5335  {
5336  R->wvhdl[n][i-2] = (*iv)[i];
5337  last++;
5338  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5339  }
5340  R->block1[n] = si_min(last,R->N);
5341  break;
5342  case ringorder_ls:
5343  case ringorder_ds:
5344  case ringorder_Ds:
5345  case ringorder_rs:
5346  typ=-1;
5347  case ringorder_lp:
5348  case ringorder_dp:
5349  case ringorder_Dp:
5350  case ringorder_rp:
5351  R->block0[n] = last+1;
5352  if (iv->length() == 3) last+=(*iv)[2];
5353  else last += (*iv)[0];
5354  R->block1[n] = si_min(last,R->N);
5355  if (rCheckIV(iv)) return TRUE;
5356  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5357  {
5358  if (weights[i]==0) weights[i]=typ;
5359  }
5360  break;
5361 
5362  case ringorder_s: // no 'rank' params!
5363  {
5364 
5365  if(iv->length() > 3)
5366  return TRUE;
5367 
5368  if(iv->length() == 3)
5369  {
5370  const int s = (*iv)[2];
5371  R->block0[n] = s;
5372  R->block1[n] = s;
5373  }
5374  break;
5375  }
5376  case ringorder_IS:
5377  {
5378  if(iv->length() != 3) return TRUE;
5379 
5380  const int s = (*iv)[2];
5381 
5382  if( 1 < s || s < -1 ) return TRUE;
5383 
5384  R->block0[n] = s;
5385  R->block1[n] = s;
5386  break;
5387  }
5388  case ringorder_S:
5389  case ringorder_c:
5390  case ringorder_C:
5391  {
5392  if (rCheckIV(iv)) return TRUE;
5393  break;
5394  }
5395  case ringorder_aa:
5396  case ringorder_a:
5397  {
5398  R->block0[n] = last+1;
5399  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5400  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5401  for (i=2; i<iv->length(); i++)
5402  {
5403  R->wvhdl[n][i-2]=(*iv)[i];
5404  last++;
5405  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5406  }
5407  last=R->block0[n]-1;
5408  break;
5409  }
5410  case ringorder_am:
5411  {
5412  R->block0[n] = last+1;
5413  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5414  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5415  if (R->block1[n]- R->block0[n]+2>=iv->length())
5416  WarnS("missing module weights");
5417  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5418  {
5419  R->wvhdl[n][i-2]=(*iv)[i];
5420  last++;
5421  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5422  }
5423  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5424  for (; i<iv->length(); i++)
5425  {
5426  R->wvhdl[n][i-1]=(*iv)[i];
5427  }
5428  last=R->block0[n]-1;
5429  break;
5430  }
5431  case ringorder_a64:
5432  {
5433  R->block0[n] = last+1;
5434  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5435  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5436  int64 *w=(int64 *)R->wvhdl[n];
5437  for (i=2; i<iv->length(); i++)
5438  {
5439  w[i-2]=(*iv)[i];
5440  last++;
5441  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5442  }
5443  last=R->block0[n]-1;
5444  break;
5445  }
5446  case ringorder_M:
5447  {
5448  int Mtyp=rTypeOfMatrixOrder(iv);
5449  if (Mtyp==0) return TRUE;
5450  if (Mtyp==-1) typ = -1;
5451 
5452  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5453  for (i=2; i<iv->length();i++)
5454  R->wvhdl[n][i-2]=(*iv)[i];
5455 
5456  R->block0[n] = last+1;
5457  last += (int)sqrt((double)(iv->length()-2));
5458  R->block1[n] = si_min(last,R->N);
5459  for(i=R->block1[n];i>=R->block0[n];i--)
5460  {
5461  if (weights[i]==0) weights[i]=typ;
5462  }
5463  break;
5464  }
5465 
5466  case ringorder_no:
5467  R->order[n] = ringorder_unspec;
5468  return TRUE;
5469 
5470  default:
5471  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5472  R->order[n] = ringorder_unspec;
5473  return TRUE;
5474  }
5475  }
5476  if (last>R->N)
5477  {
5478  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5479  R->N,last);
5480  return TRUE;
5481  }
5482  sl=sl->next;
5483  }
5484  // find OrdSgn:
5485  R->OrdSgn = 1;
5486  for(i=1;i<=R->N;i++)
5487  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5488  omFree(weights);
5489 
5490  // check for complete coverage
5491  while ( n >= 0 && (
5492  (R->order[n]==ringorder_c)
5493  || (R->order[n]==ringorder_C)
5494  || (R->order[n]==ringorder_s)
5495  || (R->order[n]==ringorder_S)
5496  || (R->order[n]==ringorder_IS)
5497  )) n--;
5498 
5499  assume( n >= 0 );
5500 
5501  if (R->block1[n] != R->N)
5502  {
5503  if (((R->order[n]==ringorder_dp) ||
5504  (R->order[n]==ringorder_ds) ||
5505  (R->order[n]==ringorder_Dp) ||
5506  (R->order[n]==ringorder_Ds) ||
5507  (R->order[n]==ringorder_rp) ||
5508  (R->order[n]==ringorder_rs) ||
5509  (R->order[n]==ringorder_lp) ||
5510  (R->order[n]==ringorder_ls))
5511  &&
5512  R->block0[n] <= R->N)
5513  {
5514  R->block1[n] = R->N;
5515  }
5516  else
5517  {
5518  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5519  R->N,R->block1[n]);
5520  return TRUE;
5521  }
5522  }
5523  return FALSE;
5524 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:92
const CanonicalForm int s
Definition: facAbsFact.cc:55
int j
Definition: facHensel.cc:105
for int64 weights
Definition: ring.h:72
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
#define FALSE
Definition: auxiliary.h:94
opposite of ls
Definition: ring.h:93
static poly last
Definition: hdegree.cc:1077
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
long int64
Definition: auxiliary.h:66
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:78
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
if(yy_init)
Definition: libparse.cc:1418
Definition: intvec.h:17
#define omFree(addr)
Definition: omAllocDecl.h:261
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5142
#define assume(x)
Definition: mod2.h:390
for(int i=0;i<=n;i++) degsf[i]
Definition: cfEzgcd.cc:65
rRingOrder_t
order stuff
Definition: ring.h:68
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:328
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:176
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:94
S?
Definition: ring.h:76
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:92
#define R
Definition: sirandom.c:26
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:186
const CanonicalForm & w
Definition: facAbsFact.cc:55
int * int_ptr
Definition: structs.h:57
s?
Definition: ring.h:77
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 5957 of file ipshell.cc.

5958 {
5959  ring R = rCopy0(org_ring);
5960  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5961  int n = rBlocks(org_ring), i=0, j;
5962 
5963  /* names and number of variables-------------------------------------*/
5964  {
5965  int l=rv->listLength();
5966  if (l>MAX_SHORT)
5967  {
5968  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5969  goto rInitError;
5970  }
5971  R->N = l; /*rv->listLength();*/
5972  }
5973  omFree(R->names);
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 for subring in org_ring ------------------------- */
5982  {
5983  i=0;
5984 
5985  for(j=0;j<R->N;j++)
5986  {
5987  for(;i<org_ring->N;i++)
5988  {
5989  if (strcmp(org_ring->names[i],R->names[j])==0)
5990  {
5991  perm[i+1]=j+1;
5992  break;
5993  }
5994  }
5995  if (i>org_ring->N)
5996  {
5997  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5998  break;
5999  }
6000  }
6001  }
6002  //Print("perm=");
6003  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6004  /* ordering -------------------------------------------------------------*/
6005 
6006  for(i=0;i<n;i++)
6007  {
6008  int min_var=-1;
6009  int max_var=-1;
6010  for(j=R->block0[i];j<=R->block1[i];j++)
6011  {
6012  if (perm[j]>0)
6013  {
6014  if (min_var==-1) min_var=perm[j];
6015  max_var=perm[j];
6016  }
6017  }
6018  if (min_var!=-1)
6019  {
6020  //Print("block %d: old %d..%d, now:%d..%d\n",
6021  // i,R->block0[i],R->block1[i],min_var,max_var);
6022  R->block0[i]=min_var;
6023  R->block1[i]=max_var;
6024  if (R->wvhdl[i]!=NULL)
6025  {
6026  omFree(R->wvhdl[i]);
6027  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6028  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6029  {
6030  if (perm[j]>0)
6031  {
6032  R->wvhdl[i][perm[j]-R->block0[i]]=
6033  org_ring->wvhdl[i][j-org_ring->block0[i]];
6034  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6035  }
6036  }
6037  }
6038  }
6039  else
6040  {
6041  if(R->block0[i]>0)
6042  {
6043  //Print("skip block %d\n",i);
6044  R->order[i]=ringorder_unspec;
6045  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6046  R->wvhdl[i]=NULL;
6047  }
6048  //else Print("keep block %d\n",i);
6049  }
6050  }
6051  i=n-1;
6052  while(i>0)
6053  {
6054  // removed unneded blocks
6055  if(R->order[i-1]==ringorder_unspec)
6056  {
6057  for(j=i;j<=n;j++)
6058  {
6059  R->order[j-1]=R->order[j];
6060  R->block0[j-1]=R->block0[j];
6061  R->block1[j-1]=R->block1[j];
6062  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6063  R->wvhdl[j-1]=R->wvhdl[j];
6064  }
6065  R->order[n]=ringorder_unspec;
6066  n--;
6067  }
6068  i--;
6069  }
6070  n=rBlocks(org_ring)-1;
6071  while (R->order[n]==0) n--;
6072  while (R->order[n]==ringorder_unspec) n--;
6073  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6074  if (R->block1[n] != R->N)
6075  {
6076  if (((R->order[n]==ringorder_dp) ||
6077  (R->order[n]==ringorder_ds) ||
6078  (R->order[n]==ringorder_Dp) ||
6079  (R->order[n]==ringorder_Ds) ||
6080  (R->order[n]==ringorder_rp) ||
6081  (R->order[n]==ringorder_rs) ||
6082  (R->order[n]==ringorder_lp) ||
6083  (R->order[n]==ringorder_ls))
6084  &&
6085  R->block0[n] <= R->N)
6086  {
6087  R->block1[n] = R->N;
6088  }
6089  else
6090  {
6091  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6092  R->N,R->block1[n],n);
6093  return NULL;
6094  }
6095  }
6096  omFree(perm);
6097  // find OrdSgn:
6098  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6099  //for(i=1;i<=R->N;i++)
6100  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6101  //omFree(weights);
6102  // Complete the initialization
6103  if (rComplete(R,1))
6104  goto rInitError;
6105 
6106  rTest(R);
6107 
6108  if (rv != NULL) rv->CleanUp();
6109 
6110  return R;
6111 
6112  // error case:
6113  rInitError:
6114  if (R != NULL) rDelete(R);
6115  if (rv != NULL) rv->CleanUp();
6116  return NULL;
6117 }
int j
Definition: facHensel.cc:105
const short MAX_SHORT
Definition: ipshell.cc:5562
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5526
opposite of ls
Definition: ring.h:93
int listLength()
Definition: subexpr.cc:57
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * char_ptr
Definition: structs.h:56
static int rBlocks(ring r)
Definition: ring.h:558
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:3369
#define omFree(addr)
Definition: omAllocDecl.h:261
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1340
#define rTest(r)
Definition: ring.h:776
int i
Definition: cfEzgcd.cc:125
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:437
#define R
Definition: sirandom.c:26
void CleanUp(ring r=currRing)
Definition: subexpr.cc:354
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93

◆ scIndIndset()

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

Definition at line 1027 of file ipshell.cc.

1028 {
1029  int i;
1030  indset save;
1032 
1033  hexist = hInit(S, Q, &hNexist, currRing);
1034  if (hNexist == 0)
1035  {
1036  intvec *iv=new intvec(rVar(currRing));
1037  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1038  res->Init(1);
1039  res->m[0].rtyp=INTVEC_CMD;
1040  res->m[0].data=(intvec*)iv;
1041  return res;
1042  }
1043  else if (hisModule!=0)
1044  {
1045  res->Init(0);
1046  return res;
1047  }
1048  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1049  hMu = 0;
1050  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1051  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1052  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1053  hrad = hexist;
1054  hNrad = hNexist;
1055  radmem = hCreate(rVar(currRing) - 1);
1056  hCo = rVar(currRing) + 1;
1057  hNvar = rVar(currRing);
1058  hRadical(hrad, &hNrad, hNvar);
1059  hSupp(hrad, hNrad, hvar, &hNvar);
1060  if (hNvar)
1061  {
1062  hCo = hNvar;
1063  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1064  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1065  hLexR(hrad, hNrad, hvar, hNvar);
1067  }
1068  if (hCo && (hCo < rVar(currRing)))
1069  {
1071  }
1072  if (hMu!=0)
1073  {
1074  ISet = save;
1075  hMu2 = 0;
1076  if (all && (hCo+1 < rVar(currRing)))
1077  {
1080  i=hMu+hMu2;
1081  res->Init(i);
1082  if (hMu2 == 0)
1083  {
1085  }
1086  }
1087  else
1088  {
1089  res->Init(hMu);
1090  }
1091  for (i=0;i<hMu;i++)
1092  {
1093  res->m[i].data = (void *)save->set;
1094  res->m[i].rtyp = INTVEC_CMD;
1095  ISet = save;
1096  save = save->nx;
1098  }
1099  omFreeBin((ADDRESS)save, indlist_bin);
1100  if (hMu2 != 0)
1101  {
1102  save = JSet;
1103  for (i=hMu;i<hMu+hMu2;i++)
1104  {
1105  res->m[i].data = (void *)save->set;
1106  res->m[i].rtyp = INTVEC_CMD;
1107  JSet = save;
1108  save = save->nx;
1110  }
1111  omFreeBin((ADDRESS)save, indlist_bin);
1112  }
1113  }
1114  else
1115  {
1116  res->Init(0);
1118  }
1119  hKill(radmem, rVar(currRing) - 1);
1120  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1121  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1122  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1124  return res;
1125 }
int hMu2
Definition: hdegree.cc:22
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:29
scfmon hwork
Definition: hutil.cc:19
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:496
int hNexist
Definition: hutil.cc:22
int * varset
Definition: hutil.h:16
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:15
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
scfmon hexist
Definition: hutil.cc:19
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:133
int hNrad
Definition: hutil.cc:22
int hNpure
Definition: hutil.cc:22
scmon hpure
Definition: hutil.cc:20
#define Q
Definition: sirandom.c:25
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:417
#define omAlloc(size)
Definition: omAllocDecl.h:210
scfmon hrad
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:146
indset ISet
Definition: hdegree.cc:279
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1016
varset hvar
Definition: hutil.cc:21
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:313
indlist * indset
Definition: hutil.h:28
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:627
omBin indlist_bin
Definition: hdegree.cc:23
indset JSet
Definition: hdegree.cc:279
int * scmon
Definition: hutil.h:14
int i
Definition: cfEzgcd.cc:125
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
monf radmem
Definition: hutil.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
omBin slists_bin
Definition: lists.cc:23
int hisModule
Definition: hutil.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:34
int hMu
Definition: hdegree.cc:22
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:180

◆ semicProc()

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

Definition at line 4520 of file ipshell.cc.

4521 {
4522  sleftv tmp;
4523  memset(&tmp,0,sizeof(tmp));
4524  tmp.rtyp=INT_CMD;
4525  /* tmp.data = (void *)0; -- done by memset */
4526 
4527  return semicProc3(res,u,v,&tmp);
4528 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4480
CanonicalForm res
Definition: facAbsFact.cc:64
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int rtyp
Definition: subexpr.h:91

◆ semicProc3()

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

Definition at line 4480 of file ipshell.cc.

4481 {
4482  semicState state;
4483  BOOLEAN qh=(((int)(long)w->Data())==1);
4484 
4485  // -----------------
4486  // check arguments
4487  // -----------------
4488 
4489  lists l1 = (lists)u->Data( );
4490  lists l2 = (lists)v->Data( );
4491 
4492  if( (state=list_is_spectrum( l1 ))!=semicOK )
4493  {
4494  WerrorS( "first argument is not a spectrum" );
4495  list_error( state );
4496  }
4497  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4498  {
4499  WerrorS( "second argument is not a spectrum" );
4500  list_error( state );
4501  }
4502  else
4503  {
4504  spectrum s1= spectrumFromList( l1 );
4505  spectrum s2= spectrumFromList( l2 );
4506 
4507  res->rtyp = INT_CMD;
4508  if (qh)
4509  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4510  else
4511  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4512  }
4513 
4514  // -----------------
4515  // check status
4516  // -----------------
4517 
4518  return (state!=semicOK);
4519 }
Definition: tok.h:96
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3353
void list_error(semicState state)
Definition: ipshell.cc:3437
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4222
CanonicalForm res
Definition: facAbsFact.cc:64
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3403
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
slists * lists
Definition: mpr_numeric.h:146
const CanonicalForm & w
Definition: facAbsFact.cc:55
void * Data()
Definition: subexpr.cc:1182
int BOOLEAN
Definition: auxiliary.h:85
int mult_spectrum(spectrum &)
Definition: semic.cc:396

◆ spaddProc()

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

Definition at line 4397 of file ipshell.cc.

4398 {
4399  semicState state;
4400 
4401  // -----------------
4402  // check arguments
4403  // -----------------
4404 
4405  lists l1 = (lists)first->Data( );
4406  lists l2 = (lists)second->Data( );
4407 
4408  if( (state=list_is_spectrum( l1 )) != semicOK )
4409  {
4410  WerrorS( "first argument is not a spectrum:" );
4411  list_error( state );
4412  }
4413  else if( (state=list_is_spectrum( l2 )) != semicOK )
4414  {
4415  WerrorS( "second argument is not a spectrum:" );
4416  list_error( state );
4417  }
4418  else
4419  {
4420  spectrum s1= spectrumFromList ( l1 );
4421  spectrum s2= spectrumFromList ( l2 );
4422  spectrum sum( s1+s2 );
4423 
4424  result->rtyp = LIST_CMD;
4425  result->data = (char*)(getList(sum));
4426  }
4427 
4428  return (state!=semicOK);
4429 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3353
void list_error(semicState state)
Definition: ipshell.cc:3437
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3365
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4222
semicState
Definition: ipshell.cc:3403
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76

◆ spectrumCompute()

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

Definition at line 3779 of file ipshell.cc.

3780 {
3781  int i;
3782 
3783  #ifdef SPECTRUM_DEBUG
3784  #ifdef SPECTRUM_PRINT
3785  #ifdef SPECTRUM_IOSTREAM
3786  cout << "spectrumCompute\n";
3787  if( fast==0 ) cout << " no optimization" << endl;
3788  if( fast==1 ) cout << " weight optimization" << endl;
3789  if( fast==2 ) cout << " symmetry optimization" << endl;
3790  #else
3791  fputs( "spectrumCompute\n",stdout );
3792  if( fast==0 ) fputs( " no optimization\n", stdout );
3793  if( fast==1 ) fputs( " weight optimization\n", stdout );
3794  if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3795  #endif
3796  #endif
3797  #endif
3798 
3799  // ----------------------
3800  // check if h is zero
3801  // ----------------------
3802 
3803  if( h==(poly)NULL )
3804  {
3805  return spectrumZero;
3806  }
3807 
3808  // ----------------------------------
3809  // check if h has a constant term
3810  // ----------------------------------
3811 
3812  if( hasConstTerm( h, currRing ) )
3813  {
3814  return spectrumBadPoly;
3815  }
3816 
3817  // --------------------------------
3818  // check if h has a linear term
3819  // --------------------------------
3820 
3821  if( hasLinearTerm( h, currRing ) )
3822  {
3823  *L = (lists)omAllocBin( slists_bin);
3824  (*L)->Init( 1 );
3825  (*L)->m[0].rtyp = INT_CMD; // milnor number
3826  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3827 
3828  return spectrumNoSingularity;
3829  }
3830 
3831  // ----------------------------------
3832  // compute the jacobi ideal of (h)
3833  // ----------------------------------
3834 
3835  ideal J = NULL;
3836  J = idInit( rVar(currRing),1 );
3837 
3838  #ifdef SPECTRUM_DEBUG
3839  #ifdef SPECTRUM_PRINT
3840  #ifdef SPECTRUM_IOSTREAM
3841  cout << "\n computing the Jacobi ideal...\n";
3842  #else
3843  fputs( "\n computing the Jacobi ideal...\n",stdout );
3844  #endif
3845  #endif
3846  #endif
3847 
3848  for( i=0; i<rVar(currRing); i++ )
3849  {
3850  J->m[i] = pDiff( h,i+1); //j );
3851 
3852  #ifdef SPECTRUM_DEBUG
3853  #ifdef SPECTRUM_PRINT
3854  #ifdef SPECTRUM_IOSTREAM
3855  cout << " ";
3856  #else
3857  fputs(" ", stdout );
3858  #endif
3859  pWrite( J->m[i] );
3860  #endif
3861  #endif
3862  }
3863 
3864  // --------------------------------------------
3865  // compute a standard basis stdJ of jac(h)
3866  // --------------------------------------------
3867 
3868  #ifdef SPECTRUM_DEBUG
3869  #ifdef SPECTRUM_PRINT
3870  #ifdef SPECTRUM_IOSTREAM
3871  cout << endl;
3872  cout << " computing a standard basis..." << endl;
3873  #else
3874  fputs( "\n", stdout );
3875  fputs( " computing a standard basis...\n", stdout );
3876  #endif
3877  #endif
3878  #endif
3879 
3880  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3881  idSkipZeroes( stdJ );
3882 
3883  #ifdef SPECTRUM_DEBUG
3884  #ifdef SPECTRUM_PRINT
3885  for( i=0; i<IDELEMS(stdJ); i++ )
3886  {
3887  #ifdef SPECTRUM_IOSTREAM
3888  cout << " ";
3889  #else
3890  fputs( " ",stdout );
3891  #endif
3892 
3893  pWrite( stdJ->m[i] );
3894  }
3895  #endif
3896  #endif
3897 
3898  idDelete( &J );
3899 
3900  // ------------------------------------------
3901  // check if the h has a singularity
3902  // ------------------------------------------
3903 
3904  if( hasOne( stdJ, currRing ) )
3905  {
3906  // -------------------------------
3907  // h is smooth in the origin
3908  // return only the Milnor number
3909  // -------------------------------
3910 
3911  *L = (lists)omAllocBin( slists_bin);
3912  (*L)->Init( 1 );
3913  (*L)->m[0].rtyp = INT_CMD; // milnor number
3914  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3915 
3916  return spectrumNoSingularity;
3917  }
3918 
3919  // ------------------------------------------
3920  // check if the singularity h is isolated
3921  // ------------------------------------------
3922 
3923  for( i=rVar(currRing); i>0; i-- )
3924  {
3925  if( hasAxis( stdJ,i, currRing )==FALSE )
3926  {
3927  return spectrumNotIsolated;
3928  }
3929  }
3930 
3931  // ------------------------------------------
3932  // compute the highest corner hc of stdJ
3933  // ------------------------------------------
3934 
3935  #ifdef SPECTRUM_DEBUG
3936  #ifdef SPECTRUM_PRINT
3937  #ifdef SPECTRUM_IOSTREAM
3938  cout << "\n computing the highest corner...\n";
3939  #else
3940  fputs( "\n computing the highest corner...\n", stdout );
3941  #endif
3942  #endif
3943  #endif
3944 
3945  poly hc = (poly)NULL;
3946 
3947  scComputeHC( stdJ,currRing->qideal, 0,hc );
3948 
3949  if( hc!=(poly)NULL )
3950  {
3951  pGetCoeff(hc) = nInit(1);
3952 
3953  for( i=rVar(currRing); i>0; i-- )
3954  {
3955  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3956  }
3957  pSetm( hc );
3958  }
3959  else
3960  {
3961  return spectrumNoHC;
3962  }
3963 
3964  #ifdef SPECTRUM_DEBUG
3965  #ifdef SPECTRUM_PRINT
3966  #ifdef SPECTRUM_IOSTREAM
3967  cout << " ";
3968  #else
3969  fputs( " ", stdout );
3970  #endif
3971  pWrite( hc );
3972  #endif
3973  #endif
3974 
3975  // ----------------------------------------
3976  // compute the Newton polygon nph of h
3977  // ----------------------------------------
3978 
3979  #ifdef SPECTRUM_DEBUG
3980  #ifdef SPECTRUM_PRINT
3981  #ifdef SPECTRUM_IOSTREAM
3982  cout << "\n computing the newton polygon...\n";
3983  #else
3984  fputs( "\n computing the newton polygon...\n", stdout );
3985  #endif
3986  #endif
3987  #endif
3988 
3989  newtonPolygon nph( h, currRing );
3990 
3991  #ifdef SPECTRUM_DEBUG
3992  #ifdef SPECTRUM_PRINT
3993  cout << nph;
3994  #endif
3995  #endif
3996 
3997  // -----------------------------------------------
3998  // compute the weight corner wc of (stdj,nph)
3999  // -----------------------------------------------
4000 
4001  #ifdef SPECTRUM_DEBUG
4002  #ifdef SPECTRUM_PRINT
4003  #ifdef SPECTRUM_IOSTREAM
4004  cout << "\n computing the weight corner...\n";
4005  #else
4006  fputs( "\n computing the weight corner...\n", stdout );
4007  #endif
4008  #endif
4009  #endif
4010 
4011  poly wc = ( fast==0 ? pCopy( hc ) :
4012  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4013  /* fast==2 */computeWC( nph,
4014  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4015 
4016  #ifdef SPECTRUM_DEBUG
4017  #ifdef SPECTRUM_PRINT
4018  #ifdef SPECTRUM_IOSTREAM
4019  cout << " ";
4020  #else
4021  fputs( " ", stdout );
4022  #endif
4023  pWrite( wc );
4024  #endif
4025  #endif
4026 
4027  // -------------
4028  // compute NF
4029  // -------------
4030 
4031  #ifdef SPECTRUM_DEBUG
4032  #ifdef SPECTRUM_PRINT
4033  #ifdef SPECTRUM_IOSTREAM
4034  cout << "\n computing NF...\n" << endl;
4035  #else
4036  fputs( "\n computing NF...\n", stdout );
4037  #endif
4038  #endif
4039  #endif
4040 
4041  spectrumPolyList NF( &nph );
4042 
4043  computeNF( stdJ,hc,wc,&NF, currRing );
4044 
4045  #ifdef SPECTRUM_DEBUG
4046  #ifdef SPECTRUM_PRINT
4047  cout << NF;
4048  #ifdef SPECTRUM_IOSTREAM
4049  cout << endl;
4050  #else
4051  fputs( "\n", stdout );
4052  #endif
4053  #endif
4054  #endif
4055 
4056  // ----------------------------
4057  // compute the spectrum of h
4058  // ----------------------------
4059 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4060 
4061  return spectrumStateFromList(NF, L, fast );
4062 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define pSetm(p)
Definition: polys.h:265
Definition: tok.h:96
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
#define FALSE
Definition: auxiliary.h:94
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
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:2087
void pWrite(poly p)
Definition: polys.h:302
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:45
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3538
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:24
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
omBin slists_bin
Definition: lists.cc:23
#define pDiff(a, b)
Definition: polys.h:290
#define nInit(i)
Definition: numbers.h:25
static Poly * h
Definition: janet.cc:972
#define pCopy(p)
return a copy of the poly
Definition: polys.h:180
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4153 of file ipshell.cc.

4154 {
4155  spectrumState state = spectrumOK;
4156 
4157  // -------------------
4158  // check consistency
4159  // -------------------
4160 
4161  // check for a local polynomial ring
4162 
4163  if( currRing->OrdSgn != -1 )
4164  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4165  // or should we use:
4166  //if( !ringIsLocal( ) )
4167  {
4168  WerrorS( "only works for local orderings" );
4169  state = spectrumWrongRing;
4170  }
4171  else if( currRing->qideal != NULL )
4172  {
4173  WerrorS( "does not work in quotient rings" );
4174  state = spectrumWrongRing;
4175  }
4176  else
4177  {
4178  lists L = (lists)NULL;
4179  int flag = 2; // symmetric optimization
4180 
4181  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4182 
4183  if( state==spectrumOK )
4184  {
4185  result->rtyp = LIST_CMD;
4186  result->data = (char*)L;
4187  }
4188  else
4189  {
4190  spectrumPrintError(state);
4191  }
4192  }
4193 
4194  return (state!=spectrumOK);
4195 }
spectrumState
Definition: ipshell.cc:3519
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4071
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3779
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3353 of file ipshell.cc.

3354 {
3355  spectrum result;
3356  copy_deep( result, l );
3357  return result;
3358 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3329
int l
Definition: cfEzgcd.cc:93
return result
Definition: facAbsBiFact.cc:76

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4071 of file ipshell.cc.

4072 {
4073  switch( state )
4074  {
4075  case spectrumZero:
4076  WerrorS( "polynomial is zero" );
4077  break;
4078  case spectrumBadPoly:
4079  WerrorS( "polynomial has constant term" );
4080  break;
4081  case spectrumNoSingularity:
4082  WerrorS( "not a singularity" );
4083  break;
4084  case spectrumNotIsolated:
4085  WerrorS( "the singularity is not isolated" );
4086  break;
4087  case spectrumNoHC:
4088  WerrorS( "highest corner cannot be computed" );
4089  break;
4090  case spectrumDegenerate:
4091  WerrorS( "principal part is degenerate" );
4092  break;
4093  case spectrumOK:
4094  break;
4095 
4096  default:
4097  WerrorS( "unknown error occurred" );
4098  break;
4099  }
4100 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4102 of file ipshell.cc.

4103 {
4104  spectrumState state = spectrumOK;
4105 
4106  // -------------------
4107  // check consistency
4108  // -------------------
4109 
4110  // check for a local ring
4111 
4112  if( !ringIsLocal(currRing ) )
4113  {
4114  WerrorS( "only works for local orderings" );
4115  state = spectrumWrongRing;
4116  }
4117 
4118  // no quotient rings are allowed
4119 
4120  else if( currRing->qideal != NULL )
4121  {
4122  WerrorS( "does not work in quotient rings" );
4123  state = spectrumWrongRing;
4124  }
4125  else
4126  {
4127  lists L = (lists)NULL;
4128  int flag = 1; // weight corner optimization is safe
4129 
4130  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4131 
4132  if( state==spectrumOK )
4133  {
4134  result->rtyp = LIST_CMD;
4135  result->data = (char*)L;
4136  }
4137  else
4138  {
4139  spectrumPrintError(state);
4140  }
4141  }
4142 
4143  return (state!=spectrumOK);
4144 }
spectrumState
Definition: ipshell.cc:3519
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4071
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3779
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
return result
Definition: facAbsBiFact.cc:76

◆ spectrumStateFromList()

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

Definition at line 3538 of file ipshell.cc.

3539 {
3540  spectrumPolyNode **node = &speclist.root;
3542 
3543  poly f,tmp;
3544  int found,cmp;
3545 
3546  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3547  ( fast==2 ? 2 : 1 ) );
3548 
3549  Rational weight_prev( 0,1 );
3550 
3551  int mu = 0; // the milnor number
3552  int pg = 0; // the geometrical genus
3553  int n = 0; // number of different spectral numbers
3554  int z = 0; // number of spectral number equal to smax
3555 
3556  while( (*node)!=(spectrumPolyNode*)NULL &&
3557  ( fast==0 || (*node)->weight<=smax ) )
3558  {
3559  // ---------------------------------------
3560  // determine the first normal form which
3561  // contains the monomial node->mon
3562  // ---------------------------------------
3563 
3564  found = FALSE;
3565  search = *node;
3566 
3567  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3568  {
3569  if( search->nf!=(poly)NULL )
3570  {
3571  f = search->nf;
3572 
3573  do
3574  {
3575  // --------------------------------
3576  // look for (*node)->mon in f
3577  // --------------------------------
3578 
3579  cmp = pCmp( (*node)->mon,f );
3580 
3581  if( cmp<0 )
3582  {
3583  f = pNext( f );
3584  }
3585  else if( cmp==0 )
3586  {
3587  // -----------------------------
3588  // we have found a normal form
3589  // -----------------------------
3590 
3591  found = TRUE;
3592 
3593  // normalize coefficient
3594 
3595  number inv = nInvers( pGetCoeff( f ) );
3596  search->nf=__p_Mult_nn( search->nf,inv,currRing );
3597  nDelete( &inv );
3598 
3599  // exchange normal forms
3600 
3601  tmp = (*node)->nf;
3602  (*node)->nf = search->nf;
3603  search->nf = tmp;
3604  }
3605  }
3606  while( cmp<0 && f!=(poly)NULL );
3607  }
3608  search = search->next;
3609  }
3610 
3611  if( found==FALSE )
3612  {
3613  // ------------------------------------------------
3614  // the weight of node->mon is a spectrum number
3615  // ------------------------------------------------
3616 
3617  mu++;
3618 
3619  if( (*node)->weight<=(Rational)1 ) pg++;
3620  if( (*node)->weight==smax ) z++;
3621  if( (*node)->weight>weight_prev ) n++;
3622 
3623  weight_prev = (*node)->weight;
3624  node = &((*node)->next);
3625  }
3626  else
3627  {
3628  // -----------------------------------------------
3629  // determine all other normal form which contain
3630  // the monomial node->mon
3631  // replace for node->mon its normal form
3632  // -----------------------------------------------
3633 
3634  while( search!=(spectrumPolyNode*)NULL )
3635  {
3636  if( search->nf!=(poly)NULL )
3637  {
3638  f = search->nf;
3639 
3640  do
3641  {
3642  // --------------------------------
3643  // look for (*node)->mon in f
3644  // --------------------------------
3645 
3646  cmp = pCmp( (*node)->mon,f );
3647 
3648  if( cmp<0 )
3649  {
3650  f = pNext( f );
3651  }
3652  else if( cmp==0 )
3653  {
3654  search->nf = pSub( search->nf,
3655  __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3656  pNorm( search->nf );
3657  }
3658  }
3659  while( cmp<0 && f!=(poly)NULL );
3660  }
3661  search = search->next;
3662  }
3663  speclist.delete_node( node );
3664  }
3665 
3666  }
3667 
3668  // --------------------------------------------------------
3669  // fast computation exploits the symmetry of the spectrum
3670  // --------------------------------------------------------
3671 
3672  if( fast==2 )
3673  {
3674  mu = 2*mu - z;
3675  n = ( z > 0 ? 2*n - 1 : 2*n );
3676  }
3677 
3678  // --------------------------------------------------------
3679  // compute the spectrum numbers with their multiplicities
3680  // --------------------------------------------------------
3681 
3682  intvec *nom = new intvec( n );
3683  intvec *den = new intvec( n );
3684  intvec *mult = new intvec( n );
3685 
3686  int count = 0;
3687  int multiplicity = 1;
3688 
3689  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3690  ( fast==0 || search->weight<=smax );
3691  search=search->next )
3692  {
3693  if( search->next==(spectrumPolyNode*)NULL ||
3694  search->weight<search->next->weight )
3695  {
3696  (*nom) [count] = search->weight.get_num_si( );
3697  (*den) [count] = search->weight.get_den_si( );
3698  (*mult)[count] = multiplicity;
3699 
3700  multiplicity=1;
3701  count++;
3702  }
3703  else
3704  {
3705  multiplicity++;
3706  }
3707  }
3708 
3709  // --------------------------------------------------------
3710  // fast computation exploits the symmetry of the spectrum
3711  // --------------------------------------------------------
3712 
3713  if( fast==2 )
3714  {
3715  int n1,n2;
3716  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3717  {
3718  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3719  (*den) [n2] = (*den)[n1];
3720  (*mult)[n2] = (*mult)[n1];
3721  }
3722  }
3723 
3724  // -----------------------------------
3725  // test if the spectrum is symmetric
3726  // -----------------------------------
3727 
3728  if( fast==0 || fast==1 )
3729  {
3730  int symmetric=TRUE;
3731 
3732  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3733  {
3734  if( (*mult)[n1]!=(*mult)[n2] ||
3735  (*den) [n1]!= (*den)[n2] ||
3736  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3737  {
3738  symmetric = FALSE;
3739  }
3740  }
3741 
3742  if( symmetric==FALSE )
3743  {
3744  // ---------------------------------------------
3745  // the spectrum is not symmetric => degenerate
3746  // principal part
3747  // ---------------------------------------------
3748 
3749  *L = (lists)omAllocBin( slists_bin);
3750  (*L)->Init( 1 );
3751  (*L)->m[0].rtyp = INT_CMD; // milnor number
3752  (*L)->m[0].data = (void*)(long)mu;
3753 
3754  return spectrumDegenerate;
3755  }
3756  }
3757 
3758  *L = (lists)omAllocBin( slists_bin);
3759 
3760  (*L)->Init( 6 );
3761 
3762  (*L)->m[0].rtyp = INT_CMD; // milnor number
3763  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3764  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3765  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3766  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3767  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3768 
3769  (*L)->m[0].data = (void*)(long)mu;
3770  (*L)->m[1].data = (void*)(long)pg;
3771  (*L)->m[2].data = (void*)(long)n;
3772  (*L)->m[3].data = (void*)nom;
3773  (*L)->m[4].data = (void*)den;
3774  (*L)->m[5].data = (void*)mult;
3775 
3776  return spectrumOK;
3777 }
int status int void size_t count
Definition: si_signals.h:59
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
void mu(int **points, int sizePoints)
Definition: tok.h:96
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:582
static int * multiplicity
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition: polys.h:115
#define TRUE
Definition: auxiliary.h:98
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:45
bool found
Definition: facFactorize.cc:56
spectrumPolyNode * root
Definition: splist.h:60
Definition: intvec.h:17
#define pSub(a, b)
Definition: polys.h:281
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
#define __pp_Mult_nn(p, n, r)
Definition: p_polys.h:959
FILE * f
Definition: checklibs.c:9
#define nDelete(n)
Definition: numbers.h:17
#define nInvers(a)
Definition: numbers.h:34
#define __p_Mult_nn(p, n, r)
Definition: p_polys.h:928
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
CanonicalForm den(const CanonicalForm &f)
void pNorm(poly p, const ring R=currRing)
Definition: polys.h:357
#define pNext(p)
Definition: monomials.h:37
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
omBin slists_bin
Definition: lists.cc:23
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256

◆ spmulProc()

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

Definition at line 4439 of file ipshell.cc.

4440 {
4441  semicState state;
4442 
4443  // -----------------
4444  // check arguments
4445  // -----------------
4446 
4447  lists l = (lists)first->Data( );
4448  int k = (int)(long)second->Data( );
4449 
4450  if( (state=list_is_spectrum( l ))!=semicOK )
4451  {
4452  WerrorS( "first argument is not a spectrum" );
4453  list_error( state );
4454  }
4455  else if( k < 0 )
4456  {
4457  WerrorS( "second argument should be positive" );
4458  state = semicMulNegative;
4459  }
4460  else
4461  {
4463  spectrum product( k*s );
4464 
4465  result->rtyp = LIST_CMD;
4466  result->data = (char*)getList(product);
4467  }
4468 
4469  return (state!=semicOK);
4470 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3353
void list_error(semicState state)
Definition: ipshell.cc:3437
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:92
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3365
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4222
semicState
Definition: ipshell.cc:3403
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1182
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:93

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3141 of file ipshell.cc.

3142 {
3143  sleftv tmp;
3144  memset(&tmp,0,sizeof(tmp));
3145  tmp.rtyp=INT_CMD;
3146  tmp.data=(void *)1;
3147  return syBetti2(res,u,&tmp);
3148 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
void * data
Definition: subexpr.h:88
CanonicalForm res
Definition: facAbsFact.cc:64
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3118
int rtyp
Definition: subexpr.h:91

◆ syBetti2()

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

Definition at line 3118 of file ipshell.cc.

3119 {
3120  syStrategy syzstr=(syStrategy)u->Data();
3121 
3122  BOOLEAN minim=(int)(long)w->Data();
3123  int row_shift=0;
3124  int add_row_shift=0;
3125  intvec *weights=NULL;
3126  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3127  if (ww!=NULL)
3128  {
3129  weights=ivCopy(ww);
3130  add_row_shift = ww->min_in();
3131  (*weights) -= add_row_shift;
3132  }
3133 
3134  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3135  //row_shift += add_row_shift;
3136  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3137  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3138 
3139  return FALSE;
3140 }
Definition: tok.h:96
#define FALSE
Definition: auxiliary.h:94
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
int min_in()
Definition: intvec.h:119
Definition: intvec.h:17
CanonicalForm res
Definition: facAbsFact.cc:64
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:152
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:131
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1756
const CanonicalForm & w
Definition: facAbsFact.cc:55
void * Data()
Definition: subexpr.cc:1182
int BOOLEAN
Definition: auxiliary.h:85
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3225 of file ipshell.cc.

3226 {
3227  int typ0;
3229 
3230  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3231  if (fr != NULL)
3232  {
3233 
3234  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3235  for (int i=result->length-1;i>=0;i--)
3236  {
3237  if (fr[i]!=NULL)
3238  result->fullres[i] = idCopy(fr[i]);
3239  }
3240  result->list_length=result->length;
3241  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3242  }
3243  else
3244  {
3245  omFreeSize(result, sizeof(ssyStrategy));
3246  result = NULL;
3247  }
3248  return result;
3249 }
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
int i
Definition: cfEzgcd.cc:125
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

◆ syConvRes()

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

Definition at line 3153 of file ipshell.cc.

3154 {
3155  resolvente fullres = syzstr->fullres;
3156  resolvente minres = syzstr->minres;
3157 
3158  const int length = syzstr->length;
3159 
3160  if ((fullres==NULL) && (minres==NULL))
3161  {
3162  if (syzstr->hilb_coeffs==NULL)
3163  { // La Scala
3164  fullres = syReorder(syzstr->res, length, syzstr);
3165  }
3166  else
3167  { // HRES
3168  minres = syReorder(syzstr->orderedRes, length, syzstr);
3169  syKillEmptyEntres(minres, length);
3170  }
3171  }
3172 
3173  resolvente tr;
3174  int typ0=IDEAL_CMD;
3175 
3176  if (minres!=NULL)
3177  tr = minres;
3178  else
3179  tr = fullres;
3180 
3181  resolvente trueres=NULL;
3182  intvec ** w=NULL;
3183 
3184  if (length>0)
3185  {
3186  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3187  for (int i=length-1;i>=0;i--)
3188  {
3189  if (tr[i]!=NULL)
3190  {
3191  trueres[i] = idCopy(tr[i]);
3192  }
3193  }
3194  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3195  typ0 = MODUL_CMD;
3196  if (syzstr->weights!=NULL)
3197  {
3198  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3199  for (int i=length-1;i>=0;i--)
3200  {
3201  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3202  }
3203  }
3204  }
3205 
3206  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3207  w, add_row_shift);
3208 
3209  if (toDel)
3210  syKillComputation(syzstr);
3211  else
3212  {
3213  if( fullres != NULL && syzstr->fullres == NULL )
3214  syzstr->fullres = fullres;
3215 
3216  if( minres != NULL && syzstr->minres == NULL )
3217  syzstr->minres = minres;
3218  }
3219  return li;
3220 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1642
Definition: lists.h:22
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:17
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
int i
Definition: cfEzgcd.cc:125
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:60
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
const CanonicalForm & w
Definition: facAbsFact.cc:55
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2201
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1496
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3254 of file ipshell.cc.

3255 {
3256  int typ0;
3258 
3259  resolvente fr = liFindRes(li,&(result->length),&typ0);
3260  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3261  for (int i=result->length-1;i>=0;i--)
3262  {
3263  if (fr[i]!=NULL)
3264  result->minres[i] = idCopy(fr[i]);
3265  }
3266  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3267  return result;
3268 }
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
int i
Definition: cfEzgcd.cc:125
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 511 of file ipshell.cc.

512 {
513  int ii;
514 
515  if (i<0)
516  {
517  ii= -i;
518  if (ii < 32)
519  {
520  si_opt_1 &= ~Sy_bit(ii);
521  }
522  else if (ii < 64)
523  {
524  si_opt_2 &= ~Sy_bit(ii-32);
525  }
526  else
527  WerrorS("out of bounds\n");
528  }
529  else if (i<32)
530  {
531  ii=i;
532  if (Sy_bit(ii) & kOptions)
533  {
534  WarnS("Gerhard, use the option command");
535  si_opt_1 |= Sy_bit(ii);
536  }
537  else if (Sy_bit(ii) & validOpts)
538  si_opt_1 |= Sy_bit(ii);
539  }
540  else if (i<64)
541  {
542  ii=i-32;
543  si_opt_2 |= Sy_bit(ii);
544  }
545  else
546  WerrorS("out of bounds\n");
547 }
unsigned si_opt_1
Definition: options.c:5
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:78
#define Sy_bit(x)
Definition: options.h:32
BITSET validOpts
Definition: kstd1.cc:59
int i
Definition: cfEzgcd.cc:125
BITSET kOptions
Definition: kstd1.cc:44
unsigned si_opt_2
Definition: options.c:6

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 251 of file ipshell.cc.

252 {
253  BOOLEAN oldShortOut = FALSE;
254 
255  if (currRing != NULL)
256  {
257  oldShortOut = currRing->ShortOut;
258  currRing->ShortOut = 1;
259  }
260  int t=v->Typ();
261  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
262  switch (t)
263  {
264  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
265  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
266  ((intvec*)(v->Data()))->cols()); break;
267  case MATRIX_CMD:Print(" %u x %u\n" ,
268  MATROWS((matrix)(v->Data())),
269  MATCOLS((matrix)(v->Data())));break;
270  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
271  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
272 
273  case PROC_CMD:
274  case RING_CMD:
275  case IDEAL_CMD: PrintLn(); break;
276 
277  //case INT_CMD:
278  //case STRING_CMD:
279  //case INTVEC_CMD:
280  //case POLY_CMD:
281  //case VECTOR_CMD:
282  //case PACKAGE_CMD:
283 
284  default:
285  break;
286  }
287  v->Print();
288  if (currRing != NULL)
289  currRing->ShortOut = oldShortOut;
290 }
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:400
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
Definition: intvec.h:17
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define MATCOLS(i)
Definition: matpol.h:27
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Definition: tok.h:118
#define MATROWS(i)
Definition: matpol.h:26
int BOOLEAN
Definition: auxiliary.h:85

Variable Documentation

◆ iiCurrArgs

leftv iiCurrArgs =NULL

Definition at line 78 of file ipshell.cc.

◆ iiCurrProc

idhdl iiCurrProc =NULL

Definition at line 79 of file ipshell.cc.

◆ iiDebugMarker

BOOLEAN iiDebugMarker =TRUE

Definition at line 987 of file ipshell.cc.

◆ iiNoKeepRing

BOOLEAN iiNoKeepRing =TRUE
static

Definition at line 82 of file ipshell.cc.

◆ lastreserved

const char* lastreserved =NULL

Definition at line 80 of file ipshell.cc.

◆ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5562 of file ipshell.cc.