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 <math.h>
#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 res, 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)
 
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 983 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 3360 of file ipshell.cc.

3361 {
3362  semicOK,
3364 
3367 
3374 
3379 
3385 
3388 
3391 
3392 } semicState;
semicState
Definition: ipshell.cc:3360

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3476 of file ipshell.cc.

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3286 of file ipshell.cc.

3287 {
3288  spec.mu = (int)(long)(l->m[0].Data( ));
3289  spec.pg = (int)(long)(l->m[1].Data( ));
3290  spec.n = (int)(long)(l->m[2].Data( ));
3291 
3292  spec.copy_new( spec.n );
3293 
3294  intvec *num = (intvec*)l->m[3].Data( );
3295  intvec *den = (intvec*)l->m[4].Data( );
3296  intvec *mul = (intvec*)l->m[5].Data( );
3297 
3298  for( int i=0; i<spec.n; i++ )
3299  {
3300  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3301  spec.w[i] = (*mul)[i];
3302  }
3303 }
sleftv * m
Definition: lists.h:45
CanonicalForm num(const CanonicalForm &f)
Rational * s
Definition: semic.h:70
int pg
Definition: semic.h:68
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
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
void * Data()
Definition: subexpr.cc:1137
int * w
Definition: semic.h:71

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 544 of file ipshell.cc.

545 {
546  int rc = 0;
547  while (v!=NULL)
548  {
549  switch (v->Typ())
550  {
551  case INT_CMD:
552  case POLY_CMD:
553  case VECTOR_CMD:
554  case NUMBER_CMD:
555  rc++;
556  break;
557  case INTVEC_CMD:
558  case INTMAT_CMD:
559  rc += ((intvec *)(v->Data()))->length();
560  break;
561  case MATRIX_CMD:
562  case IDEAL_CMD:
563  case MODUL_CMD:
564  {
565  matrix mm = (matrix)(v->Data());
566  rc += mm->rows() * mm->cols();
567  }
568  break;
569  case LIST_CMD:
570  rc+=((lists)v->Data())->nr+1;
571  break;
572  default:
573  rc++;
574  }
575  v = v->next;
576  }
577  return rc;
578 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:95
int Typ()
Definition: subexpr.cc:995
Definition: intvec.h:14
ip_smatrix * matrix
leftv next
Definition: subexpr.h:86
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117

◆ getList()

lists getList ( spectrum spec)

Definition at line 3322 of file ipshell.cc.

3323 {
3325 
3326  L->Init( 6 );
3327 
3328  intvec *num = new intvec( spec.n );
3329  intvec *den = new intvec( spec.n );
3330  intvec *mult = new intvec( spec.n );
3331 
3332  for( int i=0; i<spec.n; i++ )
3333  {
3334  (*num) [i] = spec.s[i].get_num_si( );
3335  (*den) [i] = spec.s[i].get_den_si( );
3336  (*mult)[i] = spec.w[i];
3337  }
3338 
3339  L->m[0].rtyp = INT_CMD; // milnor number
3340  L->m[1].rtyp = INT_CMD; // geometrical genus
3341  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3342  L->m[3].rtyp = INTVEC_CMD; // numerators
3343  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3344  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3345 
3346  L->m[0].data = (void*)(long)spec.mu;
3347  L->m[1].data = (void*)(long)spec.pg;
3348  L->m[2].data = (void*)(long)spec.n;
3349  L->m[3].data = (void*)num;
3350  L->m[4].data = (void*)den;
3351  L->m[5].data = (void*)mult;
3352 
3353  return L;
3354 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
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:159
int get_num_si()
Definition: GMPrat.cc:145
void * data
Definition: subexpr.h:88
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
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:649
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 6327 of file ipshell.cc.

6328 {
6329  memset(res,0,sizeof(sleftv));
6330  res->rtyp=a->Typ();
6331  switch (res->rtyp /*a->Typ()*/)
6332  {
6333  case INTVEC_CMD:
6334  case INTMAT_CMD:
6335  return iiApplyINTVEC(res,a,op,proc);
6336  case BIGINTMAT_CMD:
6337  return iiApplyBIGINTMAT(res,a,op,proc);
6338  case IDEAL_CMD:
6339  case MODUL_CMD:
6340  case MATRIX_CMD:
6341  return iiApplyIDEAL(res,a,op,proc);
6342  case LIST_CMD:
6343  return iiApplyLIST(res,a,op,proc);
6344  }
6345  WerrorS("first argument to `apply` must allow an index");
6346  return TRUE;
6347 }
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:995
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6285
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6295
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6290
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6253

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6285 of file ipshell.cc.

6286 {
6287  WerrorS("not implemented");
6288  return TRUE;
6289 }
#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 6290 of file ipshell.cc.

6291 {
6292  WerrorS("not implemented");
6293  return TRUE;
6294 }
#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 6253 of file ipshell.cc.

6254 {
6255  intvec *aa=(intvec*)a->Data();
6256  sleftv tmp_out;
6257  sleftv tmp_in;
6258  leftv curr=res;
6259  BOOLEAN bo=FALSE;
6260  for(int i=0;i<aa->length(); i++)
6261  {
6262  memset(&tmp_in,0,sizeof(tmp_in));
6263  tmp_in.rtyp=INT_CMD;
6264  tmp_in.data=(void*)(long)(*aa)[i];
6265  if (proc==NULL)
6266  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6267  else
6268  bo=jjPROC(&tmp_out,proc,&tmp_in);
6269  if (bo)
6270  {
6271  res->CleanUp(currRing);
6272  Werror("apply fails at index %d",i+1);
6273  return TRUE;
6274  }
6275  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6276  else
6277  {
6278  curr->next=(leftv)omAllocBin(sleftv_bin);
6279  curr=curr->next;
6280  memcpy(curr,&tmp_out,sizeof(tmp_out));
6281  }
6282  }
6283  return FALSE;
6284 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8319
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void * data
Definition: subexpr.h:88
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
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 6295 of file ipshell.cc.

6296 {
6297  lists aa=(lists)a->Data();
6298  sleftv tmp_out;
6299  sleftv tmp_in;
6300  leftv curr=res;
6301  BOOLEAN bo=FALSE;
6302  for(int i=0;i<=aa->nr; i++)
6303  {
6304  memset(&tmp_in,0,sizeof(tmp_in));
6305  tmp_in.Copy(&(aa->m[i]));
6306  if (proc==NULL)
6307  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6308  else
6309  bo=jjPROC(&tmp_out,proc,&tmp_in);
6310  tmp_in.CleanUp();
6311  if (bo)
6312  {
6313  res->CleanUp(currRing);
6314  Werror("apply fails at index %d",i+1);
6315  return TRUE;
6316  }
6317  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6318  else
6319  {
6320  curr->next=(leftv)omAllocBin(sleftv_bin);
6321  curr=curr->next;
6322  memcpy(curr,&tmp_out,sizeof(tmp_out));
6323  }
6324  }
6325  return FALSE;
6326 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
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:8319
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void Copy(leftv e)
Definition: subexpr.cc:688
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
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:332
void * Data()
Definition: subexpr.cc:1137
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 6376 of file ipshell.cc.

6377 {
6378  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6379  // find end of s:
6380  int end_s=strlen(s);
6381  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6382  s[end_s+1]='\0';
6383  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6384  sprintf(name,"%s->%s",a,s);
6385  // find start of last expression
6386  int start_s=end_s-1;
6387  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6388  if (start_s<0) // ';' not found
6389  {
6390  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6391  }
6392  else // s[start_s] is ';'
6393  {
6394  s[start_s]='\0';
6395  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6396  }
6397  memset(r,0,sizeof(*r));
6398  // now produce procinfo for PROC_CMD:
6399  r->data = (void *)omAlloc0Bin(procinfo_bin);
6400  ((procinfo *)(r->data))->language=LANG_NONE;
6401  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6402  ((procinfo *)r->data)->data.s.body=ss;
6403  omFree(name);
6404  r->rtyp=PROC_CMD;
6405  //r->rtyp=STRING_CMD;
6406  //r->data=ss;
6407  return FALSE;
6408 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
#define FALSE
Definition: auxiliary.h:94
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1009
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
void * data
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
char name(const Variable &v)
Definition: factory.h:178
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int rtyp
Definition: subexpr.h:91

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6410 of file ipshell.cc.

6411 {
6412  char* ring_name=omStrDup((char*)r->Name());
6413  int t=arg->Typ();
6414  if (t==RING_CMD)
6415  {
6416  sleftv tmp;
6417  memset(&tmp,0,sizeof(tmp));
6418  tmp.rtyp=IDHDL;
6419  tmp.data=(char*)rDefault(ring_name);
6420  if (tmp.data!=NULL)
6421  {
6422  BOOLEAN b=iiAssign(&tmp,arg);
6423  if (b) return TRUE;
6424  rSetHdl(ggetid(ring_name));
6425  omFree(ring_name);
6426  return FALSE;
6427  }
6428  else
6429  return TRUE;
6430  }
6431  else if (t==CRING_CMD)
6432  {
6433  sleftv tmp;
6434  sleftv n;
6435  memset(&n,0,sizeof(n));
6436  n.name=ring_name;
6437  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6438  if (iiAssign(&tmp,arg)) return TRUE;
6439  //Print("create %s\n",r->Name());
6440  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6441  return FALSE;
6442  }
6443  //Print("create %s\n",r->Name());
6444  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6445  return TRUE;// not handled -> error for now
6446 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:120
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1549
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
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:1122
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
void rSetHdl(idhdl h)
Definition: ipshell.cc:5038
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  res,
leftv  args 
)

Definition at line 1179 of file ipshell.cc.

1180 {
1181  // must be inside a proc, as we simultae an proc_end at the end
1182  if (myynest==0)
1183  {
1184  WerrorS("branchTo can only occur in a proc");
1185  return TRUE;
1186  }
1187  // <string1...stringN>,<proc>
1188  // known: args!=NULL, l>=1
1189  int l=args->listLength();
1190  int ll=0;
1191  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1192  if (ll!=(l-1)) return FALSE;
1193  leftv h=args;
1194  // set up the table for type test:
1195  short *t=(short*)omAlloc(l*sizeof(short));
1196  t[0]=l-1;
1197  int b;
1198  int i;
1199  for(i=1;i<l;i++,h=h->next)
1200  {
1201  if (h->Typ()!=STRING_CMD)
1202  {
1203  omFree(t);
1204  Werror("arg %d is not a string",i);
1205  return TRUE;
1206  }
1207  int tt;
1208  b=IsCmd((char *)h->Data(),tt);
1209  if(b) t[i]=tt;
1210  else
1211  {
1212  omFree(t);
1213  Werror("arg %d is not a type name",i);
1214  return TRUE;
1215  }
1216  }
1217  if (h->Typ()!=PROC_CMD)
1218  {
1219  omFree(t);
1220  Werror("last arg (%d) is not a proc(%d), nest=%d",i,h->Typ(),myynest);
1221  return TRUE;
1222  }
1223  b=iiCheckTypes(iiCurrArgs,t,0);
1224  omFree(t);
1225  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1226  {
1227  // get the proc:
1228  iiCurrProc=(idhdl)h->data;
1230  // already loaded ?
1231  if( pi->data.s.body==NULL )
1232  {
1234  if (pi->data.s.body==NULL) return TRUE;
1235  }
1236  // set currPackHdl/currPack
1237  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1238  {
1239  currPack=pi->pack;
1242  //Print("set pack=%s\n",IDID(currPackHdl));
1243  }
1244  // see iiAllStart:
1245  BITSET save1=si_opt_1;
1246  BITSET save2=si_opt_2;
1247  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1248  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1249  BOOLEAN err=yyparse();
1250  si_opt_1=save1;
1251  si_opt_2=save2;
1252  // now save the return-expr.
1254  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1255  iiRETURNEXPR.Init();
1256  // warning about args.:
1257  if (iiCurrArgs!=NULL)
1258  {
1259  if (err==0) Warn("too many arguments for %s",IDID(iiCurrProc));
1260  iiCurrArgs->CleanUp();
1262  iiCurrArgs=NULL;
1263  }
1264  // similate proc_end:
1265  // - leave input
1266  void myychangebuffer();
1267  myychangebuffer();
1268  // - set the current buffer to its end (this is a pointer in a buffer,
1269  // not a file ptr) "branchTo" is only valid in proc)
1271  // - kill local vars
1273  // - return
1274  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1275  return (err!=0);
1276  }
1277  return FALSE;
1278 }
long fptr
Definition: fevoices.h:70
void myychangebuffer()
Definition: scanner.cc:2333
unsigned si_opt_1
Definition: options.c:5
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
idhdl currPackHdl
Definition: ipid.cc:61
char * buffer
Definition: fevoices.h:69
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
void * ADDRESS
Definition: auxiliary.h:115
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:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define omFree(addr)
Definition: omAllocDecl.h:261
void killlocals(int v)
Definition: ipshell.cc:378
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
int yyparse(void)
Definition: grammar.cc:2101
leftv next
Definition: subexpr.h:86
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
Voice * currentVoice
Definition: fevoices.cc:57
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:6466
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
idhdl packFindHdl(package r)
Definition: ipid.cc:739
void iiCheckPack(package &p)
Definition: ipshell.cc:1535
#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:210
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8729
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1535 of file ipshell.cc.

1536 {
1537  if (p!=basePack)
1538  {
1539  idhdl t=basePack->idroot;
1540  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1541  if (t==NULL)
1542  {
1543  WarnS("package not found\n");
1544  p=basePack;
1545  }
1546  }
1547 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1491 of file ipshell.cc.

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

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

6467 {
6468  if (args==NULL)
6469  {
6470  if (type_list[0]==0) return TRUE;
6471  else
6472  {
6473  if (report) WerrorS("no arguments expected");
6474  return FALSE;
6475  }
6476  }
6477  int l=args->listLength();
6478  if (l!=(int)type_list[0])
6479  {
6480  if (report) iiReportTypes(0,l,type_list);
6481  return FALSE;
6482  }
6483  for(int i=1;i<=l;i++,args=args->next)
6484  {
6485  short t=type_list[i];
6486  if (t!=ANY_TYPE)
6487  {
6488  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6489  || (t!=args->Typ()))
6490  {
6491  if (report) iiReportTypes(i,args->Typ(),type_list);
6492  return FALSE;
6493  }
6494  }
6495  }
6496  return TRUE;
6497 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define IDHDL
Definition: tok.h:31
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6448
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 855 of file ipshell.cc.

856 {
857  int i;
858  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
859 
860  for (i=0; i<l; i++)
861  if (r[i]!=NULL) res[i]=idCopy(r[i]);
862  return res;
863 }
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
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:94

◆ iiDebug()

void iiDebug ( )

Definition at line 984 of file ipshell.cc.

985 {
986 #ifdef HAVE_SDB
987  sdb_flags=1;
988 #endif
989  Print("\n-- break point in %s --\n",VoiceName());
991  char * s;
993  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
994  loop
995  {
996  memset(s,0,80);
998  if (s[BREAK_LINE_LENGTH-1]!='\0')
999  {
1000  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1001  }
1002  else
1003  break;
1004  }
1005  if (*s=='\n')
1006  {
1008  }
1009 #if MDEBUG
1010  else if(strncmp(s,"cont;",5)==0)
1011  {
1013  }
1014 #endif /* MDEBUG */
1015  else
1016  {
1017  strcat( s, "\n;~\n");
1018  newBuffer(s,BT_execute);
1019  }
1020 }
void VoiceBackTrack()
Definition: fevoices.cc:77
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:83
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:982
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:983
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171

◆ iiDeclCommand()

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

Definition at line 1122 of file ipshell.cc.

1123 {
1124  BOOLEAN res=FALSE;
1125  const char *id = name->name;
1126 
1127  memset(sy,0,sizeof(sleftv));
1128  if ((name->name==NULL)||(isdigit(name->name[0])))
1129  {
1130  WerrorS("object to declare is not a name");
1131  res=TRUE;
1132  }
1133  else
1134  {
1135  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1136 
1137  if (TEST_V_ALLWARN
1138  && (name->rtyp!=0)
1139  && (name->rtyp!=IDHDL)
1140  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1141  {
1142  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1144  }
1145  {
1146  sy->data = (char *)enterid(id,lev,t,root,init_b);
1147  }
1148  if (sy->data!=NULL)
1149  {
1150  sy->rtyp=IDHDL;
1151  currid=sy->name=IDID((idhdl)sy->data);
1152  // name->name=NULL; /* used in enterid */
1153  //sy->e = NULL;
1154  if (name->next!=NULL)
1155  {
1157  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1158  }
1159  }
1160  else res=TRUE;
1161  }
1162  name->CleanUp();
1163  return res;
1164 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
int yylineno
Definition: febase.cc:45
#define IDID(a)
Definition: ipid.h:119
#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
poly res
Definition: myNF.cc:322
int myynest
Definition: febase.cc:46
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:87
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
#define IDLEV(a)
Definition: ipid.h:118
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:1122
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
Definition: tok.h:157
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1166 of file ipshell.cc.

1167 {
1168  attr at=NULL;
1169  if (iiCurrProc!=NULL)
1170  at=iiCurrProc->attribute->get("default_arg");
1171  if (at==NULL)
1172  return FALSE;
1173  sleftv tmp;
1174  memset(&tmp,0,sizeof(sleftv));
1175  tmp.rtyp=at->atyp;
1176  tmp.data=at->CopyA();
1177  return iiAssign(p,&tmp);
1178 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:94
idhdl iiCurrProc
Definition: ipshell.cc:79
void * data
Definition: subexpr.h:88
void * CopyA()
Definition: subexpr.cc:1952
#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:98
int atyp
Definition: attrib.h:22
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1413 of file ipshell.cc.

1414 {
1415  BOOLEAN nok=FALSE;
1416  leftv r=v;
1417  while (v!=NULL)
1418  {
1419  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1420  {
1421  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1422  nok=TRUE;
1423  }
1424  else
1425  {
1426  if(iiInternalExport(v, toLev))
1427  {
1428  r->CleanUp();
1429  return TRUE;
1430  }
1431  }
1432  v=v->next;
1433  }
1434  r->CleanUp();
1435  return nok;
1436 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Subexpr e
Definition: subexpr.h:105
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:87
leftv next
Definition: subexpr.h:86
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
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 1439 of file ipshell.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1511 of file ipshell.cc.

1512 {
1513  int i;
1514  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1515  poly po=NULL;
1517  {
1518  scComputeHC(I,currRing->qideal,ak,po);
1519  if (po!=NULL)
1520  {
1521  pGetCoeff(po)=nInit(1);
1522  for (i=rVar(currRing); i>0; i--)
1523  {
1524  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1525  }
1526  pSetComp(po,ak);
1527  pSetm(po);
1528  }
1529  }
1530  else
1531  po=pOne();
1532  return po;
1533 }
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:752
#define pSetm(p)
Definition: polys.h:253
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
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:51
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:177
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:297
#define NULL
Definition: omList.c:10
strat ak
Definition: myNF.cc:321
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24

◆ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1315 of file ipshell.cc.

1316 {
1317  idhdl h=(idhdl)v->data;
1318  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1319  if (IDLEV(h)==0)
1320  {
1321  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1322  }
1323  else
1324  {
1325  h=IDROOT->get(v->name,toLev);
1326  idhdl *root=&IDROOT;
1327  if ((h==NULL)&&(currRing!=NULL))
1328  {
1329  h=currRing->idroot->get(v->name,toLev);
1330  root=&currRing->idroot;
1331  }
1332  BOOLEAN keepring=FALSE;
1333  if ((h!=NULL)&&(IDLEV(h)==toLev))
1334  {
1335  if (IDTYP(h)==v->Typ())
1336  {
1337  if ((IDTYP(h)==RING_CMD)
1338  && (v->Data()==IDDATA(h)))
1339  {
1340  IDRING(h)->ref++;
1341  keepring=TRUE;
1342  IDLEV(h)=toLev;
1343  //WarnS("keepring");
1344  return FALSE;
1345  }
1346  if (BVERBOSE(V_REDEFINE))
1347  {
1348  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1349  }
1350  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1351  killhdl2(h,root,currRing);
1352  }
1353  else
1354  {
1355  return TRUE;
1356  }
1357  }
1358  h=(idhdl)v->data;
1359  IDLEV(h)=toLev;
1360  if (keepring) IDRING(h)->ref--;
1362  //Print("export %s\n",IDID(h));
1363  }
1364  return FALSE;
1365 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:87
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
idrec * idhdl
Definition: ring.h:18
#define IDLEV(a)
Definition: ipid.h:118
#define BVERBOSE(a)
Definition: options.h:33
ring * iiLocalRing
Definition: iplib.cc:472
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
void * Data()
Definition: subexpr.cc:1137
#define IDDATA(a)
Definition: ipid.h:123
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
#define V_REDEFINE
Definition: options.h:43
#define Warn
Definition: emacs.cc:80

◆ iiInternalExport() [2/2]

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

Definition at line 1367 of file ipshell.cc.

1368 {
1369  idhdl h=(idhdl)v->data;
1370  if(h==NULL)
1371  {
1372  Warn("'%s': no such identifier\n", v->name);
1373  return FALSE;
1374  }
1375  package frompack=v->req_packhdl;
1376  if (frompack==NULL) frompack=currPack;
1377  if ((RingDependend(IDTYP(h)))
1378  || ((IDTYP(h)==LIST_CMD)
1379  && (lRingDependend(IDLIST(h)))
1380  )
1381  )
1382  {
1383  //Print("// ==> Ringdependent set nesting to 0\n");
1384  return (iiInternalExport(v, toLev));
1385  }
1386  else
1387  {
1388  IDLEV(h)=toLev;
1389  v->req_packhdl=rootpack;
1390  if (h==frompack->idroot)
1391  {
1392  frompack->idroot=h->next;
1393  }
1394  else
1395  {
1396  idhdl hh=frompack->idroot;
1397  while ((hh!=NULL) && (hh->next!=h))
1398  hh=hh->next;
1399  if ((hh!=NULL) && (hh->next==h))
1400  hh->next=h->next;
1401  else
1402  {
1403  Werror("`%s` not found",v->Name());
1404  return TRUE;
1405  }
1406  }
1407  h->next=rootpack->idroot;
1408  rootpack->idroot=h;
1409  }
1410  return FALSE;
1411 }
#define IDLIST(a)
Definition: ipid.h:134
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const char * Name()
Definition: subexpr.h:120
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:87
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
#define IDLEV(a)
Definition: ipid.h:118
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:106
package currPack
Definition: ipid.cc:63
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80

◆ iiMakeResolv()

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

Definition at line 766 of file ipshell.cc.

768 {
769  lists L=liMakeResolv(r,length,rlen,typ0,weights);
770  int i=0;
771  idhdl h;
772  char * s=(char *)omAlloc(strlen(name)+5);
773 
774  while (i<=L->nr)
775  {
776  sprintf(s,"%s(%d)",name,i+1);
777  if (i==0)
778  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
779  else
780  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
781  if (h!=NULL)
782  {
783  h->data.uideal=(ideal)L->m[i].data;
784  h->attribute=L->m[i].attribute;
786  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
787  }
788  else
789  {
790  idDelete((ideal *)&(L->m[i].data));
791  Warn("cannot define %s",s);
792  }
793  //L->m[i].data=NULL;
794  //L->m[i].rtyp=0;
795  //L->m[i].attribute=NULL;
796  i++;
797  }
798  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
800  omFreeSize((ADDRESS)s,strlen(name)+5);
801 }
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:83
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:94
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: factory.h:178
#define BVERBOSE(a)
Definition: options.h:33
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:215
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:978
utypes data
Definition: idrec.h:40
#define Warn
Definition: emacs.cc:80

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 607 of file ipshell.cc.

608 {
609  idhdl w,r;
610  leftv v;
611  int i;
612  nMapFunc nMap;
613 
614  r=IDROOT->get(theMap->preimage,myynest);
615  if ((currPack!=basePack)
616  &&((r==NULL) || ((r->typ != RING_CMD) )))
617  r=basePack->idroot->get(theMap->preimage,myynest);
618  if ((r==NULL) && (currRingHdl!=NULL)
619  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
620  {
621  r=currRingHdl;
622  }
623  if ((r!=NULL) && (r->typ == RING_CMD))
624  {
625  ring src_ring=IDRING(r);
626  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
627  {
628  Werror("can not map from ground field of %s to current ground field",
629  theMap->preimage);
630  return NULL;
631  }
632  if (IDELEMS(theMap)<src_ring->N)
633  {
634  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
635  IDELEMS(theMap)*sizeof(poly),
636  (src_ring->N)*sizeof(poly));
637  for(i=IDELEMS(theMap);i<src_ring->N;i++)
638  theMap->m[i]=NULL;
639  IDELEMS(theMap)=src_ring->N;
640  }
641  if (what==NULL)
642  {
643  WerrorS("argument of a map must have a name");
644  }
645  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
646  {
647  char *save_r=NULL;
649  sleftv tmpW;
650  memset(&tmpW,0,sizeof(sleftv));
651  tmpW.rtyp=IDTYP(w);
652  if (tmpW.rtyp==MAP_CMD)
653  {
654  tmpW.rtyp=IDEAL_CMD;
655  save_r=IDMAP(w)->preimage;
656  IDMAP(w)->preimage=0;
657  }
658  tmpW.data=IDDATA(w);
659  // check overflow
660  BOOLEAN overflow=FALSE;
661  if ((tmpW.rtyp==IDEAL_CMD)
662  || (tmpW.rtyp==MODUL_CMD)
663  || (tmpW.rtyp==MAP_CMD))
664  {
665  ideal id=(ideal)tmpW.data;
666  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
667  for(int i=IDELEMS(id)-1;i>=0;i--)
668  {
669  poly p=id->m[i];
670  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
671  else degs[i]=0;
672  }
673  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
674  {
675  if (theMap->m[j]!=NULL)
676  {
677  long deg_monexp=pTotaldegree(theMap->m[j]);
678 
679  for(int i=IDELEMS(id)-1;i>=0;i--)
680  {
681  poly p=id->m[i];
682  if ((p!=NULL) && (degs[i]!=0) &&
683  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
684  {
685  overflow=TRUE;
686  break;
687  }
688  }
689  }
690  }
691  omFreeSize(degs,IDELEMS(id)*sizeof(long));
692  }
693  else if (tmpW.rtyp==POLY_CMD)
694  {
695  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
696  {
697  if (theMap->m[j]!=NULL)
698  {
699  long deg_monexp=pTotaldegree(theMap->m[j]);
700  poly p=(poly)tmpW.data;
701  long deg=0;
702  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
703  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
704  {
705  overflow=TRUE;
706  break;
707  }
708  }
709  }
710  }
711  if (overflow)
712  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
713 #if 0
714  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
715  {
716  v->rtyp=tmpW.rtyp;
717  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
718  }
719  else
720 #endif
721  {
722  if ((tmpW.rtyp==IDEAL_CMD)
723  ||(tmpW.rtyp==MODUL_CMD)
724  ||(tmpW.rtyp==MATRIX_CMD)
725  ||(tmpW.rtyp==MAP_CMD))
726  {
727  v->rtyp=tmpW.rtyp;
728  char *tmp = theMap->preimage;
729  theMap->preimage=(char*)1L;
730  // map gets 1 as its rank (as an ideal)
731  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
732  theMap->preimage=tmp; // map gets its preimage back
733  }
734  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
735  {
736  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
737  {
738  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
740  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
741  return NULL;
742  }
743  }
744  }
745  if (save_r!=NULL)
746  {
747  IDMAP(w)->preimage=save_r;
748  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
749  v->rtyp=MAP_CMD;
750  }
751  return v;
752  }
753  else
754  {
755  Werror("%s undefined in %s",what,theMap->preimage);
756  }
757  }
758  else
759  {
760  Werror("cannot find preimage %s",theMap->preimage);
761  }
762  return NULL;
763 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:20
#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:49
#define IDIDEAL(a)
Definition: ipid.h:130
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1430
void * ADDRESS
Definition: auxiliary.h:115
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
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
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
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:264
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:65
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
#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:725
#define IDMAP(a)
Definition: ipid.h:132
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
poly * polyset
Definition: hutil.h:15
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:91
int typ
Definition: idrec.h:43
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:123
#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:80
#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 1279 of file ipshell.cc.

1280 {
1281  if (iiCurrArgs==NULL)
1282  {
1283  if (strcmp(p->name,"#")==0)
1284  return iiDefaultParameter(p);
1285  Werror("not enough arguments for proc %s",VoiceName());
1286  p->CleanUp();
1287  return TRUE;
1288  }
1289  leftv h=iiCurrArgs;
1290  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1291  BOOLEAN is_default_list=FALSE;
1292  if (strcmp(p->name,"#")==0)
1293  {
1294  is_default_list=TRUE;
1295  rest=NULL;
1296  }
1297  else
1298  {
1299  h->next=NULL;
1300  }
1301  BOOLEAN res=iiAssign(p,h);
1302  if (is_default_list)
1303  {
1304  iiCurrArgs=NULL;
1305  }
1306  else
1307  {
1308  iiCurrArgs=rest;
1309  }
1310  h->CleanUp();
1312  return res;
1313 }
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:115
poly res
Definition: myNF.cc:322
const char * name
Definition: subexpr.h:87
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1166
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
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:1793

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 956 of file ipshell.cc.

957 {
958  int len,reg,typ0;
959 
960  resolvente r=liFindRes(L,&len,&typ0);
961 
962  if (r==NULL)
963  return -2;
964  intvec *weights=NULL;
965  int add_row_shift=0;
966  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
967  if (ww!=NULL)
968  {
969  weights=ivCopy(ww);
970  add_row_shift = ww->min_in();
971  (*weights) -= add_row_shift;
972  }
973  //Print("attr:%x\n",weights);
974 
975  intvec *dummy=syBetti(r,len,&reg,weights);
976  if (weights!=NULL) delete weights;
977  delete dummy;
978  omFreeSize((ADDRESS)r,len*sizeof(ideal));
979  return reg+1+add_row_shift;
980 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
void * ADDRESS
Definition: auxiliary.h:115
int min_in()
Definition: intvec.h:113
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#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:791

◆ iiReportTypes()

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

Definition at line 6448 of file ipshell.cc.

6449 {
6450  char *buf=(char*)omAlloc(250);
6451  buf[0]='\0';
6452  if (nr==0)
6453  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6454  else
6455  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6456  for(int i=1;i<=T[0];i++)
6457  {
6458  strcat(buf,"`");
6459  strcat(buf,Tok2Cmdname(T[i]));
6460  strcat(buf,"`");
6461  if (i<T[0]) strcat(buf,",");
6462  }
6463  WerrorS(buf);
6464 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
int status int void * buf
Definition: si_signals.h:59
int i
Definition: cfEzgcd.cc:123
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
static jList * T
Definition: janet.cc:37

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6349 of file ipshell.cc.

6350 {
6351  // assume a: level
6352  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6353  {
6354  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6355  char assume_yylinebuf[80];
6356  strncpy(assume_yylinebuf,my_yylinebuf,79);
6357  int lev=(long)a->Data();
6358  int startlev=0;
6359  idhdl h=ggetid("assumeLevel");
6360  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6361  if(lev <=startlev)
6362  {
6363  BOOLEAN bo=b->Eval();
6364  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6365  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6366  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6367  }
6368  }
6369  b->CleanUp();
6370  a->CleanUp();
6371  return FALSE;
6372 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
int Eval()
Definition: subexpr.cc:1760
Definition: tok.h:95
#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:81
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:116
char my_yylinebuf[80]
Definition: febase.cc:48
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:122
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define TEST_V_ALLWARN
Definition: options.h:135

◆ 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:132

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 580 of file ipshell.cc.

581 {
582  sleftv vf;
583  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
584  {
585  WerrorS("link expected");
586  return TRUE;
587  }
588  si_link l=(si_link)vf.Data();
589  if (vf.next == NULL)
590  {
591  WerrorS("write: need at least two arguments");
592  return TRUE;
593  }
594 
595  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
596  if (b)
597  {
598  const char *s;
599  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
600  else s=sNoName_fe;
601  Werror("cannot write to %s",s);
602  }
603  vf.CleanUp();
604  return b;
605 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:293
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:401
const char sNoName_fe[]
Definition: fevoices.cc:65
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:995
leftv next
Definition: subexpr.h:86
Definition: tok.h:116
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:94

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 886 of file ipshell.cc.

887 {
888  sleftv tmp;
889  memset(&tmp,0,sizeof(tmp));
890  tmp.rtyp=INT_CMD;
891  tmp.data=(void *)1;
892  if ((u->Typ()==IDEAL_CMD)
893  || (u->Typ()==MODUL_CMD))
894  return jjBETTI2_ID(res,u,&tmp);
895  else
896  return jjBETTI2(res,u,&tmp);
897 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:995
void * data
Definition: subexpr.h:88
int rtyp
Definition: subexpr.h:91
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:899

◆ jjBETTI2()

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

Definition at line 920 of file ipshell.cc.

921 {
922  resolvente r;
923  int len;
924  int reg,typ0;
925  lists l=(lists)u->Data();
926 
927  intvec *weights=NULL;
928  int add_row_shift=0;
929  intvec *ww=NULL;
930  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
931  if (ww!=NULL)
932  {
933  weights=ivCopy(ww);
934  add_row_shift = ww->min_in();
935  (*weights) -= add_row_shift;
936  }
937  //Print("attr:%x\n",weights);
938 
939  r=liFindRes(l,&len,&typ0);
940  if (r==NULL) return TRUE;
941  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
942  res->data=(void*)res_im;
943  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
944  //Print("rowShift: %d ",add_row_shift);
945  for(int i=1;i<=res_im->rows();i++)
946  {
947  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
948  else break;
949  }
950  //Print(" %d\n",add_row_shift);
951  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
952  if (weights!=NULL) delete weights;
953  return FALSE;
954 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
int rows() const
Definition: intvec.h:88
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:88
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:158
int i
Definition: cfEzgcd.cc:123
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1137
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791
#define IMATELEM(M, I, J)
Definition: intvec.h:77
int l
Definition: cfEzgcd.cc:94
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ jjBETTI2_ID()

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

Definition at line 899 of file ipshell.cc.

900 {
902  l->Init(1);
903  l->m[0].rtyp=u->Typ();
904  l->m[0].data=u->Data();
905  attr *a=u->Attribute();
906  if (a!=NULL)
907  l->m[0].attribute=*a;
908  sleftv tmp2;
909  memset(&tmp2,0,sizeof(tmp2));
910  tmp2.rtyp=LIST_CMD;
911  tmp2.data=(void *)l;
912  BOOLEAN r=jjBETTI2(res,&tmp2,v);
913  l->m[0].data=NULL;
914  l->m[0].attribute=NULL;
915  l->m[0].rtyp=DEF_CMD;
916  l->Clean();
917  return r;
918 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
const poly a
Definition: syzextra.cc:212
Definition: attrib.h:15
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1392
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:995
void * data
Definition: subexpr.h:88
const ring r
Definition: syzextra.cc:208
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
attr attribute
Definition: subexpr.h:89
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:85
int l
Definition: cfEzgcd.cc:94

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3273 of file ipshell.cc.

3274 {
3275  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3276  return (res->data==NULL);
3277 }
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1385
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1137

◆ jjINT_S_TO_ID()

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

Definition at line 6192 of file ipshell.cc.

6193 {
6194  if (n==0) n=1;
6195  ideal l=idInit(n,1);
6196  int i;
6197  poly p;
6198  for(i=rVar(currRing);i>0;i--)
6199  {
6200  if (e[i]>0)
6201  {
6202  n--;
6203  p=pOne();
6204  pSetExp(p,i,1);
6205  pSetm(p);
6206  l->m[n]=p;
6207  if (n==0) break;
6208  }
6209  }
6210  res->data=(char*)l;
6211  setFlag(res,FLAG_STD);
6212  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6213 }
#define pSetm(p)
Definition: polys.h:253
#define pSetExp(p, i, v)
Definition: polys.h:42
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
void * ADDRESS
Definition: auxiliary.h:115
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define setFlag(A, F)
Definition: ipid.h:110
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:297
#define FLAG_STD
Definition: ipid.h:106
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
polyrec * poly
Definition: hilb.h:10
int l
Definition: cfEzgcd.cc:94

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 865 of file ipshell.cc.

866 {
867  int len=0;
868  int typ0;
869  lists L=(lists)v->Data();
870  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
871  int add_row_shift = 0;
872  if (weights==NULL)
873  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
874  if (weights!=NULL) add_row_shift=weights->min_in();
875  resolvente rr=liFindRes(L,&len,&typ0);
876  if (rr==NULL) return TRUE;
877  resolvente r=iiCopyRes(rr,len);
878 
879  syMinimizeResolvente(r,len,0);
880  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
881  len++;
882  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
883  return FALSE;
884 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:360
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:88
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:855
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#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:215
void * Data()
Definition: subexpr.cc:1137
ideal * resolvente
Definition: ideals.h:18

◆ jjPROC()

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

Definition at line 1599 of file iparith.cc.

1600 {
1601  void *d;
1602  Subexpr e;
1603  int typ;
1604  BOOLEAN t=FALSE;
1605  idhdl tmp_proc=NULL;
1606  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1607  {
1608  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1609  tmp_proc->id="_auto";
1610  tmp_proc->typ=PROC_CMD;
1611  tmp_proc->data.pinf=(procinfo *)u->Data();
1612  tmp_proc->ref=1;
1613  d=u->data; u->data=(void *)tmp_proc;
1614  e=u->e; u->e=NULL;
1615  t=TRUE;
1616  typ=u->rtyp; u->rtyp=IDHDL;
1617  }
1618  BOOLEAN sl;
1619  if (u->req_packhdl==currPack)
1620  sl = iiMake_proc((idhdl)u->data,NULL,v);
1621  else
1622  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1623  if (t)
1624  {
1625  u->rtyp=typ;
1626  u->data=d;
1627  u->e=e;
1628  omFreeSize(tmp_proc,sizeof(idrec));
1629  }
1630  if (sl) return TRUE;
1631  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1632  iiRETURNEXPR.Init();
1633  return FALSE;
1634 }
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:473
#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
short ref
Definition: idrec.h:46
idrec * idhdl
Definition: ring.h:18
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:503
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:106
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
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 3266 of file ipshell.cc.

3267 {
3268  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3269  (poly)w->CopyD(), currRing);
3270  return errorreported;
3271 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:304
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:707

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6222 of file ipshell.cc.

6223 {
6224  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6225  ideal I=(ideal)u->Data();
6226  int i;
6227  int n=0;
6228  for(i=I->nrows*I->ncols-1;i>=0;i--)
6229  {
6230  int n0=pGetVariables(I->m[i],e);
6231  if (n0>n) n=n0;
6232  }
6233  jjINT_S_TO_ID(n,e,res);
6234  return FALSE;
6235 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6192
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1137
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6214 of file ipshell.cc.

6215 {
6216  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6217  int n=pGetVariables((poly)u->Data(),e);
6218  jjINT_S_TO_ID(n,e,res);
6219  return FALSE;
6220 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6192
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void * Data()
Definition: subexpr.cc:1137
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6147 of file ipshell.cc.

6148 {
6149  //test|=Sy_bit(OPT_PROT);
6150  idhdl save_ringhdl=currRingHdl;
6151  ideal resid;
6152  idhdl new_ring=NULL;
6153  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6154  {
6155  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6156  new_ring=currRingHdl;
6158  }
6159  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6160  idhdl h=ggetid("groebner");
6161  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6162  u.name=IDID(h);
6163 
6164  sleftv res; memset(&res,0,sizeof(res));
6165  if(jjPROC(&res,&u,&v))
6166  {
6167  resid=kStd(F,Q,testHomog,NULL);
6168  }
6169  else
6170  {
6171  //printf("typ:%d\n",res.rtyp);
6172  resid=(ideal)(res.data);
6173  }
6174  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6175  if (new_ring!=NULL)
6176  {
6177  idhdl h=IDROOT;
6178  if (h==new_ring) IDROOT=h->next;
6179  else
6180  {
6181  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6182  if (h!=NULL) h->next=h->next->next;
6183  }
6184  if (h!=NULL) omFreeSize(h,sizeof(*h));
6185  }
6186  currRingHdl=save_ringhdl;
6187  u.CleanUp();
6188  v.CleanUp();
6189  return resid;
6190 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:20
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:2231
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
const char * name
Definition: subexpr.h:87
idhdl currRingHdl
Definition: ipid.cc:65
idhdl next
Definition: idrec.h:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ killlocals()

void killlocals ( int  v)

Definition at line 378 of file ipshell.cc.

379 {
380  BOOLEAN changed=FALSE;
381  idhdl sh=currRingHdl;
382  ring cr=currRing;
383  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
384  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
385 
386  killlocals_rec(&(basePack->idroot),v,currRing);
387 
389  {
390  int t=iiRETURNEXPR.Typ();
391  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
392  {
394  if (((ring)h->data)->idroot!=NULL)
395  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
396  }
397  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
398  {
399  leftv h=&iiRETURNEXPR;
400  changed |=killlocals_list(v,(lists)h->data);
401  }
402  }
403  if (changed)
404  {
406  if (currRingHdl==NULL)
407  currRing=NULL;
408  else if(cr!=currRing)
409  rChangeCurrRing(cr);
410  }
411 
412  if (myynest<=1) iiNoKeepRing=TRUE;
413  //Print("end killlocals >= %d\n",v);
414  //listall();
415 }
int iiRETURNEXPR_len
Definition: iplib.cc:474
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:473
#define TRUE
Definition: auxiliary.h:98
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:322
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:358
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1594
#define IDLEV(a)
Definition: ipid.h:118
void rChangeCurrRing(ring r)
Definition: polys.cc:12
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:287

◆ killlocals0()

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

Definition at line 287 of file ipshell.cc.

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

◆ killlocals_list()

BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 358 of file ipshell.cc.

359 {
360  if (L==NULL) return FALSE;
361  BOOLEAN changed=FALSE;
362  int n=L->nr;
363  for(;n>=0;n--)
364  {
365  leftv h=&(L->m[n]);
366  void *d=h->data;
367  if ((h->rtyp==RING_CMD)
368  && (((ring)d)->idroot!=NULL))
369  {
370  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
371  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
372  }
373  else if (h->rtyp==LIST_CMD)
374  changed|=killlocals_list(v,(lists)d);
375  }
376  return changed;
377 }
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
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:358
void rChangeCurrRing(ring r)
Definition: polys.cc:12
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:287

◆ killlocals_rec()

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

Definition at line 322 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3249 of file ipshell.cc.

3250 {
3251  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3252  if (res->data==NULL)
3253  res->data=(char *)new intvec(rVar(currRing));
3254  return FALSE;
3255 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
intvec * id_QHomWeight(ideal id, const ring r)
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1137

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3227 of file ipshell.cc.

3228 {
3229  ideal F=(ideal)id->Data();
3230  intvec * iv = new intvec(rVar(currRing));
3231  polyset s;
3232  int sl, n, i;
3233  int *x;
3234 
3235  res->data=(char *)iv;
3236  s = F->m;
3237  sl = IDELEMS(F) - 1;
3238  n = rVar(currRing);
3239  double wNsqr = (double)2.0 / (double)n;
3241  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3242  wCall(s, sl, x, wNsqr, currRing);
3243  for (i = n; i!=0; i--)
3244  (*iv)[i-1] = x[i + n + 1];
3245  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3246  return FALSE;
3247 }
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:583
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
poly * polyset
Definition: hutil.h:15
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
Variable x
Definition: cfModGcd.cc:4023
void * Data()
Definition: subexpr.cc:1137
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 PACKAGE_CMD:
189  paPrint(IDID(h),IDPACKAGE(h));
190  break;
191  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
192  && (strlen(IDPROC(h)->libname)>0))
193  Print(" from %s",IDPROC(h)->libname);
194  if(IDPROC(h)->language==LANG_C)
195  PrintS(" (C)");
196  if(IDPROC(h)->is_static)
197  PrintS(" (static)");
198  break;
199  case STRING_CMD:
200  {
201  char *s;
202  l=strlen(IDSTRING(h));
203  memset(buffer,0,22);
204  strncpy(buffer,IDSTRING(h),si_min(l,20));
205  if ((s=strchr(buffer,'\n'))!=NULL)
206  {
207  *s='\0';
208  }
209  PrintS(" ");
210  PrintS(buffer);
211  if((s!=NULL) ||(l>20))
212  {
213  Print("..., %d char(s)",l);
214  }
215  break;
216  }
217  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
218  break;
219  case RING_CMD:
220  if ((IDRING(h)==currRing) && (currRingHdl!=h))
221  PrintS("(*)"); /* this is an alias to currRing */
222 #ifdef RDEBUG
224  Print(" <%lx>",(long)(IDRING(h)));
225 #endif
226  break;
227 #ifdef SINGULAR_4_2
228  case CNUMBER_CMD:
229  { number2 n=(number2)IDDATA(h);
230  Print(" (%s)",nCoeffName(n->cf));
231  break;
232  }
233  case CMATRIX_CMD:
234  { bigintmat *b=(bigintmat*)IDDATA(h);
235  Print(" %d x %d (%s)",
236  b->rows(),b->cols(),
237  nCoeffName(b->basecoeffs()));
238  break;
239  }
240 #endif
241  /*default: break;*/
242  }
243  PrintLn();
244 }
#define IDLIST(a)
Definition: ipid.h:134
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:83
Definition: tok.h:95
#define IDINTVEC(a)
Definition: ipid.h:125
#define IDID(a)
Definition: ipid.h:119
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
Matrices of numbers.
Definition: bigintmat.h:51
int rows() const
Definition: bigintmat.h:146
#define IDIDEAL(a)
Definition: ipid.h:130
int traceit
Definition: febase.cc:47
Definition: idrec.h:34
void ipListFlag(idhdl h)
Definition: ipid.cc:525
Definition: subexpr.h:22
#define IDPACKAGE(a)
Definition: ipid.h:136
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:980
#define IDSTRING(a)
Definition: ipid.h:133
idhdl currRingHdl
Definition: ipid.cc:65
int cols() const
Definition: bigintmat.h:145
void PrintS(const char *s)
Definition: reporter.cc:284
static unsigned pLength(poly a)
Definition: p_polys.h:189
#define IDELEMS(i)
Definition: simpleideals.h:24
#define IDLEV(a)
Definition: ipid.h:118
#define IDMAP(a)
Definition: ipid.h:132
CanonicalForm buf2
Definition: facFqBivar.cc:71
Definition: tok.h:34
#define IDPROC(a)
Definition: ipid.h:137
void paPrint(const char *n, package p)
Definition: ipshell.cc:6237
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:122
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
#define IDPOLY(a)
Definition: ipid.h:127
coeffs basecoeffs() const
Definition: bigintmat.h:147
#define IDRING(a)
Definition: ipid.h:124
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
void wrp(poly p)
Definition: polys.h:292
#define IDDATA(a)
Definition: ipid.h:123
const poly b
Definition: syzextra.cc:213
int l
Definition: cfEzgcd.cc:94
#define IDMATRIX(a)
Definition: ipid.h:131

◆ list_cmd()

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

Definition at line 417 of file ipshell.cc.

418 {
419  package savePack=currPack;
420  idhdl h,start;
421  BOOLEAN all = typ<0;
422  BOOLEAN really_all=FALSE;
423 
424  if ( typ==0 )
425  {
426  if (strcmp(what,"all")==0)
427  {
428  if (currPack!=basePack)
429  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
430  really_all=TRUE;
431  h=basePack->idroot;
432  }
433  else
434  {
435  h = ggetid(what);
436  if (h!=NULL)
437  {
438  if (iterate) list1(prefix,h,TRUE,fullname);
439  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
440  if ((IDTYP(h)==RING_CMD)
441  //|| (IDTYP(h)==PACKE_CMD)
442  )
443  {
444  h=IDRING(h)->idroot;
445  }
446  else if(IDTYP(h)==PACKAGE_CMD)
447  {
448  currPack=IDPACKAGE(h);
449  //Print("list_cmd:package\n");
450  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
451  h=IDPACKAGE(h)->idroot;
452  }
453  else
454  {
455  currPack=savePack;
456  return;
457  }
458  }
459  else
460  {
461  Werror("%s is undefined",what);
462  currPack=savePack;
463  return;
464  }
465  }
466  all=TRUE;
467  }
468  else if (RingDependend(typ))
469  {
470  h = currRing->idroot;
471  }
472  else
473  h = IDROOT;
474  start=h;
475  while (h!=NULL)
476  {
477  if ((all
478  && (IDTYP(h)!=PROC_CMD)
479  &&(IDTYP(h)!=PACKAGE_CMD)
480  &&(IDTYP(h)!=CRING_CMD)
481  )
482  || (typ == IDTYP(h))
483  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
484  )
485  {
486  list1(prefix,h,start==currRingHdl, fullname);
487  if ((IDTYP(h)==RING_CMD)
488  && (really_all || (all && (h==currRingHdl)))
489  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
490  {
491  list_cmd(0,IDID(h),"// ",FALSE);
492  }
493  if (IDTYP(h)==PACKAGE_CMD && really_all)
494  {
495  package save_p=currPack;
496  currPack=IDPACKAGE(h);
497  list_cmd(0,IDID(h),"// ",FALSE);
498  currPack=save_p;
499  }
500  }
501  h = IDNEXT(h);
502  }
503  currPack=savePack;
504 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define IDNEXT(a)
Definition: ipid.h:115
#define IDROOT
Definition: ipid.h:20
#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:136
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
Definition: tok.h:56
int RingDependend(int t)
Definition: gentable.cc:23
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:417
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDLEV(a)
Definition: ipid.h:118
Definition: tok.h:34
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
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 3394 of file ipshell.cc.

3395 {
3396  switch( state )
3397  {
3398  case semicListTooShort:
3399  WerrorS( "the list is too short" );
3400  break;
3401  case semicListTooLong:
3402  WerrorS( "the list is too long" );
3403  break;
3404 
3406  WerrorS( "first element of the list should be int" );
3407  break;
3409  WerrorS( "second element of the list should be int" );
3410  break;
3412  WerrorS( "third element of the list should be int" );
3413  break;
3415  WerrorS( "fourth element of the list should be intvec" );
3416  break;
3418  WerrorS( "fifth element of the list should be intvec" );
3419  break;
3421  WerrorS( "sixth element of the list should be intvec" );
3422  break;
3423 
3424  case semicListNNegative:
3425  WerrorS( "first element of the list should be positive" );
3426  break;
3428  WerrorS( "wrong number of numerators" );
3429  break;
3431  WerrorS( "wrong number of denominators" );
3432  break;
3434  WerrorS( "wrong number of multiplicities" );
3435  break;
3436 
3437  case semicListMuNegative:
3438  WerrorS( "the Milnor number should be positive" );
3439  break;
3440  case semicListPgNegative:
3441  WerrorS( "the geometrical genus should be nonnegative" );
3442  break;
3443  case semicListNumNegative:
3444  WerrorS( "all numerators should be positive" );
3445  break;
3446  case semicListDenNegative:
3447  WerrorS( "all denominators should be positive" );
3448  break;
3449  case semicListMulNegative:
3450  WerrorS( "all multiplicities should be positive" );
3451  break;
3452 
3453  case semicListNotSymmetric:
3454  WerrorS( "it is not symmetric" );
3455  break;
3457  WerrorS( "it is not monotonous" );
3458  break;
3459 
3460  case semicListMilnorWrong:
3461  WerrorS( "the Milnor number is wrong" );
3462  break;
3463  case semicListPGWrong:
3464  WerrorS( "the geometrical genus is wrong" );
3465  break;
3466 
3467  default:
3468  WerrorS( "unspecific error" );
3469  break;
3470  }
3471 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4179 of file ipshell.cc.

4180 {
4181  // -------------------
4182  // check list length
4183  // -------------------
4184 
4185  if( l->nr < 5 )
4186  {
4187  return semicListTooShort;
4188  }
4189  else if( l->nr > 5 )
4190  {
4191  return semicListTooLong;
4192  }
4193 
4194  // -------------
4195  // check types
4196  // -------------
4197 
4198  if( l->m[0].rtyp != INT_CMD )
4199  {
4201  }
4202  else if( l->m[1].rtyp != INT_CMD )
4203  {
4205  }
4206  else if( l->m[2].rtyp != INT_CMD )
4207  {
4209  }
4210  else if( l->m[3].rtyp != INTVEC_CMD )
4211  {
4213  }
4214  else if( l->m[4].rtyp != INTVEC_CMD )
4215  {
4217  }
4218  else if( l->m[5].rtyp != INTVEC_CMD )
4219  {
4221  }
4222 
4223  // -------------------------
4224  // check number of entries
4225  // -------------------------
4226 
4227  int mu = (int)(long)(l->m[0].Data( ));
4228  int pg = (int)(long)(l->m[1].Data( ));
4229  int n = (int)(long)(l->m[2].Data( ));
4230 
4231  if( n <= 0 )
4232  {
4233  return semicListNNegative;
4234  }
4235 
4236  intvec *num = (intvec*)l->m[3].Data( );
4237  intvec *den = (intvec*)l->m[4].Data( );
4238  intvec *mul = (intvec*)l->m[5].Data( );
4239 
4240  if( n != num->length( ) )
4241  {
4243  }
4244  else if( n != den->length( ) )
4245  {
4247  }
4248  else if( n != mul->length( ) )
4249  {
4251  }
4252 
4253  // --------
4254  // values
4255  // --------
4256 
4257  if( mu <= 0 )
4258  {
4259  return semicListMuNegative;
4260  }
4261  if( pg < 0 )
4262  {
4263  return semicListPgNegative;
4264  }
4265 
4266  int i;
4267 
4268  for( i=0; i<n; i++ )
4269  {
4270  if( (*num)[i] <= 0 )
4271  {
4272  return semicListNumNegative;
4273  }
4274  if( (*den)[i] <= 0 )
4275  {
4276  return semicListDenNegative;
4277  }
4278  if( (*mul)[i] <= 0 )
4279  {
4280  return semicListMulNegative;
4281  }
4282  }
4283 
4284  // ----------------
4285  // check symmetry
4286  // ----------------
4287 
4288  int j;
4289 
4290  for( i=0, j=n-1; i<=j; i++,j-- )
4291  {
4292  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4293  (*den)[i] != (*den)[j] ||
4294  (*mul)[i] != (*mul)[j] )
4295  {
4296  return semicListNotSymmetric;
4297  }
4298  }
4299 
4300  // ----------------
4301  // check monotony
4302  // ----------------
4303 
4304  for( i=0, j=1; i<n/2; i++,j++ )
4305  {
4306  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4307  {
4308  return semicListNotMonotonous;
4309  }
4310  }
4311 
4312  // ---------------------
4313  // check Milnor number
4314  // ---------------------
4315 
4316  for( mu=0, i=0; i<n; i++ )
4317  {
4318  mu += (*mul)[i];
4319  }
4320 
4321  if( mu != (int)(long)(l->m[0].Data( )) )
4322  {
4323  return semicListMilnorWrong;
4324  }
4325 
4326  // -------------------------
4327  // check geometrical genus
4328  // -------------------------
4329 
4330  for( pg=0, i=0; i<n; i++ )
4331  {
4332  if( (*num)[i]<=(*den)[i] )
4333  {
4334  pg += (*mul)[i];
4335  }
4336  }
4337 
4338  if( pg != (int)(long)(l->m[1].Data( )) )
4339  {
4340  return semicListPGWrong;
4341  }
4342 
4343  return semicOK;
4344 }
sleftv * m
Definition: lists.h:45
void mu(int **points, int sizePoints)
Definition: tok.h:95
CanonicalForm num(const CanonicalForm &f)
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
int nr
Definition: lists.h:43
int length() const
Definition: intvec.h:86
CanonicalForm den(const CanonicalForm &f)
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4991 of file ipshell.cc.

4992 {
4993  int i,j;
4994  int count= self->roots[0]->getAnzRoots(); // number of roots
4995  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4996 
4997  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4998 
4999  if ( self->found_roots )
5000  {
5001  listofroots->Init( count );
5002 
5003  for (i=0; i < count; i++)
5004  {
5005  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5006  onepoint->Init(elem);
5007  for ( j= 0; j < elem; j++ )
5008  {
5009  if ( !rField_is_long_C(currRing) )
5010  {
5011  onepoint->m[j].rtyp=STRING_CMD;
5012  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5013  }
5014  else
5015  {
5016  onepoint->m[j].rtyp=NUMBER_CMD;
5017  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5018  }
5019  onepoint->m[j].next= NULL;
5020  onepoint->m[j].name= NULL;
5021  }
5022  listofroots->m[i].rtyp=LIST_CMD;
5023  listofroots->m[i].data=(void *)onepoint;
5024  listofroots->m[j].next= NULL;
5025  listofroots->m[j].name= NULL;
5026  }
5027 
5028  }
5029  else
5030  {
5031  listofroots->Init( 0 );
5032  }
5033 
5034  return listofroots;
5035 }
int status int void size_t count
Definition: si_signals.h:59
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int j
Definition: myNF.cc:70
const char * name
Definition: subexpr.h:87
int i
Definition: cfEzgcd.cc:123
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:537
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 &#39;n&#39;
Definition: coeffs.h:455
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:706
rootContainer ** roots
Definition: mpr_numeric.h:167

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4489 of file ipshell.cc.

4490 {
4491  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4492  return FALSE;
4493 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:88
void * Data()
Definition: subexpr.cc:1137

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4495 of file ipshell.cc.

4496 {
4497  if ( !(rField_is_long_R(currRing)) )
4498  {
4499  WerrorS("Ground field not implemented!");
4500  return TRUE;
4501  }
4502 
4503  simplex * LP;
4504  matrix m;
4505 
4506  leftv v= args;
4507  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4508  return TRUE;
4509  else
4510  m= (matrix)(v->CopyD());
4511 
4512  LP = new simplex(MATROWS(m),MATCOLS(m));
4513  LP->mapFromMatrix(m);
4514 
4515  v= v->next;
4516  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4517  return TRUE;
4518  else
4519  LP->m= (int)(long)(v->Data());
4520 
4521  v= v->next;
4522  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4523  return TRUE;
4524  else
4525  LP->n= (int)(long)(v->Data());
4526 
4527  v= v->next;
4528  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4529  return TRUE;
4530  else
4531  LP->m1= (int)(long)(v->Data());
4532 
4533  v= v->next;
4534  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4535  return TRUE;
4536  else
4537  LP->m2= (int)(long)(v->Data());
4538 
4539  v= v->next;
4540  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4541  return TRUE;
4542  else
4543  LP->m3= (int)(long)(v->Data());
4544 
4545 #ifdef mprDEBUG_PROT
4546  Print("m (constraints) %d\n",LP->m);
4547  Print("n (columns) %d\n",LP->n);
4548  Print("m1 (<=) %d\n",LP->m1);
4549  Print("m2 (>=) %d\n",LP->m2);
4550  Print("m3 (==) %d\n",LP->m3);
4551 #endif
4552 
4553  LP->compute();
4554 
4555  lists lres= (lists)omAlloc( sizeof(slists) );
4556  lres->Init( 6 );
4557 
4558  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4559  lres->m[0].data=(void*)LP->mapToMatrix(m);
4560 
4561  lres->m[1].rtyp= INT_CMD; // found a solution?
4562  lres->m[1].data=(void*)(long)LP->icase;
4563 
4564  lres->m[2].rtyp= INTVEC_CMD;
4565  lres->m[2].data=(void*)LP->posvToIV();
4566 
4567  lres->m[3].rtyp= INTVEC_CMD;
4568  lres->m[3].data=(void*)LP->zrovToIV();
4569 
4570  lres->m[4].rtyp= INT_CMD;
4571  lres->m[4].data=(void*)(long)LP->m;
4572 
4573  lres->m[5].rtyp= INT_CMD;
4574  lres->m[5].data=(void*)(long)LP->n;
4575 
4576  res->data= (void*)lres;
4577 
4578  return FALSE;
4579 }
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:83
Definition: tok.h:95
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
int Typ()
Definition: subexpr.cc:995
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
ip_smatrix * matrix
int m
Definition: cfEzgcd.cc:119
leftv next
Definition: subexpr.h:86
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:28
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:534
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:707

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2996 of file ipshell.cc.

2997 {
2998  int i,j;
2999  matrix result;
3000  ideal id=(ideal)a->Data();
3001 
3002  result =mpNew(IDELEMS(id),rVar(currRing));
3003  for (i=1; i<=IDELEMS(id); i++)
3004  {
3005  for (j=1; j<=rVar(currRing); j++)
3006  {
3007  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3008  }
3009  }
3010  res->data=(char *)result;
3011  return FALSE;
3012 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:44
void * Data()
Definition: subexpr.cc:1137
#define pDiff(a, b)
Definition: polys.h:278
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:29

◆ mpKoszul()

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

Definition at line 3018 of file ipshell.cc.

3019 {
3020  int n=(int)(long)b->Data();
3021  int d=(int)(long)c->Data();
3022  int k,l,sign,row,col;
3023  matrix result;
3024  ideal temp;
3025  BOOLEAN bo;
3026  poly p;
3027 
3028  if ((d>n) || (d<1) || (n<1))
3029  {
3030  res->data=(char *)mpNew(1,1);
3031  return FALSE;
3032  }
3033  int *choise = (int*)omAlloc(d*sizeof(int));
3034  if (id==NULL)
3035  temp=idMaxIdeal(1);
3036  else
3037  temp=(ideal)id->Data();
3038 
3039  k = binom(n,d);
3040  l = k*d;
3041  l /= n-d+1;
3042  result =mpNew(l,k);
3043  col = 1;
3044  idInitChoise(d,1,n,&bo,choise);
3045  while (!bo)
3046  {
3047  sign = 1;
3048  for (l=1;l<=d;l++)
3049  {
3050  if (choise[l-1]<=IDELEMS(temp))
3051  {
3052  p = pCopy(temp->m[choise[l-1]-1]);
3053  if (sign == -1) p = pNeg(p);
3054  sign *= -1;
3055  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3056  MATELEM(result,row,col) = p;
3057  }
3058  }
3059  col++;
3060  idGetNextChoise(d,n,&bo,choise);
3061  }
3062  omFreeSize(choise,d*sizeof(int));
3063  if (id==NULL) idDelete(&temp);
3064 
3065  res->data=(char *)result;
3066  return FALSE;
3067 }
#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
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define pNeg(p)
Definition: polys.h:181
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
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:44
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1137
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:85
static int sign(int x)
Definition: ring.cc:3342
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
#define pCopy(p)
return a copy of the poly
Definition: polys.h:168
#define MATELEM(mat, i, j)
Definition: matpol.h:29

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

4605 {
4606 
4607  poly gls;
4608  gls= (poly)(arg1->Data());
4609  int howclean= (int)(long)arg3->Data();
4610 
4611  if ( !(rField_is_R(currRing) ||
4612  rField_is_Q(currRing) ||
4615  {
4616  WerrorS("Ground field not implemented!");
4617  return TRUE;
4618  }
4619 
4622  {
4623  unsigned long int ii = (unsigned long int)arg2->Data();
4624  setGMPFloatDigits( ii, ii );
4625  }
4626 
4627  if ( gls == NULL || pIsConstant( gls ) )
4628  {
4629  WerrorS("Input polynomial is constant!");
4630  return TRUE;
4631  }
4632 
4633  int ldummy;
4634  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4635  int i,vpos=0;
4636  poly piter;
4637  lists elist;
4638  lists rlist;
4639 
4640  elist= (lists)omAlloc( sizeof(slists) );
4641  elist->Init( 0 );
4642 
4643  if ( rVar(currRing) > 1 )
4644  {
4645  piter= gls;
4646  for ( i= 1; i <= rVar(currRing); i++ )
4647  if ( pGetExp( piter, i ) )
4648  {
4649  vpos= i;
4650  break;
4651  }
4652  while ( piter )
4653  {
4654  for ( i= 1; i <= rVar(currRing); i++ )
4655  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4656  {
4657  WerrorS("The input polynomial must be univariate!");
4658  return TRUE;
4659  }
4660  pIter( piter );
4661  }
4662  }
4663 
4664  rootContainer * roots= new rootContainer();
4665  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4666  piter= gls;
4667  for ( i= deg; i >= 0; i-- )
4668  {
4669  if ( piter && pTotaldegree(piter) == i )
4670  {
4671  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4672  //nPrint( pcoeffs[i] );PrintS(" ");
4673  pIter( piter );
4674  }
4675  else
4676  {
4677  pcoeffs[i]= nInit(0);
4678  }
4679  }
4680 
4681 #ifdef mprDEBUG_PROT
4682  for (i=deg; i >= 0; i--)
4683  {
4684  nPrint( pcoeffs[i] );PrintS(" ");
4685  }
4686  PrintLn();
4687 #endif
4688 
4689  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4690  roots->solver( howclean );
4691 
4692  int elem= roots->getAnzRoots();
4693  char *dummy;
4694  int j;
4695 
4696  rlist= (lists)omAlloc( sizeof(slists) );
4697  rlist->Init( elem );
4698 
4700  {
4701  for ( j= 0; j < elem; j++ )
4702  {
4703  rlist->m[j].rtyp=NUMBER_CMD;
4704  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4705  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4706  }
4707  }
4708  else
4709  {
4710  for ( j= 0; j < elem; j++ )
4711  {
4712  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4713  rlist->m[j].rtyp=STRING_CMD;
4714  rlist->m[j].data=(void *)dummy;
4715  }
4716  }
4717 
4718  elist->Clean();
4719  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4720 
4721  // this is (via fillContainer) the same data as in root
4722  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4723  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4724 
4725  delete roots;
4726 
4727  res->rtyp= LIST_CMD;
4728  res->data= (void*)rlist;
4729 
4730  return FALSE;
4731 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
sleftv * m
Definition: lists.h:45
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:510
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
#define TRUE
Definition: auxiliary.h:98
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:449
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:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:88
#define pIter(p)
Definition: monomials.h:44
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:264
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:221
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:312
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:284
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:537
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:534
int rtyp
Definition: subexpr.h:91
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:706
size_t gmp_output_digits
Definition: mpr_complex.cc:44
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:62
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24

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

4582 {
4583  ideal gls = (ideal)(arg1->Data());
4584  int imtype= (int)(long)arg2->Data();
4585 
4586  uResultant::resMatType mtype= determineMType( imtype );
4587 
4588  // check input ideal ( = polynomial system )
4589  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4590  {
4591  return TRUE;
4592  }
4593 
4594  uResultant *resMat= new uResultant( gls, mtype, false );
4595  if (resMat!=NULL)
4596  {
4597  res->rtyp = MODUL_CMD;
4598  res->data= (void*)resMat->accessResMat()->getMatrix();
4599  if (!errorreported) delete resMat;
4600  }
4601  return errorreported;
4602 }
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
void * data
Definition: subexpr.h:88
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
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137

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

4835 {
4836  leftv v= args;
4837 
4838  ideal gls;
4839  int imtype;
4840  int howclean;
4841 
4842  // get ideal
4843  if ( v->Typ() != IDEAL_CMD )
4844  return TRUE;
4845  else gls= (ideal)(v->Data());
4846  v= v->next;
4847 
4848  // get resultant matrix type to use (0,1)
4849  if ( v->Typ() != INT_CMD )
4850  return TRUE;
4851  else imtype= (int)(long)v->Data();
4852  v= v->next;
4853 
4854  if (imtype==0)
4855  {
4856  ideal test_id=idInit(1,1);
4857  int j;
4858  for(j=IDELEMS(gls)-1;j>=0;j--)
4859  {
4860  if (gls->m[j]!=NULL)
4861  {
4862  test_id->m[0]=gls->m[j];
4863  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4864  if (dummy_w!=NULL)
4865  {
4866  WerrorS("Newton polytope not of expected dimension");
4867  delete dummy_w;
4868  return TRUE;
4869  }
4870  }
4871  }
4872  }
4873 
4874  // get and set precision in digits ( > 0 )
4875  if ( v->Typ() != INT_CMD )
4876  return TRUE;
4877  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4879  {
4880  unsigned long int ii=(unsigned long int)v->Data();
4881  setGMPFloatDigits( ii, ii );
4882  }
4883  v= v->next;
4884 
4885  // get interpolation steps (0,1,2)
4886  if ( v->Typ() != INT_CMD )
4887  return TRUE;
4888  else howclean= (int)(long)v->Data();
4889 
4890  uResultant::resMatType mtype= determineMType( imtype );
4891  int i,count;
4892  lists listofroots= NULL;
4893  number smv= NULL;
4894  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4895 
4896  //emptylist= (lists)omAlloc( sizeof(slists) );
4897  //emptylist->Init( 0 );
4898 
4899  //res->rtyp = LIST_CMD;
4900  //res->data= (void *)emptylist;
4901 
4902  // check input ideal ( = polynomial system )
4903  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4904  {
4905  return TRUE;
4906  }
4907 
4908  uResultant * ures;
4909  rootContainer ** iproots;
4910  rootContainer ** muiproots;
4911  rootArranger * arranger;
4912 
4913  // main task 1: setup of resultant matrix
4914  ures= new uResultant( gls, mtype );
4915  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4916  {
4917  WerrorS("Error occurred during matrix setup!");
4918  return TRUE;
4919  }
4920 
4921  // if dense resultant, check if minor nonsingular
4922  if ( mtype == uResultant::denseResMat )
4923  {
4924  smv= ures->accessResMat()->getSubDet();
4925 #ifdef mprDEBUG_PROT
4926  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4927 #endif
4928  if ( nIsZero(smv) )
4929  {
4930  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4931  return TRUE;
4932  }
4933  }
4934 
4935  // main task 2: Interpolate specialized resultant polynomials
4936  if ( interpolate_det )
4937  iproots= ures->interpolateDenseSP( false, smv );
4938  else
4939  iproots= ures->specializeInU( false, smv );
4940 
4941  // main task 3: Interpolate specialized resultant polynomials
4942  if ( interpolate_det )
4943  muiproots= ures->interpolateDenseSP( true, smv );
4944  else
4945  muiproots= ures->specializeInU( true, smv );
4946 
4947 #ifdef mprDEBUG_PROT
4948  int c= iproots[0]->getAnzElems();
4949  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4950  c= muiproots[0]->getAnzElems();
4951  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4952 #endif
4953 
4954  // main task 4: Compute roots of specialized polys and match them up
4955  arranger= new rootArranger( iproots, muiproots, howclean );
4956  arranger->solve_all();
4957 
4958  // get list of roots
4959  if ( arranger->success() )
4960  {
4961  arranger->arrange();
4962  listofroots= listOfRoots(arranger, gmp_output_digits );
4963  }
4964  else
4965  {
4966  WerrorS("Solver was unable to find any roots!");
4967  return TRUE;
4968  }
4969 
4970  // free everything
4971  count= iproots[0]->getAnzElems();
4972  for (i=0; i < count; i++) delete iproots[i];
4973  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4974  count= muiproots[0]->getAnzElems();
4975  for (i=0; i < count; i++) delete muiproots[i];
4976  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4977 
4978  delete ures;
4979  delete arranger;
4980  nDelete( &smv );
4981 
4982  res->data= (void *)listofroots;
4983 
4984  //emptylist->Clean();
4985  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4986 
4987  return FALSE;
4988 }
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
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:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:510
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:115
void pWrite(poly p)
Definition: polys.h:290
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:3059
int Typ()
Definition: subexpr.cc:995
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:46
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
int j
Definition: myNF.cc:70
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:895
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:284
void solve_all()
Definition: mpr_numeric.cc:870
#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:2921
#define nDelete(n)
Definition: numbers.h:16
leftv next
Definition: subexpr.h:86
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:537
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:534
void * Data()
Definition: subexpr.cc:1137
size_t gmp_output_digits
Definition: mpr_complex.cc:44
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:62
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:4991
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 4733 of file ipshell.cc.

4734 {
4735  int i;
4736  ideal p,w;
4737  p= (ideal)arg1->Data();
4738  w= (ideal)arg2->Data();
4739 
4740  // w[0] = f(p^0)
4741  // w[1] = f(p^1)
4742  // ...
4743  // p can be a vector of numbers (multivariate polynom)
4744  // or one number (univariate polynom)
4745  // tdg = deg(f)
4746 
4747  int n= IDELEMS( p );
4748  int m= IDELEMS( w );
4749  int tdg= (int)(long)arg3->Data();
4750 
4751  res->data= (void*)NULL;
4752 
4753  // check the input
4754  if ( tdg < 1 )
4755  {
4756  WerrorS("Last input parameter must be > 0!");
4757  return TRUE;
4758  }
4759  if ( n != rVar(currRing) )
4760  {
4761  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4762  return TRUE;
4763  }
4764  if ( m != (int)pow((double)tdg+1,(double)n) )
4765  {
4766  Werror("Size of second input ideal must be equal to %d!",
4767  (int)pow((double)tdg+1,(double)n));
4768  return TRUE;
4769  }
4770  if ( !(rField_is_Q(currRing) /* ||
4771  rField_is_R() || rField_is_long_R() ||
4772  rField_is_long_C()*/ ) )
4773  {
4774  WerrorS("Ground field not implemented!");
4775  return TRUE;
4776  }
4777 
4778  number tmp;
4779  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4780  for ( i= 0; i < n; i++ )
4781  {
4782  pevpoint[i]=nInit(0);
4783  if ( (p->m)[i] )
4784  {
4785  tmp = pGetCoeff( (p->m)[i] );
4786  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4787  {
4788  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4789  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4790  return TRUE;
4791  }
4792  } else tmp= NULL;
4793  if ( !nIsZero(tmp) )
4794  {
4795  if ( !pIsConstant((p->m)[i]))
4796  {
4797  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4798  WerrorS("Elements of first input ideal must be numbers!");
4799  return TRUE;
4800  }
4801  pevpoint[i]= nCopy( tmp );
4802  }
4803  }
4804 
4805  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4806  for ( i= 0; i < m; i++ )
4807  {
4808  wresults[i]= nInit(0);
4809  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4810  {
4811  if ( !pIsConstant((w->m)[i]))
4812  {
4813  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4814  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4815  WerrorS("Elements of second input ideal must be numbers!");
4816  return TRUE;
4817  }
4818  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4819  }
4820  }
4821 
4822  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4823  number *ncpoly= vm.interpolateDense( wresults );
4824  // do not free ncpoly[]!!
4825  poly rpoly= vm.numvec2poly( ncpoly );
4826 
4827  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4828  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4829 
4830  res->data= (void*)rpoly;
4831  return FALSE;
4832 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
#define TRUE
Definition: auxiliary.h:98
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define nIsMOne(n)
Definition: numbers.h:26
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int m
Definition: cfEzgcd.cc:119
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:221
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
#define IDELEMS(i)
Definition: simpleideals.h:24
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define nCopy(n)
Definition: numbers.h:15
void * Data()
Definition: subexpr.cc:1137
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:418
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6237 of file ipshell.cc.

6238 {
6239  Print(" %s (",n);
6240  switch (p->language)
6241  {
6242  case LANG_SINGULAR: PrintS("S"); break;
6243  case LANG_C: PrintS("C"); break;
6244  case LANG_TOP: PrintS("T"); break;
6245  case LANG_NONE: PrintS("N"); break;
6246  default: PrintS("U");
6247  }
6248  if(p->libname!=NULL)
6249  Print(",%s", p->libname);
6250  PrintS(")");
6251 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:22
void PrintS(const char *s)
Definition: reporter.cc:284
#define NULL
Definition: omList.c:10

◆ rCompose()

ring rCompose ( const lists  L,
const BOOLEAN  check_comp 
)

Definition at line 2731 of file ipshell.cc.

2732 {
2733  if ((L->nr!=3)
2734 #ifdef HAVE_PLURAL
2735  &&(L->nr!=5)
2736 #endif
2737  )
2738  return NULL;
2739  int is_gf_char=0;
2740  // 0: char/ cf - ring
2741  // 1: list (var)
2742  // 2: list (ord)
2743  // 3: qideal
2744  // possibly:
2745  // 4: C
2746  // 5: D
2747 
2748  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2749 
2750  // ------------------------------------------------------------------
2751  // 0: char:
2752  if (L->m[0].Typ()==CRING_CMD)
2753  {
2754  R->cf=(coeffs)L->m[0].Data();
2755  R->cf->ref++;
2756  }
2757  else if (L->m[0].Typ()==INT_CMD)
2758  {
2759  int ch = (int)(long)L->m[0].Data();
2760  assume( ch >= 0 );
2761 
2762  if (ch == 0) // Q?
2763  R->cf = nInitChar(n_Q, NULL);
2764  else
2765  {
2766  int l = IsPrime(ch); // Zp?
2767  if( l != ch )
2768  {
2769  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2770  ch = l;
2771  }
2772  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2773  }
2774  }
2775  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2776  {
2777  lists LL=(lists)L->m[0].Data();
2778 
2779 #ifdef HAVE_RINGS
2780  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2781  {
2782  rComposeRing(LL, R); // Ring!?
2783  }
2784  else
2785 #endif
2786  if (LL->nr < 3)
2787  rComposeC(LL,R); // R, long_R, long_C
2788  else
2789  {
2790  if (LL->m[0].Typ()==INT_CMD)
2791  {
2792  int ch = (int)(long)LL->m[0].Data();
2793  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2794  if (fftable[is_gf_char]==0) is_gf_char=-1;
2795 
2796  if(is_gf_char!= -1)
2797  {
2798  GFInfo param;
2799 
2800  param.GFChar = ch;
2801  param.GFDegree = 1;
2802  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2803 
2804  // nfInitChar should be able to handle the case when ch is in fftables!
2805  R->cf = nInitChar(n_GF, (void*)&param);
2806  }
2807  }
2808 
2809  if( R->cf == NULL )
2810  {
2811  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2812 
2813  if (extRing==NULL)
2814  {
2815  WerrorS("could not create the specified coefficient field");
2816  goto rCompose_err;
2817  }
2818 
2819  if( extRing->qideal != NULL ) // Algebraic extension
2820  {
2821  AlgExtInfo extParam;
2822 
2823  extParam.r = extRing;
2824 
2825  R->cf = nInitChar(n_algExt, (void*)&extParam);
2826  }
2827  else // Transcendental extension
2828  {
2829  TransExtInfo extParam;
2830  extParam.r = extRing;
2831  assume( extRing->qideal == NULL );
2832 
2833  R->cf = nInitChar(n_transExt, &extParam);
2834  }
2835  }
2836  }
2837  }
2838  else
2839  {
2840  WerrorS("coefficient field must be described by `int` or `list`");
2841  goto rCompose_err;
2842  }
2843 
2844  if( R->cf == NULL )
2845  {
2846  WerrorS("could not create coefficient field described by the input!");
2847  goto rCompose_err;
2848  }
2849 
2850  // ------------------------- VARS ---------------------------
2851  if (rComposeVar(L,R)) goto rCompose_err;
2852  // ------------------------ ORDER ------------------------------
2853  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2854 
2855  // ------------------------ ??????? --------------------
2856 
2857  rRenameVars(R);
2858  rComplete(R);
2859 
2860  // ------------------------ Q-IDEAL ------------------------
2861 
2862  if (L->m[3].Typ()==IDEAL_CMD)
2863  {
2864  ideal q=(ideal)L->m[3].Data();
2865  if (q->m[0]!=NULL)
2866  {
2867  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2868  {
2869  #if 0
2870  WerrorS("coefficient fields must be equal if q-ideal !=0");
2871  goto rCompose_err;
2872  #else
2873  ring orig_ring=currRing;
2874  rChangeCurrRing(R);
2875  int *perm=NULL;
2876  int *par_perm=NULL;
2877  int par_perm_size=0;
2878  nMapFunc nMap;
2879 
2880  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2881  {
2882  if (rEqual(orig_ring,currRing))
2883  {
2884  nMap=n_SetMap(currRing->cf, currRing->cf);
2885  }
2886  else
2887  // Allow imap/fetch to be make an exception only for:
2888  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2891  ||
2892  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2893  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2894  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2895  {
2896  par_perm_size=rPar(orig_ring);
2897 
2898 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2899 // naSetChar(rInternalChar(orig_ring),orig_ring);
2900 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2901 
2902  nSetChar(currRing->cf);
2903  }
2904  else
2905  {
2906  WerrorS("coefficient fields must be equal if q-ideal !=0");
2907  goto rCompose_err;
2908  }
2909  }
2910  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2911  if (par_perm_size!=0)
2912  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2913  int i;
2914  #if 0
2915  // use imap:
2916  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2917  currRing->names,currRing->N,currRing->parameter, currRing->P,
2918  perm,par_perm, currRing->ch);
2919  #else
2920  // use fetch
2921  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2922  {
2923  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2924  }
2925  else if (par_perm_size!=0)
2926  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2927  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2928  #endif
2929  ideal dest_id=idInit(IDELEMS(q),1);
2930  for(i=IDELEMS(q)-1; i>=0; i--)
2931  {
2932  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2933  par_perm,par_perm_size);
2934  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2935  pTest(dest_id->m[i]);
2936  }
2937  R->qideal=dest_id;
2938  if (perm!=NULL)
2939  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2940  if (par_perm!=NULL)
2941  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2942  rChangeCurrRing(orig_ring);
2943  #endif
2944  }
2945  else
2946  R->qideal=idrCopyR(q,currRing,R);
2947  }
2948  }
2949  else
2950  {
2951  WerrorS("q-ideal must be given as `ideal`");
2952  goto rCompose_err;
2953  }
2954 
2955 
2956  // ---------------------------------------------------------------
2957  #ifdef HAVE_PLURAL
2958  if (L->nr==5)
2959  {
2960  if (nc_CallPlural((matrix)L->m[4].Data(),
2961  (matrix)L->m[5].Data(),
2962  NULL,NULL,
2963  R,
2964  true, // !!!
2965  true, false,
2966  currRing, FALSE)) goto rCompose_err;
2967  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2968  }
2969  #endif
2970  return R;
2971 
2972 rCompose_err:
2973  if (R->N>0)
2974  {
2975  int i;
2976  if (R->names!=NULL)
2977  {
2978  i=R->N-1;
2979  while (i>=0) { omfree(R->names[i]); i--; }
2980  omFree(R->names);
2981  }
2982  }
2983  omfree(R->order);
2984  omfree(R->block0);
2985  omfree(R->block1);
2986  omfree(R->wvhdl);
2987  omFree(R);
2988  return NULL;
2989 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
ring r
Definition: algext.h:40
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:521
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2431
Definition: lists.h:22
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2731
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:121
#define FALSE
Definition: auxiliary.h:94
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:590
#define pTest(p)
Definition: polys.h:398
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:440
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
{p < 2^31}
Definition: coeffs.h:30
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:531
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:995
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2226
Creation data needed for finite fields.
Definition: coeffs.h:92
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
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:3985
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2476
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:3365
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:394
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
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
const ring R
Definition: DebugPrint.cc:36
ip_smatrix * matrix
omBin sip_sring_bin
Definition: ring.cc:54
const unsigned short fftable[]
Definition: ffields.cc:31
struct for passing initialization parameters to naInitChar
Definition: transext.h:93
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
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, if qr == 1, then qrideal equality is tested, as well
Definition: ring.cc:1629
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:725
static void rRenameVars(ring R)
Definition: ipshell.cc:2390
void rChangeCurrRing(ring r)
Definition: polys.cc:12
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:495
#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:38
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:2693
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:169
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2297
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:36
void * Data()
Definition: subexpr.cc:1137
#define nSetMap(R)
Definition: numbers.h:43
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:193
static int rInternalChar(const ring r)
Definition: ring.h:680
Definition: tok.h:117
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:341
#define Warn
Definition: emacs.cc:80

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2226 of file ipshell.cc.

2228 {
2229  // ----------------------------------------
2230  // 0: char/ cf - ring
2231  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2232  {
2233  WerrorS("invalid coeff. field description, expecting 0");
2234  return;
2235  }
2236 // R->cf->ch=0;
2237  // ----------------------------------------
2238  // 1:
2239  if (L->m[1].rtyp!=LIST_CMD)
2240  {
2241  WerrorS("invalid coeff. field description, expecting precision list");
2242  return;
2243  }
2244  lists LL=(lists)L->m[1].data;
2245  if (((LL->nr!=2)
2246  || (LL->m[0].rtyp!=INT_CMD)
2247  || (LL->m[1].rtyp!=INT_CMD))
2248  && ((LL->nr!=1)
2249  || (LL->m[0].rtyp!=INT_CMD)))
2250  {
2251  WerrorS("invalid coeff. field description list");
2252  return;
2253  }
2254  int r1=(int)(long)LL->m[0].data;
2255  int r2=(int)(long)LL->m[1].data;
2256  if (L->nr==2) // complex
2257  R->cf = nInitChar(n_long_C, NULL);
2258  else if ((r1<=SHORT_REAL_LENGTH)
2259  && (r2=SHORT_REAL_LENGTH))
2260  R->cf = nInitChar(n_R, NULL);
2261  else
2262  {
2264  p->float_len=r1;
2265  p->float_len2=r2;
2266  R->cf = nInitChar(n_long_R, NULL);
2267  }
2268 
2269  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2270  && (r2=SHORT_REAL_LENGTH))
2271  {
2272  R->cf->float_len=SHORT_REAL_LENGTH/2;
2273  R->cf->float_len2=SHORT_REAL_LENGTH;
2274  }
2275  else
2276  {
2277  R->cf->float_len=si_min(r1,32767);
2278  R->cf->float_len2=si_min(r2,32767);
2279  }
2280  // ----------------------------------------
2281  // 2: list (par)
2282  if (L->nr==2)
2283  {
2284  //R->cf->extRing->N=1;
2285  if (L->m[2].rtyp!=STRING_CMD)
2286  {
2287  WerrorS("invalid coeff. field description, expecting parameter name");
2288  return;
2289  }
2290  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2291  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2292  }
2293  // ----------------------------------------
2294 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
return P p
Definition: myNF.cc:203
void WerrorS(const char *s)
Definition: feFopen.cc:24
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
void * data
Definition: subexpr.h:88
single prescision (6,6) real numbers
Definition: coeffs.h:32
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
const ring R
Definition: DebugPrint.cc:36
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
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
#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:341
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rComposeOrder()

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

Definition at line 2476 of file ipshell.cc.

2477 {
2478  assume(R!=NULL);
2479  long bitmask=0L;
2480  if (L->m[2].Typ()==LIST_CMD)
2481  {
2482  lists v=(lists)L->m[2].Data();
2483  int n= v->nr+2;
2484  int j_in_R,j_in_L;
2485  // do we have an entry "L",... ?: set bitmask
2486  for (int j=0; j < n-1; j++)
2487  {
2488  if (v->m[j].Typ()==LIST_CMD)
2489  {
2490  lists vv=(lists)v->m[j].Data();
2491  if ((vv->nr==1)
2492  &&(vv->m[0].Typ()==STRING_CMD)
2493  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2494  {
2495  number nn=(number)vv->m[1].Data();
2496  if (vv->m[1].Typ()==BIGINT_CMD)
2497  bitmask=n_Int(nn,coeffs_BIGINT);
2498  else if (vv->m[1].Typ()==INT_CMD)
2499  bitmask=(long)nn;
2500  else
2501  {
2502  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2503  return TRUE;
2504  }
2505  break;
2506  }
2507  }
2508  }
2509  if (bitmask!=0) n--;
2510 
2511  // initialize fields of R
2512  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
2513  R->block0=(int *)omAlloc0(n*sizeof(int));
2514  R->block1=(int *)omAlloc0(n*sizeof(int));
2515  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2516  // init order, so that rBlocks works correctly
2517  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2518  R->order[j_in_R] = ringorder_unspec;
2519  // orderings
2520  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2521  {
2522  // todo: a(..), M
2523  if (v->m[j_in_L].Typ()!=LIST_CMD)
2524  {
2525  WerrorS("ordering must be list of lists");
2526  return TRUE;
2527  }
2528  lists vv=(lists)v->m[j_in_L].Data();
2529  if ((vv->nr==1)
2530  && (vv->m[0].Typ()==STRING_CMD))
2531  {
2532  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2533  {
2534  j_in_R--;
2535  continue;
2536  }
2537  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD))
2538  {
2539  PrintS(lString(vv));
2540  WerrorS("ordering name must be a (string,intvec)(1)");
2541  return TRUE;
2542  }
2543  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2544 
2545  if (j_in_R==0) R->block0[0]=1;
2546  else
2547  {
2548  int jj=j_in_R-1;
2549  while((jj>=0)
2550  && ((R->order[jj]== ringorder_a)
2551  || (R->order[jj]== ringorder_aa)
2552  || (R->order[jj]== ringorder_am)
2553  || (R->order[jj]== ringorder_c)
2554  || (R->order[jj]== ringorder_C)
2555  || (R->order[jj]== ringorder_s)
2556  || (R->order[jj]== ringorder_S)
2557  ))
2558  {
2559  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2560  jj--;
2561  }
2562  if (jj<0) R->block0[j_in_R]=1;
2563  else R->block0[j_in_R]=R->block1[jj]+1;
2564  }
2565  intvec *iv;
2566  if (vv->m[1].Typ()==INT_CMD)
2567  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2568  else
2569  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2570  int iv_len=iv->length();
2571  if (R->order[j_in_R]!=ringorder_s)
2572  {
2573  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2574  if (R->block1[j_in_R]>R->N)
2575  {
2576  R->block1[j_in_R]=R->N;
2577  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2578  }
2579  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2580  }
2581  int i;
2582  switch (R->order[j_in_R])
2583  {
2584  case ringorder_ws:
2585  case ringorder_Ws:
2586  R->OrdSgn=-1;
2587  case ringorder_aa:
2588  case ringorder_a:
2589  case ringorder_wp:
2590  case ringorder_Wp:
2591  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2592  for (i=0; i<iv_len;i++)
2593  {
2594  R->wvhdl[j_in_R][i]=(*iv)[i];
2595  }
2596  break;
2597  case ringorder_am:
2598  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2599  for (i=0; i<iv_len;i++)
2600  {
2601  R->wvhdl[j_in_R][i]=(*iv)[i];
2602  }
2603  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2604  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2605  for (; i<iv->length(); i++)
2606  {
2607  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2608  }
2609  break;
2610  case ringorder_M:
2611  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2612  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2613  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length()-1)));
2614  if (R->block1[j_in_R]>R->N)
2615  {
2616  WerrorS("ordering matrix too big");
2617  return TRUE;
2618  }
2619  break;
2620  case ringorder_ls:
2621  case ringorder_ds:
2622  case ringorder_Ds:
2623  case ringorder_rs:
2624  R->OrdSgn=-1;
2625  case ringorder_lp:
2626  case ringorder_dp:
2627  case ringorder_Dp:
2628  case ringorder_rp:
2629  break;
2630  case ringorder_S:
2631  break;
2632  case ringorder_c:
2633  case ringorder_C:
2634  R->block1[j_in_R]=R->block0[j_in_R]=0;
2635  break;
2636 
2637  case ringorder_s:
2638  R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2639  rSetSyzComp(R->block0[j_in_R],R);
2640  break;
2641 
2642  case ringorder_IS:
2643  {
2644  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2645  if( iv->length() > 0 )
2646  {
2647  const int s = (*iv)[0];
2648  assume( -2 < s && s < 2 );
2649  R->block1[j_in_R] = R->block0[j_in_R] = s;
2650  }
2651  break;
2652  }
2653  case 0:
2654  case ringorder_unspec:
2655  break;
2656  }
2657  delete iv;
2658  }
2659  else
2660  {
2661  PrintS(lString(vv));
2662  WerrorS("ordering name must be a (string,intvec)");
2663  return TRUE;
2664  }
2665  }
2666  // sanity check
2667  j_in_R=n-2;
2668  if ((R->order[j_in_R]==ringorder_c)
2669  || (R->order[j_in_R]==ringorder_C)
2670  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2671  if (R->block1[j_in_R] != R->N)
2672  {
2673  if (((R->order[j_in_R]==ringorder_dp) ||
2674  (R->order[j_in_R]==ringorder_ds) ||
2675  (R->order[j_in_R]==ringorder_Dp) ||
2676  (R->order[j_in_R]==ringorder_Ds) ||
2677  (R->order[j_in_R]==ringorder_rp) ||
2678  (R->order[j_in_R]==ringorder_rs) ||
2679  (R->order[j_in_R]==ringorder_lp) ||
2680  (R->order[j_in_R]==ringorder_ls))
2681  &&
2682  R->block0[j_in_R] <= R->N)
2683  {
2684  R->block1[j_in_R] = R->N;
2685  }
2686  else
2687  {
2688  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2689  return TRUE;
2690  }
2691  }
2692  if (R->block0[j_in_R]>R->N)
2693  {
2694  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2695  for(int ii=0;ii<=j_in_R;ii++)
2696  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2697  return TRUE;
2698  }
2699  if (check_comp)
2700  {
2701  BOOLEAN comp_order=FALSE;
2702  int jj;
2703  for(jj=0;jj<n;jj++)
2704  {
2705  if ((R->order[jj]==ringorder_c) ||
2706  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2707  }
2708  if (!comp_order)
2709  {
2710  R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2711  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2712  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2713  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2714  R->order[n-1]=ringorder_C;
2715  R->block0[n-1]=0;
2716  R->block1[n-1]=0;
2717  R->wvhdl[n-1]=NULL;
2718  n++;
2719  }
2720  }
2721  }
2722  else
2723  {
2724  WerrorS("ordering must be given as `list`");
2725  return TRUE;
2726  }
2727  if (bitmask!=0) R->bitmask=bitmask*2;
2728  return FALSE;
2729 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:99
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:38
opposite of ls
Definition: ring.h:100
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
#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:377
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:995
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: intvec.h:14
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ...
Definition: coeffs.h:551
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:394
const ring R
Definition: DebugPrint.cc:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
rRingOrder_t
order stuff
Definition: ring.h:75
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
void PrintS(const char *s)
Definition: reporter.cc:284
S?
Definition: ring.h:83
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:4989
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:86
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
rRingOrder_t rOrderName(char *ordername)
Definition: ring.cc:508
int * int_ptr
Definition: structs.h:57
int BOOLEAN
Definition: auxiliary.h:85
s?
Definition: ring.h:84
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 2297 of file ipshell.cc.

2299 {
2300  // ----------------------------------------
2301  // 0: string: integer
2302  // no further entries --> Z
2303  mpz_t modBase;
2304  unsigned int modExponent = 1;
2305 
2306  if (L->nr == 0)
2307  {
2308  mpz_init_set_ui(modBase,0);
2309  modExponent = 1;
2310  }
2311  // ----------------------------------------
2312  // 1:
2313  else
2314  {
2315  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2316  lists LL=(lists)L->m[1].data;
2317  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2318  {
2319  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2320  // assume that tmp is integer, not rational
2321  mpz_init(modBase);
2322  n_MPZ (modBase, tmp, coeffs_BIGINT);
2323  }
2324  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2325  {
2326  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2327  }
2328  else
2329  {
2330  mpz_init_set_ui(modBase,0);
2331  }
2332  if (LL->nr >= 1)
2333  {
2334  modExponent = (unsigned long) LL->m[1].data;
2335  }
2336  else
2337  {
2338  modExponent = 1;
2339  }
2340  }
2341  // ----------------------------------------
2342  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2343  {
2344  WerrorS("Wrong ground ring specification (module is 1)");
2345  return;
2346  }
2347  if (modExponent < 1)
2348  {
2349  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2350  return;
2351  }
2352  // module is 0 ---> integers
2353  if (mpz_cmp_ui(modBase, 0) == 0)
2354  {
2355  R->cf=nInitChar(n_Z,NULL);
2356  }
2357  // we have an exponent
2358  else if (modExponent > 1)
2359  {
2360  //R->cf->ch = R->cf->modExponent;
2361  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2362  {
2363  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2364  depending on the size of a long on the respective platform */
2365  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2366  }
2367  else
2368  {
2369  //ringtype 3
2370  ZnmInfo info;
2371  info.base= modBase;
2372  info.exp= modExponent;
2373  R->cf=nInitChar(n_Znm,(void*) &info);
2374  }
2375  }
2376  // just a module m > 1
2377  else
2378  {
2379  //ringtype = 2;
2380  //const int ch = mpz_get_ui(modBase);
2381  ZnmInfo info;
2382  info.base= modBase;
2383  info.exp= modExponent;
2384  R->cf=nInitChar(n_Zn,(void*) &info);
2385  }
2386  mpz_clear(modBase);
2387 }
mpz_ptr base
Definition: rmodulon.h:19
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
Definition: tok.h:95
Definition: lists.h:22
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
if(0 > strat->sl)
Definition: myNF.cc:73
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:54
void * data
Definition: subexpr.h:88
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
unsigned long exp
Definition: rmodulon.h:19
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:555
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:341

◆ rComposeVar()

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

Definition at line 2431 of file ipshell.cc.

2432 {
2433  assume(R!=NULL);
2434  if (L->m[1].Typ()==LIST_CMD)
2435  {
2436  lists v=(lists)L->m[1].Data();
2437  R->N = v->nr+1;
2438  if (R->N<=0)
2439  {
2440  WerrorS("no ring variables");
2441  return TRUE;
2442  }
2443  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2444  int i;
2445  for(i=0;i<R->N;i++)
2446  {
2447  if (v->m[i].Typ()==STRING_CMD)
2448  R->names[i]=omStrDup((char *)v->m[i].Data());
2449  else if (v->m[i].Typ()==POLY_CMD)
2450  {
2451  poly p=(poly)v->m[i].Data();
2452  int nr=pIsPurePower(p);
2453  if (nr>0)
2454  R->names[i]=omStrDup(currRing->names[nr-1]);
2455  else
2456  {
2457  Werror("var name %d must be a string or a ring variable",i+1);
2458  return TRUE;
2459  }
2460  }
2461  else
2462  {
2463  Werror("var name %d must be `string`",i+1);
2464  return TRUE;
2465  }
2466  }
2467  }
2468  else
2469  {
2470  WerrorS("variable must be given as `list`");
2471  return TRUE;
2472  }
2473  return FALSE;
2474 }
#define pIsPurePower(p)
Definition: polys.h:231
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:995
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
char * char_ptr
Definition: structs.h:56
#define assume(x)
Definition: mod2.h:394
const ring R
Definition: DebugPrint.cc:36
int i
Definition: cfEzgcd.cc:123
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
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10
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 2040 of file ipshell.cc.

2041 {
2042  assume( r != NULL );
2043  const coeffs C = r->cf;
2044  assume( C != NULL );
2045 
2046  // sanity check: require currRing==r for rings with polynomial data
2047  if ( (r!=currRing) && (
2048  (nCoeff_is_algExt(C) && (C != currRing->cf))
2049  || (r->qideal != NULL)
2050 #ifdef HAVE_PLURAL
2051  || (rIsPluralRing(r))
2052 #endif
2053  )
2054  )
2055  {
2056  WerrorS("ring with polynomial data must be the base ring or compatible");
2057  return NULL;
2058  }
2059  // 0: char/ cf - ring
2060  // 1: list (var)
2061  // 2: list (ord)
2062  // 3: qideal
2063  // possibly:
2064  // 4: C
2065  // 5: D
2067  if (rIsPluralRing(r))
2068  L->Init(6);
2069  else
2070  L->Init(4);
2071  // ----------------------------------------
2072  // 0: char/ cf - ring
2073  if (rField_is_numeric(r))
2074  {
2075  rDecomposeC(&(L->m[0]),r);
2076  }
2077  else if (rField_is_Ring(r))
2078  {
2079  rDecomposeRing(&(L->m[0]),r);
2080  }
2081  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2082  {
2083  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2084  }
2085  else if(rField_is_GF(r))
2086  {
2088  Lc->Init(4);
2089  // char:
2090  Lc->m[0].rtyp=INT_CMD;
2091  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2092  // var:
2094  Lv->Init(1);
2095  Lv->m[0].rtyp=STRING_CMD;
2096  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2097  Lc->m[1].rtyp=LIST_CMD;
2098  Lc->m[1].data=(void*)Lv;
2099  // ord:
2101  Lo->Init(1);
2103  Loo->Init(2);
2104  Loo->m[0].rtyp=STRING_CMD;
2105  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2106 
2107  intvec *iv=new intvec(1); (*iv)[0]=1;
2108  Loo->m[1].rtyp=INTVEC_CMD;
2109  Loo->m[1].data=(void *)iv;
2110 
2111  Lo->m[0].rtyp=LIST_CMD;
2112  Lo->m[0].data=(void*)Loo;
2113 
2114  Lc->m[2].rtyp=LIST_CMD;
2115  Lc->m[2].data=(void*)Lo;
2116  // q-ideal:
2117  Lc->m[3].rtyp=IDEAL_CMD;
2118  Lc->m[3].data=(void *)idInit(1,1);
2119  // ----------------------
2120  L->m[0].rtyp=LIST_CMD;
2121  L->m[0].data=(void*)Lc;
2122  }
2123  else
2124  {
2125  L->m[0].rtyp=INT_CMD;
2126  L->m[0].data=(void *)(long)r->cf->ch;
2127  }
2128  // ----------------------------------------
2129  // 1: list (var)
2131  LL->Init(r->N);
2132  int i;
2133  for(i=0; i<r->N; i++)
2134  {
2135  LL->m[i].rtyp=STRING_CMD;
2136  LL->m[i].data=(void *)omStrDup(r->names[i]);
2137  }
2138  L->m[1].rtyp=LIST_CMD;
2139  L->m[1].data=(void *)LL;
2140  // ----------------------------------------
2141  // 2: list (ord)
2143  i=rBlocks(r)-1;
2144  LL->Init(i);
2145  i--;
2146  lists LLL;
2147  for(; i>=0; i--)
2148  {
2149  intvec *iv;
2150  int j;
2151  LL->m[i].rtyp=LIST_CMD;
2153  LLL->Init(2);
2154  LLL->m[0].rtyp=STRING_CMD;
2155  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2156 
2157  if((r->order[i] == ringorder_IS)
2158  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2159  {
2160  assume( r->block0[i] == r->block1[i] );
2161  const int s = r->block0[i];
2162  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2163 
2164  iv=new intvec(1);
2165  (*iv)[0] = s;
2166  }
2167  else if (r->block1[i]-r->block0[i] >=0 )
2168  {
2169  int bl=j=r->block1[i]-r->block0[i];
2170  if (r->order[i]==ringorder_M)
2171  {
2172  j=(j+1)*(j+1)-1;
2173  bl=j+1;
2174  }
2175  else if (r->order[i]==ringorder_am)
2176  {
2177  j+=r->wvhdl[i][bl+1];
2178  }
2179  iv=new intvec(j+1);
2180  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2181  {
2182  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2183  }
2184  else switch (r->order[i])
2185  {
2186  case ringorder_dp:
2187  case ringorder_Dp:
2188  case ringorder_ds:
2189  case ringorder_Ds:
2190  case ringorder_lp:
2191  for(;j>=0; j--) (*iv)[j]=1;
2192  break;
2193  default: /* do nothing */;
2194  }
2195  }
2196  else
2197  {
2198  iv=new intvec(1);
2199  }
2200  LLL->m[1].rtyp=INTVEC_CMD;
2201  LLL->m[1].data=(void *)iv;
2202  LL->m[i].data=(void *)LLL;
2203  }
2204  L->m[2].rtyp=LIST_CMD;
2205  L->m[2].data=(void *)LL;
2206  // ----------------------------------------
2207  // 3: qideal
2208  L->m[3].rtyp=IDEAL_CMD;
2209  if (r->qideal==NULL)
2210  L->m[3].data=(void *)idInit(1,1);
2211  else
2212  L->m[3].data=(void *)idCopy(r->qideal);
2213  // ----------------------------------------
2214 #ifdef HAVE_PLURAL // NC! in rDecompose
2215  if (rIsPluralRing(r))
2216  {
2217  L->m[4].rtyp=MATRIX_CMD;
2218  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2219  L->m[5].rtyp=MATRIX_CMD;
2220  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2221  }
2222 #endif
2223  return L;
2224 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:513
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
CanonicalForm Lc(const CanonicalForm &f)
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1620
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
static int rBlocks(ring r)
Definition: ring.h:559
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:927
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:394
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:404
The main handler for Singular numbers which are suitable for Singular polynomials.
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1742
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
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:38
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1806
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:477
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:71
omBin slists_bin
Definition: lists.cc:23
s?
Definition: ring.h:84
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:507
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1838 of file ipshell.cc.

1839 {
1840  assume( C != NULL );
1841 
1842  // sanity check: require currRing==r for rings with polynomial data
1843  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1844  {
1845  WerrorS("ring with polynomial data must be the base ring or compatible");
1846  return TRUE;
1847  }
1848  if (nCoeff_is_numeric(C))
1849  {
1850  rDecomposeC_41(res,C);
1851  }
1852 #ifdef HAVE_RINGS
1853  else if (nCoeff_is_Ring(C))
1854  {
1855  rDecomposeRing_41(res,C);
1856  }
1857 #endif
1858  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1859  {
1860  rDecomposeCF(res, C->extRing, currRing);
1861  }
1862  else if(nCoeff_is_GF(C))
1863  {
1865  Lc->Init(4);
1866  // char:
1867  Lc->m[0].rtyp=INT_CMD;
1868  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1869  // var:
1871  Lv->Init(1);
1872  Lv->m[0].rtyp=STRING_CMD;
1873  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1874  Lc->m[1].rtyp=LIST_CMD;
1875  Lc->m[1].data=(void*)Lv;
1876  // ord:
1878  Lo->Init(1);
1880  Loo->Init(2);
1881  Loo->m[0].rtyp=STRING_CMD;
1882  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1883 
1884  intvec *iv=new intvec(1); (*iv)[0]=1;
1885  Loo->m[1].rtyp=INTVEC_CMD;
1886  Loo->m[1].data=(void *)iv;
1887 
1888  Lo->m[0].rtyp=LIST_CMD;
1889  Lo->m[0].data=(void*)Loo;
1890 
1891  Lc->m[2].rtyp=LIST_CMD;
1892  Lc->m[2].data=(void*)Lo;
1893  // q-ideal:
1894  Lc->m[3].rtyp=IDEAL_CMD;
1895  Lc->m[3].data=(void *)idInit(1,1);
1896  // ----------------------
1897  res->rtyp=LIST_CMD;
1898  res->data=(void*)Lc;
1899  }
1900  else
1901  {
1902  res->rtyp=INT_CMD;
1903  res->data=(void *)(long)C->ch;
1904  }
1905  // ----------------------------------------
1906  return FALSE;
1907 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:849
Definition: tok.h:95
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:762
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1778
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1620
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:927
Definition: intvec.h:14
#define assume(x)
Definition: mod2.h:394
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:856
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1708
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:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
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 1909 of file ipshell.cc.

1910 {
1911  assume( r != NULL );
1912  const coeffs C = r->cf;
1913  assume( C != NULL );
1914 
1915  // sanity check: require currRing==r for rings with polynomial data
1916  if ( (r!=currRing) && (
1917  (r->qideal != NULL)
1918 #ifdef HAVE_PLURAL
1919  || (rIsPluralRing(r))
1920 #endif
1921  )
1922  )
1923  {
1924  WerrorS("ring with polynomial data must be the base ring or compatible");
1925  return NULL;
1926  }
1927  // 0: char/ cf - ring
1928  // 1: list (var)
1929  // 2: list (ord)
1930  // 3: qideal
1931  // possibly:
1932  // 4: C
1933  // 5: D
1935  if (rIsPluralRing(r))
1936  L->Init(6);
1937  else
1938  L->Init(4);
1939  // ----------------------------------------
1940  // 0: char/ cf - ring
1941  L->m[0].rtyp=CRING_CMD;
1942  L->m[0].data=(char*)r->cf; r->cf->ref++;
1943  // ----------------------------------------
1944  // 1: list (var)
1946  LL->Init(r->N);
1947  int i;
1948  for(i=0; i<r->N; i++)
1949  {
1950  LL->m[i].rtyp=STRING_CMD;
1951  LL->m[i].data=(void *)omStrDup(r->names[i]);
1952  }
1953  L->m[1].rtyp=LIST_CMD;
1954  L->m[1].data=(void *)LL;
1955  // ----------------------------------------
1956  // 2: list (ord)
1958  i=rBlocks(r)-1;
1959  LL->Init(i);
1960  i--;
1961  lists LLL;
1962  for(; i>=0; i--)
1963  {
1964  intvec *iv;
1965  int j;
1966  LL->m[i].rtyp=LIST_CMD;
1968  LLL->Init(2);
1969  LLL->m[0].rtyp=STRING_CMD;
1970  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1971 
1972  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1973  {
1974  assume( r->block0[i] == r->block1[i] );
1975  const int s = r->block0[i];
1976  assume( -2 < s && s < 2);
1977 
1978  iv=new intvec(1);
1979  (*iv)[0] = s;
1980  }
1981  else if (r->block1[i]-r->block0[i] >=0 )
1982  {
1983  int bl=j=r->block1[i]-r->block0[i];
1984  if (r->order[i]==ringorder_M)
1985  {
1986  j=(j+1)*(j+1)-1;
1987  bl=j+1;
1988  }
1989  else if (r->order[i]==ringorder_am)
1990  {
1991  j+=r->wvhdl[i][bl+1];
1992  }
1993  iv=new intvec(j+1);
1994  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1995  {
1996  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1997  }
1998  else switch (r->order[i])
1999  {
2000  case ringorder_dp:
2001  case ringorder_Dp:
2002  case ringorder_ds:
2003  case ringorder_Ds:
2004  case ringorder_lp:
2005  for(;j>=0; j--) (*iv)[j]=1;
2006  break;
2007  default: /* do nothing */;
2008  }
2009  }
2010  else
2011  {
2012  iv=new intvec(1);
2013  }
2014  LLL->m[1].rtyp=INTVEC_CMD;
2015  LLL->m[1].data=(void *)iv;
2016  LL->m[i].data=(void *)LLL;
2017  }
2018  L->m[2].rtyp=LIST_CMD;
2019  L->m[2].data=(void *)LL;
2020  // ----------------------------------------
2021  // 3: qideal
2022  L->m[3].rtyp=IDEAL_CMD;
2023  if (r->qideal==NULL)
2024  L->m[3].data=(void *)idInit(1,1);
2025  else
2026  L->m[3].data=(void *)idCopy(r->qideal);
2027  // ----------------------------------------
2028 #ifdef HAVE_PLURAL // NC! in rDecompose
2029  if (rIsPluralRing(r))
2030  {
2031  L->m[4].rtyp=MATRIX_CMD;
2032  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2033  L->m[5].rtyp=MATRIX_CMD;
2034  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2035  }
2036 #endif
2037  return L;
2038 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
static int rBlocks(ring r)
Definition: ring.h:559
Definition: tok.h:56
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:394
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:404
The main handler for Singular numbers which are suitable for Singular polynomials.
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
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:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:71
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 1742 of file ipshell.cc.

1744 {
1746  if (rField_is_long_C(R)) L->Init(3);
1747  else L->Init(2);
1748  h->rtyp=LIST_CMD;
1749  h->data=(void *)L;
1750  // 0: char/ cf - ring
1751  // 1: list (var)
1752  // 2: list (ord)
1753  // ----------------------------------------
1754  // 0: char/ cf - ring
1755  L->m[0].rtyp=INT_CMD;
1756  L->m[0].data=(void *)0;
1757  // ----------------------------------------
1758  // 1:
1760  LL->Init(2);
1761  LL->m[0].rtyp=INT_CMD;
1762  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1763  LL->m[1].rtyp=INT_CMD;
1764  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1765  L->m[1].rtyp=LIST_CMD;
1766  L->m[1].data=(void *)LL;
1767  // ----------------------------------------
1768  // 2: list (par)
1769  if (rField_is_long_C(R))
1770  {
1771  L->m[2].rtyp=STRING_CMD;
1772  L->m[2].data=(void *)omStrDup(*rParameter(R));
1773  }
1774  // ----------------------------------------
1775 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
void * data
Definition: subexpr.h:88
const ring R
Definition: DebugPrint.cc:36
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:537
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:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeC_41()

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

Definition at line 1708 of file ipshell.cc.

1710 {
1712  if (nCoeff_is_long_C(C)) L->Init(3);
1713  else L->Init(2);
1714  h->rtyp=LIST_CMD;
1715  h->data=(void *)L;
1716  // 0: char/ cf - ring
1717  // 1: list (var)
1718  // 2: list (ord)
1719  // ----------------------------------------
1720  // 0: char/ cf - ring
1721  L->m[0].rtyp=INT_CMD;
1722  L->m[0].data=(void *)0;
1723  // ----------------------------------------
1724  // 1:
1726  LL->Init(2);
1727  LL->m[0].rtyp=INT_CMD;
1728  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1729  LL->m[1].rtyp=INT_CMD;
1730  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1731  L->m[1].rtyp=LIST_CMD;
1732  L->m[1].data=(void *)LL;
1733  // ----------------------------------------
1734  // 2: list (par)
1735  if (nCoeff_is_long_C(C))
1736  {
1737  L->m[2].rtyp=STRING_CMD;
1738  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1739  }
1740  // ----------------------------------------
1741 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:911
void * data
Definition: subexpr.h:88
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
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:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeCF()

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

Definition at line 1620 of file ipshell.cc.

1621 {
1623  L->Init(4);
1624  h->rtyp=LIST_CMD;
1625  h->data=(void *)L;
1626  // 0: char/ cf - ring
1627  // 1: list (var)
1628  // 2: list (ord)
1629  // 3: qideal
1630  // ----------------------------------------
1631  // 0: char/ cf - ring
1632  L->m[0].rtyp=INT_CMD;
1633  L->m[0].data=(void *)(long)r->cf->ch;
1634  // ----------------------------------------
1635  // 1: list (var)
1637  LL->Init(r->N);
1638  int i;
1639  for(i=0; i<r->N; i++)
1640  {
1641  LL->m[i].rtyp=STRING_CMD;
1642  LL->m[i].data=(void *)omStrDup(r->names[i]);
1643  }
1644  L->m[1].rtyp=LIST_CMD;
1645  L->m[1].data=(void *)LL;
1646  // ----------------------------------------
1647  // 2: list (ord)
1649  i=rBlocks(r)-1;
1650  LL->Init(i);
1651  i--;
1652  lists LLL;
1653  for(; i>=0; i--)
1654  {
1655  intvec *iv;
1656  int j;
1657  LL->m[i].rtyp=LIST_CMD;
1659  LLL->Init(2);
1660  LLL->m[0].rtyp=STRING_CMD;
1661  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1662  if (r->block1[i]-r->block0[i] >=0 )
1663  {
1664  j=r->block1[i]-r->block0[i];
1665  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1666  iv=new intvec(j+1);
1667  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1668  {
1669  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1670  }
1671  else switch (r->order[i])
1672  {
1673  case ringorder_dp:
1674  case ringorder_Dp:
1675  case ringorder_ds:
1676  case ringorder_Ds:
1677  case ringorder_lp:
1678  for(;j>=0; j--) (*iv)[j]=1;
1679  break;
1680  default: /* do nothing */;
1681  }
1682  }
1683  else
1684  {
1685  iv=new intvec(1);
1686  }
1687  LLL->m[1].rtyp=INTVEC_CMD;
1688  LLL->m[1].data=(void *)iv;
1689  LL->m[i].data=(void *)LLL;
1690  }
1691  L->m[2].rtyp=LIST_CMD;
1692  L->m[2].data=(void *)LL;
1693  // ----------------------------------------
1694  // 3: qideal
1695  L->m[3].rtyp=IDEAL_CMD;
1696  if (nCoeff_is_transExt(R->cf))
1697  L->m[3].data=(void *)idInit(1,1);
1698  else
1699  {
1700  ideal q=idInit(IDELEMS(r->qideal));
1701  q->m[0]=p_Init(R);
1702  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1703  L->m[3].data=(void *)q;
1704 // I->m[0] = pNSet(R->minpoly);
1705  }
1706  // ----------------------------------------
1707 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void * data
Definition: subexpr.h:88
static int rBlocks(ring r)
Definition: ring.h:559
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int j
Definition: myNF.cc:70
const ring R
Definition: DebugPrint.cc:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:935
int i
Definition: cfEzgcd.cc:123
#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:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
#define pSetCoeff0(p, n)
Definition: monomials.h:67
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1243
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1806 of file ipshell.cc.

1808 {
1809 #ifdef HAVE_RINGS
1811  if (rField_is_Ring_Z(R)) L->Init(1);
1812  else L->Init(2);
1813  h->rtyp=LIST_CMD;
1814  h->data=(void *)L;
1815  // 0: char/ cf - ring
1816  // 1: list (module)
1817  // ----------------------------------------
1818  // 0: char/ cf - ring
1819  L->m[0].rtyp=STRING_CMD;
1820  L->m[0].data=(void *)omStrDup("integer");
1821  // ----------------------------------------
1822  // 1: module
1823  if (rField_is_Ring_Z(R)) return;
1825  LL->Init(2);
1826  LL->m[0].rtyp=BIGINT_CMD;
1827  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); ?
1828  LL->m[1].rtyp=INT_CMD;
1829  LL->m[1].data=(void *) R->cf->modExponent;
1830  L->m[1].rtyp=LIST_CMD;
1831  L->m[1].data=(void *)LL;
1832 #else
1833  WerrorS("rDecomposeRing");
1834 #endif
1835 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
const ring R
Definition: DebugPrint.cc:36
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_Ring_Z(const ring r)
Definition: ring.h:474
int rtyp
Definition: subexpr.h:91
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:205
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1778 of file ipshell.cc.

1780 {
1782  if (nCoeff_is_Ring(C)) L->Init(1);
1783  else L->Init(2);
1784  h->rtyp=LIST_CMD;
1785  h->data=(void *)L;
1786  // 0: char/ cf - ring
1787  // 1: list (module)
1788  // ----------------------------------------
1789  // 0: char/ cf - ring
1790  L->m[0].rtyp=STRING_CMD;
1791  L->m[0].data=(void *)omStrDup("integer");
1792  // ----------------------------------------
1793  // 1: modulo
1794  if (nCoeff_is_Ring_Z(C)) return;
1796  LL->Init(2);
1797  LL->m[0].rtyp=BIGINT_CMD;
1798  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1799  LL->m[1].rtyp=INT_CMD;
1800  LL->m[1].data=(void *) C->modExponent;
1801  L->m[1].rtyp=LIST_CMD;
1802  L->m[1].data=(void *)LL;
1803 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
Definition: tok.h:38
static FORCE_INLINE BOOLEAN nCoeff_is_Ring_Z(const coeffs r)
Definition: coeffs.h:759
coeffs coeffs_BIGINT
Definition: ipid.cc:54
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:762
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:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:205
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1549 of file ipshell.cc.

1550 {
1551  idhdl tmp=NULL;
1552 
1553  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1554  if (tmp==NULL) return NULL;
1555 
1556 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1558  {
1560  memset(&sLastPrinted,0,sizeof(sleftv));
1561  }
1562 
1563  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1564 
1565  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1566  r->N = 3;
1567  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1568  /*names*/
1569  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1570  r->names[0] = omStrDup("x");
1571  r->names[1] = omStrDup("y");
1572  r->names[2] = omStrDup("z");
1573  /*weights: entries for 3 blocks: NULL*/
1574  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1575  /*order: dp,C,0*/
1576  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1577  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1578  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1579  /* ringorder dp for the first block: var 1..3 */
1580  r->order[0] = ringorder_dp;
1581  r->block0[0] = 1;
1582  r->block1[0] = 3;
1583  /* ringorder C for the second block: no vars */
1584  r->order[1] = ringorder_C;
1585  /* the last block: everything is 0 */
1586  r->order[2] = (rRingOrder_t)0;
1587 
1588  /* complete ring intializations */
1589  rComplete(r);
1590  rSetHdl(tmp);
1591  return currRingHdl;
1592 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
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:258
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:402
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:3365
rRingOrder_t
order stuff
Definition: ring.h:75
idhdl currRingHdl
Definition: ipid.cc:65
omBin sip_sring_bin
Definition: ring.cc:54
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void rSetHdl(idhdl h)
Definition: ipshell.cc:5038
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:341
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1594 of file ipshell.cc.

1595 {
1597  if (h!=NULL) return h;
1598  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1599  if (h!=NULL) return h;
1601  while(p!=NULL)
1602  {
1603  if ((p->cPack!=basePack)
1604  && (p->cPack!=currPack))
1605  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1606  if (h!=NULL) return h;
1607  p=p->next;
1608  }
1609  idhdl tmp=basePack->idroot;
1610  while (tmp!=NULL)
1611  {
1612  if (IDTYP(tmp)==PACKAGE_CMD)
1613  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1614  if (h!=NULL) return h;
1615  tmp=IDNEXT(tmp);
1616  }
1617  return NULL;
1618 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6129
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:115
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
Definition: ipid.h:56
proclevel * next
Definition: ipid.h:59
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
package cPack
Definition: ipid.h:61

◆ rInit()

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

Definition at line 5524 of file ipshell.cc.

5525 {
5526  int float_len=0;
5527  int float_len2=0;
5528  ring R = NULL;
5529  //BOOLEAN ffChar=FALSE;
5530 
5531  /* ch -------------------------------------------------------*/
5532  // get ch of ground field
5533 
5534  // allocated ring
5535  R = (ring) omAlloc0Bin(sip_sring_bin);
5536 
5537  coeffs cf = NULL;
5538 
5539  assume( pn != NULL );
5540  const int P = pn->listLength();
5541 
5542  if (pn->Typ()==CRING_CMD)
5543  {
5544  cf=(coeffs)pn->CopyD();
5545  leftv pnn=pn;
5546  if(P>1) /*parameter*/
5547  {
5548  pnn = pnn->next;
5549  const int pars = pnn->listLength();
5550  assume( pars > 0 );
5551  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5552 
5553  if (rSleftvList2StringArray(pnn, names))
5554  {
5555  WerrorS("parameter expected");
5556  goto rInitError;
5557  }
5558 
5559  TransExtInfo extParam;
5560 
5561  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5562  for(int i=pars-1; i>=0;i--)
5563  {
5564  omFree(names[i]);
5565  }
5566  omFree(names);
5567 
5568  cf = nInitChar(n_transExt, &extParam);
5569  }
5570  assume( cf != NULL );
5571  }
5572  else if (pn->Typ()==INT_CMD)
5573  {
5574  int ch = (int)(long)pn->Data();
5575  leftv pnn=pn;
5576 
5577  /* parameter? -------------------------------------------------------*/
5578  pnn = pnn->next;
5579 
5580  if (pnn == NULL) // no params!?
5581  {
5582  if (ch!=0)
5583  {
5584  int ch2=IsPrime(ch);
5585  if ((ch<2)||(ch!=ch2))
5586  {
5587  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5588  ch=32003;
5589  }
5590  cf = nInitChar(n_Zp, (void*)(long)ch);
5591  }
5592  else
5593  cf = nInitChar(n_Q, (void*)(long)ch);
5594  }
5595  else
5596  {
5597  const int pars = pnn->listLength();
5598 
5599  assume( pars > 0 );
5600 
5601  // predefined finite field: (p^k, a)
5602  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5603  {
5604  GFInfo param;
5605 
5606  param.GFChar = ch;
5607  param.GFDegree = 1;
5608  param.GFPar_name = pnn->name;
5609 
5610  cf = nInitChar(n_GF, &param);
5611  }
5612  else // (0/p, a, b, ..., z)
5613  {
5614  if ((ch!=0) && (ch!=IsPrime(ch)))
5615  {
5616  WerrorS("too many parameters");
5617  goto rInitError;
5618  }
5619 
5620  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5621 
5622  if (rSleftvList2StringArray(pnn, names))
5623  {
5624  WerrorS("parameter expected");
5625  goto rInitError;
5626  }
5627 
5628  TransExtInfo extParam;
5629 
5630  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5631  for(int i=pars-1; i>=0;i--)
5632  {
5633  omFree(names[i]);
5634  }
5635  omFree(names);
5636 
5637  cf = nInitChar(n_transExt, &extParam);
5638  }
5639  }
5640 
5641  //if (cf==NULL) ->Error: Invalid ground field specification
5642  }
5643  else if ((pn->name != NULL)
5644  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5645  {
5646  leftv pnn=pn->next;
5647  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5648  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5649  {
5650  float_len=(int)(long)pnn->Data();
5651  float_len2=float_len;
5652  pnn=pnn->next;
5653  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5654  {
5655  float_len2=(int)(long)pnn->Data();
5656  pnn=pnn->next;
5657  }
5658  }
5659 
5660  if (!complex_flag)
5661  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5662  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5663  cf=nInitChar(n_R, NULL);
5664  else // longR or longC?
5665  {
5666  LongComplexInfo param;
5667 
5668  param.float_len = si_min (float_len, 32767);
5669  param.float_len2 = si_min (float_len2, 32767);
5670 
5671  // set the parameter name
5672  if (complex_flag)
5673  {
5674  if (param.float_len < SHORT_REAL_LENGTH)
5675  {
5678  }
5679  if ((pnn == NULL) || (pnn->name == NULL))
5680  param.par_name=(const char*)"i"; //default to i
5681  else
5682  param.par_name = (const char*)pnn->name;
5683  }
5684 
5685  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5686  }
5687  assume( cf != NULL );
5688  }
5689 #ifdef HAVE_RINGS
5690  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5691  {
5692  // TODO: change to use coeffs_BIGINT!?
5693  mpz_t modBase;
5694  unsigned int modExponent = 1;
5695  mpz_init_set_si(modBase, 0);
5696  if (pn->next!=NULL)
5697  {
5698  leftv pnn=pn;
5699  if (pnn->next->Typ()==INT_CMD)
5700  {
5701  pnn=pnn->next;
5702  mpz_set_ui(modBase, (int)(long) pnn->Data());
5703  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5704  {
5705  pnn=pnn->next;
5706  modExponent = (long) pnn->Data();
5707  }
5708  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5709  {
5710  pnn=pnn->next;
5711  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5712  }
5713  }
5714  else if (pnn->next->Typ()==BIGINT_CMD)
5715  {
5716  number p=(number)pnn->next->CopyD();
5717  nlGMP(p,modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, mpz_t n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5718  n_Delete(&p,coeffs_BIGINT);
5719  }
5720  }
5721  else
5722  cf=nInitChar(n_Z,NULL);
5723 
5724  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5725  {
5726  WerrorS("Wrong ground ring specification (module is 1)");
5727  goto rInitError;
5728  }
5729  if (modExponent < 1)
5730  {
5731  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5732  goto rInitError;
5733  }
5734  // module is 0 ---> integers ringtype = 4;
5735  // we have an exponent
5736  if (modExponent > 1 && cf == NULL)
5737  {
5738  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5739  {
5740  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5741  depending on the size of a long on the respective platform */
5742  //ringtype = 1; // Use Z/2^ch
5743  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5744  }
5745  else
5746  {
5747  if (mpz_cmp_ui(modBase,0)==0)
5748  {
5749  WerrorS("modulus must not be 0 or parameter not allowed");
5750  goto rInitError;
5751  }
5752  //ringtype = 3;
5753  ZnmInfo info;
5754  info.base= modBase;
5755  info.exp= modExponent;
5756  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5757  }
5758  }
5759  // just a module m > 1
5760  else if (cf == NULL)
5761  {
5762  if (mpz_cmp_ui(modBase,0)==0)
5763  {
5764  WerrorS("modulus must not be 0 or parameter not allowed");
5765  goto rInitError;
5766  }
5767  //ringtype = 2;
5768  ZnmInfo info;
5769  info.base= modBase;
5770  info.exp= modExponent;
5771  cf=nInitChar(n_Zn,(void*) &info);
5772  }
5773  assume( cf != NULL );
5774  mpz_clear(modBase);
5775  }
5776 #endif
5777  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5778  else if ((pn->Typ()==RING_CMD) && (P == 1))
5779  {
5780  TransExtInfo extParam;
5781  extParam.r = (ring)pn->Data();
5782  cf = nInitChar(n_transExt, &extParam);
5783  }
5784  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5785  //{
5786  // AlgExtInfo extParam;
5787  // extParam.r = (ring)pn->Data();
5788 
5789  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5790  //}
5791  else
5792  {
5793  WerrorS("Wrong or unknown ground field specification");
5794 #if 0
5795 // debug stuff for unknown cf descriptions:
5796  sleftv* p = pn;
5797  while (p != NULL)
5798  {
5799  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5800  PrintLn();
5801  p = p->next;
5802  }
5803 #endif
5804  goto rInitError;
5805  }
5806 
5807  /*every entry in the new ring is initialized to 0*/
5808 
5809  /* characteristic -----------------------------------------------*/
5810  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5811  * 0 1 : Q(a,...) *names FALSE
5812  * 0 -1 : R NULL FALSE 0
5813  * 0 -1 : R NULL FALSE prec. >6
5814  * 0 -1 : C *names FALSE prec. 0..?
5815  * p p : Fp NULL FALSE
5816  * p -p : Fp(a) *names FALSE
5817  * q q : GF(q=p^n) *names TRUE
5818  */
5819  if (cf==NULL)
5820  {
5821  WerrorS("Invalid ground field specification");
5822  goto rInitError;
5823 // const int ch=32003;
5824 // cf=nInitChar(n_Zp, (void*)(long)ch);
5825  }
5826 
5827  assume( R != NULL );
5828 
5829  R->cf = cf;
5830 
5831  /* names and number of variables-------------------------------------*/
5832  {
5833  int l=rv->listLength();
5834 
5835  if (l>MAX_SHORT)
5836  {
5837  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5838  goto rInitError;
5839  }
5840  R->N = l; /*rv->listLength();*/
5841  }
5842  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5843  if (rSleftvList2StringArray(rv, R->names))
5844  {
5845  WerrorS("name of ring variable expected");
5846  goto rInitError;
5847  }
5848 
5849  /* check names and parameters for conflicts ------------------------- */
5850  rRenameVars(R); // conflicting variables will be renamed
5851  /* ordering -------------------------------------------------------------*/
5852  if (rSleftvOrdering2Ordering(ord, R))
5853  goto rInitError;
5854 
5855  // Complete the initialization
5856  if (rComplete(R,1))
5857  goto rInitError;
5858 
5859 /*#ifdef HAVE_RINGS
5860 // currently, coefficients which are ring elements require a global ordering:
5861  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5862  {
5863  WerrorS("global ordering required for these coefficients");
5864  goto rInitError;
5865  }
5866 #endif*/
5867 
5868  rTest(R);
5869 
5870  // try to enter the ring into the name list
5871  // need to clean up sleftv here, before this ring can be set to
5872  // new currRing or currRing can be killed beacuse new ring has
5873  // same name
5874  pn->CleanUp();
5875  rv->CleanUp();
5876  ord->CleanUp();
5877  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5878  // goto rInitError;
5879 
5880  //memcpy(IDRING(tmp),R,sizeof(*R));
5881  // set current ring
5882  //omFreeBin(R, ip_sring_bin);
5883  //return tmp;
5884  return R;
5885 
5886  // error case:
5887  rInitError:
5888  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5889  pn->CleanUp();
5890  rv->CleanUp();
5891  ord->CleanUp();
5892  return NULL;
5893 }
mpz_ptr base
Definition: rmodulon.h:19
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:83
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
const short MAX_SHORT
Definition: ipshell.cc:5512
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5476
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
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:121
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5204
Definition: tok.h:38
return P p
Definition: myNF.cc:203
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
{p < 2^31}
Definition: coeffs.h:30
int listLength()
Definition: subexpr.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:995
Creation data needed for finite fields.
Definition: coeffs.h:92
idhdl rDefault(const char *s)
Definition: ipshell.cc:1549
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:3365
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:394
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:42
#define rTest(r)
Definition: ring.h:777
omBin sip_sring_bin
Definition: ring.cc:54
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
struct for passing initialization parameters to naInitChar
Definition: transext.h:93
unsigned long exp
Definition: rmodulon.h:19
int i
Definition: cfEzgcd.cc:123
int IsPrime(int p)
Definition: prime.cc:61
void nlGMP(number &i, mpz_t n, const coeffs r)
Definition: longrat.cc:1482
static void rRenameVars(ring R)
Definition: ipshell.cc:2390
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
{p^n < 2^16}
Definition: coeffs.h:33
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
const char * par_name
parameter name
Definition: coeffs.h:103
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:459
kBucketDestroy & P
Definition: myNF.cc:191
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
void * CopyD(int t)
Definition: subexpr.cc:707
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:341
#define Warn
Definition: emacs.cc:80

◆ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6057 of file ipshell.cc.

6058 {
6059  if ((r->ref<=0)&&(r->order!=NULL))
6060  {
6061 #ifdef RDEBUG
6062  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6063 #endif
6064  int j;
6065  for (j=0;j<myynest;j++)
6066  {
6067  if (iiLocalRing[j]==r)
6068  {
6069  if (j==0) WarnS("killing the basering for level 0");
6070  iiLocalRing[j]=NULL;
6071  }
6072  }
6073 // any variables depending on r ?
6074  while (r->idroot!=NULL)
6075  {
6076  r->idroot->lev=myynest; // avoid warning about kill global objects
6077  killhdl2(r->idroot,&(r->idroot),r);
6078  }
6079  if (r==currRing)
6080  {
6081  // all dependend stuff is done, clean global vars:
6082  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6084  {
6086  }
6087  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6088  //{
6089  // WerrorS("return value depends on local ring variable (export missing ?)");
6090  // iiRETURNEXPR.CleanUp();
6091  //}
6092  currRing=NULL;
6093  currRingHdl=NULL;
6094  }
6095 
6096  /* nKillChar(r); will be called from inside of rDelete */
6097  rDelete(r);
6098  return;
6099  }
6100  r->ref--;
6101 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:83
int traceit
Definition: febase.cc:47
#define WarnS
Definition: emacs.cc:81
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:402
int j
Definition: myNF.cc:70
idhdl currRingHdl
Definition: ipid.cc:65
ring * iiLocalRing
Definition: iplib.cc:472
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
#define pDelete(p_ptr)
Definition: polys.h:169
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332

◆ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6103 of file ipshell.cc.

6104 {
6105  ring r = IDRING(h);
6106  int ref=0;
6107  if (r!=NULL)
6108  {
6109  // avoid, that sLastPrinted is the last reference to the base ring:
6110  // clean up before killing the last "named" refrence:
6111  if ((sLastPrinted.rtyp==RING_CMD)
6112  && (sLastPrinted.data==(void*)r))
6113  {
6114  sLastPrinted.CleanUp(r);
6115  }
6116  ref=r->ref;
6117  rKill(r);
6118  }
6119  if (h==currRingHdl)
6120  {
6121  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6122  else
6123  {
6125  }
6126  }
6127 }
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:6057
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1594
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:91
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5092 of file ipshell.cc.

5093 {
5094  // change some bad orderings/combination into better ones
5095  leftv h=ord;
5096  while(h!=NULL)
5097  {
5098  BOOLEAN change=FALSE;
5099  intvec *iv = (intvec *)(h->data);
5100  // ws(-i) -> wp(i)
5101  if ((*iv)[1]==ringorder_ws)
5102  {
5103  BOOLEAN neg=TRUE;
5104  for(int i=2;i<iv->length();i++)
5105  if((*iv)[i]>=0) { neg=FALSE; break; }
5106  if (neg)
5107  {
5108  (*iv)[1]=ringorder_wp;
5109  for(int i=2;i<iv->length();i++)
5110  (*iv)[i]= - (*iv)[i];
5111  change=TRUE;
5112  }
5113  }
5114  // Ws(-i) -> Wp(i)
5115  if ((*iv)[1]==ringorder_Ws)
5116  {
5117  BOOLEAN neg=TRUE;
5118  for(int i=2;i<iv->length();i++)
5119  if((*iv)[i]>=0) { neg=FALSE; break; }
5120  if (neg)
5121  {
5122  (*iv)[1]=ringorder_Wp;
5123  for(int i=2;i<iv->length();i++)
5124  (*iv)[i]= -(*iv)[i];
5125  change=TRUE;
5126  }
5127  }
5128  // wp(1) -> dp
5129  if ((*iv)[1]==ringorder_wp)
5130  {
5131  BOOLEAN all_one=TRUE;
5132  for(int i=2;i<iv->length();i++)
5133  if((*iv)[i]!=1) { all_one=FALSE; break; }
5134  if (all_one)
5135  {
5136  intvec *iv2=new intvec(3);
5137  (*iv2)[0]=1;
5138  (*iv2)[1]=ringorder_dp;
5139  (*iv2)[2]=iv->length()-2;
5140  delete iv;
5141  iv=iv2;
5142  h->data=iv2;
5143  change=TRUE;
5144  }
5145  }
5146  // Wp(1) -> Dp
5147  if ((*iv)[1]==ringorder_Wp)
5148  {
5149  BOOLEAN all_one=TRUE;
5150  for(int i=2;i<iv->length();i++)
5151  if((*iv)[i]!=1) { all_one=FALSE; break; }
5152  if (all_one)
5153  {
5154  intvec *iv2=new intvec(3);
5155  (*iv2)[0]=1;
5156  (*iv2)[1]=ringorder_Dp;
5157  (*iv2)[2]=iv->length()-2;
5158  delete iv;
5159  iv=iv2;
5160  h->data=iv2;
5161  change=TRUE;
5162  }
5163  }
5164  // dp(1)/Dp(1)/rp(1) -> lp(1)
5165  if (((*iv)[1]==ringorder_dp)
5166  || ((*iv)[1]==ringorder_Dp)
5167  || ((*iv)[1]==ringorder_rp))
5168  {
5169  if (iv->length()==3)
5170  {
5171  if ((*iv)[2]==1)
5172  {
5173  (*iv)[1]=ringorder_lp;
5174  change=TRUE;
5175  }
5176  }
5177  }
5178  // lp(i),lp(j) -> lp(i+j)
5179  if(((*iv)[1]==ringorder_lp)
5180  && (h->next!=NULL))
5181  {
5182  intvec *iv2 = (intvec *)(h->next->data);
5183  if ((*iv2)[1]==ringorder_lp)
5184  {
5185  leftv hh=h->next;
5186  h->next=hh->next;
5187  hh->next=NULL;
5188  if ((*iv2)[0]==1)
5189  (*iv)[2] += 1; // last block unspecified, at least 1
5190  else
5191  (*iv)[2] += (*iv2)[2];
5192  hh->CleanUp();
5193  omFree(hh);
5194  change=TRUE;
5195  }
5196  }
5197  // -------------------
5198  if (!change) h=h->next;
5199  }
5200  return ord;
5201 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * data
Definition: subexpr.h:88
Definition: intvec.h:14
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2390 of file ipshell.cc.

2391 {
2392  int i,j;
2393  BOOLEAN ch;
2394  do
2395  {
2396  ch=0;
2397  for(i=0;i<R->N-1;i++)
2398  {
2399  for(j=i+1;j<R->N;j++)
2400  {
2401  if (strcmp(R->names[i],R->names[j])==0)
2402  {
2403  ch=TRUE;
2404  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2405  omFree(R->names[j]);
2406  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2407  sprintf(R->names[j],"@%s",R->names[i]);
2408  }
2409  }
2410  }
2411  }
2412  while (ch);
2413  for(i=0;i<rPar(R); i++)
2414  {
2415  for(j=0;j<R->N;j++)
2416  {
2417  if (strcmp(rParameter(R)[i],R->names[j])==0)
2418  {
2419  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2420 // omFree(rParameter(R)[i]);
2421 // rParameter(R)[i]=(char *)omAlloc(10);
2422 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2423  omFree(R->names[j]);
2424  R->names[j]=(char *)omAlloc(10);
2425  sprintf(R->names[j],"@@(%d)",i+1);
2426  }
2427  }
2428  }
2429 }
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:590
#define TRUE
Definition: auxiliary.h:98
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
#define omAlloc(size)
Definition: omAllocDecl.h:210
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
const ring R
Definition: DebugPrint.cc:36
int i
Definition: cfEzgcd.cc:123
int BOOLEAN
Definition: auxiliary.h:85
#define Warn
Definition: emacs.cc:80

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5038 of file ipshell.cc.

5039 {
5040  ring rg = NULL;
5041  if (h!=NULL)
5042  {
5043 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5044  rg = IDRING(h);
5045  if (rg==NULL) return; //id <>NULL, ring==NULL
5046  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5047  if (IDID(h)) // OB: ????
5048  omCheckAddr((ADDRESS)IDID(h));
5049  rTest(rg);
5050  }
5051 
5052  // clean up history
5054  {
5056  memset(&sLastPrinted,0,sizeof(sleftv));
5057  }
5058 
5059  if ((rg!=currRing)&&(currRing!=NULL))
5060  {
5062  if (DENOMINATOR_LIST!=NULL)
5063  {
5064  if (TEST_V_ALLWARN)
5065  Warn("deleting denom_list for ring change to %s",IDID(h));
5066  do
5067  {
5068  n_Delete(&(dd->n),currRing->cf);
5069  dd=dd->next;
5071  DENOMINATOR_LIST=dd;
5072  } while(DENOMINATOR_LIST!=NULL);
5073  }
5074  }
5075 
5076  // test for valid "currRing":
5077  if ((rg!=NULL) && (rg->idroot==NULL))
5078  {
5079  ring old=rg;
5080  rg=rAssure_HasComp(rg);
5081  if (old!=rg)
5082  {
5083  rKill(old);
5084  IDRING(h)=rg;
5085  }
5086  }
5087  /*------------ change the global ring -----------------------*/
5088  rChangeCurrRing(rg);
5089  currRingHdl = h;
5090 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:119
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:89
void * ADDRESS
Definition: auxiliary.h:115
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4557
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
BOOLEAN RingDependend()
Definition: subexpr.cc:402
void rKill(ring r)
Definition: ipshell.cc:6057
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:777
idhdl currRingHdl
Definition: ipid.cc:65
void rChangeCurrRing(ring r)
Definition: polys.cc:12
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:59
#define IDRING(a)
Definition: ipid.h:124
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:459
static Poly * h
Definition: janet.cc:978
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

◆ rSimpleFindHdl()

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

Definition at line 6129 of file ipshell.cc.

6130 {
6131  idhdl h=root;
6132  while (h!=NULL)
6133  {
6134  if ((IDTYP(h)==RING_CMD)
6135  && (h!=n)
6136  && (IDRING(h)==r)
6137  )
6138  {
6139  return h;
6140  }
6141  h=IDNEXT(h);
6142  }
6143  return NULL;
6144 }
#define IDNEXT(a)
Definition: ipid.h:115
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
static Poly * h
Definition: janet.cc:978

◆ rSleftvList2StringArray()

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

Definition at line 5476 of file ipshell.cc.

5477 {
5478 
5479  while(sl!=NULL)
5480  {
5481  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5482  {
5483  *p = omStrDup(sl->Name());
5484  }
5485  else if (sl->name!=NULL)
5486  {
5487  *p = (char*)sl->name;
5488  sl->name=NULL;
5489  }
5490  else if (sl->rtyp==POLY_CMD)
5491  {
5492  sleftv s_sl;
5493  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5494  if (s_sl.name != NULL)
5495  {
5496  *p = (char*)s_sl.name; s_sl.name=NULL;
5497  }
5498  else
5499  *p = NULL;
5500  sl->next = s_sl.next;
5501  s_sl.next = NULL;
5502  s_sl.CleanUp();
5503  if (*p == NULL) return TRUE;
5504  }
5505  else return TRUE;
5506  p++;
5507  sl=sl->next;
5508  }
5509  return FALSE;
5510 }
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:401
return P p
Definition: myNF.cc:203
#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:332
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5204 of file ipshell.cc.

5205 {
5206  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5207  ord=rOptimizeOrdAsSleftv(ord);
5208  sleftv *sl = ord;
5209 
5210  // determine nBlocks
5211  while (sl!=NULL)
5212  {
5213  intvec *iv = (intvec *)(sl->data);
5214  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5215  i++;
5216  else if ((*iv)[1]==ringorder_L)
5217  {
5218  R->bitmask=(*iv)[2];
5219  n--;
5220  }
5221  else if (((*iv)[1]!=ringorder_a)
5222  && ((*iv)[1]!=ringorder_a64)
5223  && ((*iv)[1]!=ringorder_am))
5224  o++;
5225  n++;
5226  sl=sl->next;
5227  }
5228  // check whether at least one real ordering
5229  if (o==0)
5230  {
5231  WerrorS("invalid combination of orderings");
5232  return TRUE;
5233  }
5234  // if no c/C ordering is given, increment n
5235  if (i==0) n++;
5236  else if (i != 1)
5237  {
5238  // throw error if more than one is given
5239  WerrorS("more than one ordering c/C specified");
5240  return TRUE;
5241  }
5242 
5243  // initialize fields of R
5244  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5245  R->block0=(int *)omAlloc0(n*sizeof(int));
5246  R->block1=(int *)omAlloc0(n*sizeof(int));
5247  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5248 
5249  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5250 
5251  // init order, so that rBlocks works correctly
5252  for (j=0; j < n-1; j++)
5253  R->order[j] = ringorder_unspec;
5254  // set last _C order, if no c/C order was given
5255  if (i == 0) R->order[n-2] = ringorder_C;
5256 
5257  /* init orders */
5258  sl=ord;
5259  n=-1;
5260  while (sl!=NULL)
5261  {
5262  intvec *iv;
5263  iv = (intvec *)(sl->data);
5264  if ((*iv)[1]!=ringorder_L)
5265  {
5266  n++;
5267 
5268  /* the format of an ordering:
5269  * iv[0]: factor
5270  * iv[1]: ordering
5271  * iv[2..end]: weights
5272  */
5273  R->order[n] = (rRingOrder_t)((*iv)[1]);
5274  typ=1;
5275  switch ((*iv)[1])
5276  {
5277  case ringorder_ws:
5278  case ringorder_Ws:
5279  typ=-1;
5280  case ringorder_wp:
5281  case ringorder_Wp:
5282  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5283  R->block0[n] = last+1;
5284  for (i=2; i<iv->length(); i++)
5285  {
5286  R->wvhdl[n][i-2] = (*iv)[i];
5287  last++;
5288  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5289  }
5290  R->block1[n] = si_min(last,R->N);
5291  break;
5292  case ringorder_ls:
5293  case ringorder_ds:
5294  case ringorder_Ds:
5295  case ringorder_rs:
5296  typ=-1;
5297  case ringorder_lp:
5298  case ringorder_dp:
5299  case ringorder_Dp:
5300  case ringorder_rp:
5301  R->block0[n] = last+1;
5302  if (iv->length() == 3) last+=(*iv)[2];
5303  else last += (*iv)[0];
5304  R->block1[n] = si_min(last,R->N);
5305  if (rCheckIV(iv)) return TRUE;
5306  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5307  {
5308  if (weights[i]==0) weights[i]=typ;
5309  }
5310  break;
5311 
5312  case ringorder_s: // no 'rank' params!
5313  {
5314 
5315  if(iv->length() > 3)
5316  return TRUE;
5317 
5318  if(iv->length() == 3)
5319  {
5320  const int s = (*iv)[2];
5321  R->block0[n] = s;
5322  R->block1[n] = s;
5323  }
5324  break;
5325  }
5326  case ringorder_IS:
5327  {
5328  if(iv->length() != 3) return TRUE;
5329 
5330  const int s = (*iv)[2];
5331 
5332  if( 1 < s || s < -1 ) return TRUE;
5333 
5334  R->block0[n] = s;
5335  R->block1[n] = s;
5336  break;
5337  }
5338  case ringorder_S:
5339  case ringorder_c:
5340  case ringorder_C:
5341  {
5342  if (rCheckIV(iv)) return TRUE;
5343  break;
5344  }
5345  case ringorder_aa:
5346  case ringorder_a:
5347  {
5348  R->block0[n] = last+1;
5349  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5350  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5351  for (i=2; i<iv->length(); i++)
5352  {
5353  R->wvhdl[n][i-2]=(*iv)[i];
5354  last++;
5355  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5356  }
5357  last=R->block0[n]-1;
5358  break;
5359  }
5360  case ringorder_am:
5361  {
5362  R->block0[n] = last+1;
5363  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5364  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5365  if (R->block1[n]- R->block0[n]+2>=iv->length())
5366  WarnS("missing module weights");
5367  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5368  {
5369  R->wvhdl[n][i-2]=(*iv)[i];
5370  last++;
5371  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5372  }
5373  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5374  for (; i<iv->length(); i++)
5375  {
5376  R->wvhdl[n][i-1]=(*iv)[i];
5377  }
5378  last=R->block0[n]-1;
5379  break;
5380  }
5381  case ringorder_a64:
5382  {
5383  R->block0[n] = last+1;
5384  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5385  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5386  int64 *w=(int64 *)R->wvhdl[n];
5387  for (i=2; i<iv->length(); i++)
5388  {
5389  w[i-2]=(*iv)[i];
5390  last++;
5391  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5392  }
5393  last=R->block0[n]-1;
5394  break;
5395  }
5396  case ringorder_M:
5397  {
5398  int Mtyp=rTypeOfMatrixOrder(iv);
5399  if (Mtyp==0) return TRUE;
5400  if (Mtyp==-1) typ = -1;
5401 
5402  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5403  for (i=2; i<iv->length();i++)
5404  R->wvhdl[n][i-2]=(*iv)[i];
5405 
5406  R->block0[n] = last+1;
5407  last += (int)sqrt((double)(iv->length()-2));
5408  R->block1[n] = si_min(last,R->N);
5409  for(i=R->block1[n];i>=R->block0[n];i--)
5410  {
5411  if (weights[i]==0) weights[i]=typ;
5412  }
5413  break;
5414  }
5415 
5416  case ringorder_no:
5417  R->order[n] = ringorder_unspec;
5418  return TRUE;
5419 
5420  default:
5421  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5422  R->order[n] = ringorder_unspec;
5423  return TRUE;
5424  }
5425  }
5426  if (last>R->N)
5427  {
5428  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5429  R->N,last);
5430  return TRUE;
5431  }
5432  sl=sl->next;
5433  }
5434  // find OrdSgn:
5435  R->OrdSgn = 1;
5436  for(i=1;i<=R->N;i++)
5437  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5438  omFree(weights);
5439 
5440  // check for complete coverage
5441  while ( n >= 0 && (
5442  (R->order[n]==ringorder_c)
5443  || (R->order[n]==ringorder_C)
5444  || (R->order[n]==ringorder_s)
5445  || (R->order[n]==ringorder_S)
5446  || (R->order[n]==ringorder_IS)
5447  )) n--;
5448 
5449  assume( n >= 0 );
5450 
5451  if (R->block1[n] != R->N)
5452  {
5453  if (((R->order[n]==ringorder_dp) ||
5454  (R->order[n]==ringorder_ds) ||
5455  (R->order[n]==ringorder_Dp) ||
5456  (R->order[n]==ringorder_Ds) ||
5457  (R->order[n]==ringorder_rp) ||
5458  (R->order[n]==ringorder_rs) ||
5459  (R->order[n]==ringorder_lp) ||
5460  (R->order[n]==ringorder_ls))
5461  &&
5462  R->block0[n] <= R->N)
5463  {
5464  R->block1[n] = R->N;
5465  }
5466  else
5467  {
5468  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5469  R->N,R->block1[n]);
5470  return TRUE;
5471  }
5472  }
5473  return FALSE;
5474 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:99
const CanonicalForm int s
Definition: facAbsFact.cc:55
for int64 weights
Definition: ring.h:79
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
if(0 > strat->sl)
Definition: myNF.cc:73
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
#define FALSE
Definition: auxiliary.h:94
opposite of ls
Definition: ring.h:100
static poly last
Definition: hdegree.cc:1077
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
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:81
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
Definition: intvec.h:14
for(int i=0;i< R->ExpL_Size;i++) Print("%09lx "
Definition: cfEzgcd.cc:66
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5092
#define assume(x)
Definition: mod2.h:394
const ring R
Definition: DebugPrint.cc:36
rRingOrder_t
order stuff
Definition: ring.h:75
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:185
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
S?
Definition: ring.h:83
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:195
const CanonicalForm & w
Definition: facAbsFact.cc:55
int * int_ptr
Definition: structs.h:57
s?
Definition: ring.h:84
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 5895 of file ipshell.cc.

5896 {
5897  ring R = rCopy0(org_ring);
5898  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5899  int n = rBlocks(org_ring), i=0, j;
5900 
5901  /* names and number of variables-------------------------------------*/
5902  {
5903  int l=rv->listLength();
5904  if (l>MAX_SHORT)
5905  {
5906  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5907  goto rInitError;
5908  }
5909  R->N = l; /*rv->listLength();*/
5910  }
5911  omFree(R->names);
5912  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5913  if (rSleftvList2StringArray(rv, R->names))
5914  {
5915  WerrorS("name of ring variable expected");
5916  goto rInitError;
5917  }
5918 
5919  /* check names for subring in org_ring ------------------------- */
5920  {
5921  i=0;
5922 
5923  for(j=0;j<R->N;j++)
5924  {
5925  for(;i<org_ring->N;i++)
5926  {
5927  if (strcmp(org_ring->names[i],R->names[j])==0)
5928  {
5929  perm[i+1]=j+1;
5930  break;
5931  }
5932  }
5933  if (i>org_ring->N)
5934  {
5935  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5936  break;
5937  }
5938  }
5939  }
5940  //Print("perm=");
5941  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5942  /* ordering -------------------------------------------------------------*/
5943 
5944  for(i=0;i<n;i++)
5945  {
5946  int min_var=-1;
5947  int max_var=-1;
5948  for(j=R->block0[i];j<=R->block1[i];j++)
5949  {
5950  if (perm[j]>0)
5951  {
5952  if (min_var==-1) min_var=perm[j];
5953  max_var=perm[j];
5954  }
5955  }
5956  if (min_var!=-1)
5957  {
5958  //Print("block %d: old %d..%d, now:%d..%d\n",
5959  // i,R->block0[i],R->block1[i],min_var,max_var);
5960  R->block0[i]=min_var;
5961  R->block1[i]=max_var;
5962  if (R->wvhdl[i]!=NULL)
5963  {
5964  omFree(R->wvhdl[i]);
5965  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5966  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5967  {
5968  if (perm[j]>0)
5969  {
5970  R->wvhdl[i][perm[j]-R->block0[i]]=
5971  org_ring->wvhdl[i][j-org_ring->block0[i]];
5972  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5973  }
5974  }
5975  }
5976  }
5977  else
5978  {
5979  if(R->block0[i]>0)
5980  {
5981  //Print("skip block %d\n",i);
5982  R->order[i]=ringorder_unspec;
5983  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5984  R->wvhdl[i]=NULL;
5985  }
5986  //else Print("keep block %d\n",i);
5987  }
5988  }
5989  i=n-1;
5990  while(i>0)
5991  {
5992  // removed unneded blocks
5993  if(R->order[i-1]==ringorder_unspec)
5994  {
5995  for(j=i;j<=n;j++)
5996  {
5997  R->order[j-1]=R->order[j];
5998  R->block0[j-1]=R->block0[j];
5999  R->block1[j-1]=R->block1[j];
6000  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6001  R->wvhdl[j-1]=R->wvhdl[j];
6002  }
6003  R->order[n]=ringorder_unspec;
6004  n--;
6005  }
6006  i--;
6007  }
6008  n=rBlocks(org_ring)-1;
6009  while (R->order[n]==0) n--;
6010  while (R->order[n]==ringorder_unspec) n--;
6011  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6012  if (R->block1[n] != R->N)
6013  {
6014  if (((R->order[n]==ringorder_dp) ||
6015  (R->order[n]==ringorder_ds) ||
6016  (R->order[n]==ringorder_Dp) ||
6017  (R->order[n]==ringorder_Ds) ||
6018  (R->order[n]==ringorder_rp) ||
6019  (R->order[n]==ringorder_rs) ||
6020  (R->order[n]==ringorder_lp) ||
6021  (R->order[n]==ringorder_ls))
6022  &&
6023  R->block0[n] <= R->N)
6024  {
6025  R->block1[n] = R->N;
6026  }
6027  else
6028  {
6029  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6030  R->N,R->block1[n],n);
6031  return NULL;
6032  }
6033  }
6034  omFree(perm);
6035  // find OrdSgn:
6036  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6037  //for(i=1;i<=R->N;i++)
6038  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6039  //omFree(weights);
6040  // Complete the initialization
6041  if (rComplete(R,1))
6042  goto rInitError;
6043 
6044  rTest(R);
6045 
6046  if (rv != NULL) rv->CleanUp();
6047 
6048  return R;
6049 
6050  // error case:
6051  rInitError:
6052  if (R != NULL) rDelete(R);
6053  if (rv != NULL) rv->CleanUp();
6054  return NULL;
6055 }
const short MAX_SHORT
Definition: ipshell.cc:5512
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5476
opposite of ls
Definition: ring.h:100
int listLength()
Definition: subexpr.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * char_ptr
Definition: structs.h:56
static int rBlocks(ring r)
Definition: ring.h:559
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:3365
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1325
const ring R
Definition: DebugPrint.cc:36
#define rTest(r)
Definition: ring.h:777
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94

◆ scIndIndset()

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

Definition at line 1022 of file ipshell.cc.

1023 {
1024  int i;
1025  indset save;
1027 
1028  hexist = hInit(S, Q, &hNexist, currRing);
1029  if (hNexist == 0)
1030  {
1031  intvec *iv=new intvec(rVar(currRing));
1032  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1033  res->Init(1);
1034  res->m[0].rtyp=INTVEC_CMD;
1035  res->m[0].data=(intvec*)iv;
1036  return res;
1037  }
1038  else if (hisModule!=0)
1039  {
1040  res->Init(0);
1041  return res;
1042  }
1043  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1044  hMu = 0;
1045  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1046  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1047  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1048  hrad = hexist;
1049  hNrad = hNexist;
1050  radmem = hCreate(rVar(currRing) - 1);
1051  hCo = rVar(currRing) + 1;
1052  hNvar = rVar(currRing);
1053  hRadical(hrad, &hNrad, hNvar);
1054  hSupp(hrad, hNrad, hvar, &hNvar);
1055  if (hNvar)
1056  {
1057  hCo = hNvar;
1058  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1059  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1060  hLexR(hrad, hNrad, hvar, hNvar);
1062  }
1063  if (hCo && (hCo < rVar(currRing)))
1064  {
1066  }
1067  if (hMu!=0)
1068  {
1069  ISet = save;
1070  hMu2 = 0;
1071  if (all && (hCo+1 < rVar(currRing)))
1072  {
1075  i=hMu+hMu2;
1076  res->Init(i);
1077  if (hMu2 == 0)
1078  {
1080  }
1081  }
1082  else
1083  {
1084  res->Init(hMu);
1085  }
1086  for (i=0;i<hMu;i++)
1087  {
1088  res->m[i].data = (void *)save->set;
1089  res->m[i].rtyp = INTVEC_CMD;
1090  ISet = save;
1091  save = save->nx;
1093  }
1094  omFreeBin((ADDRESS)save, indlist_bin);
1095  if (hMu2 != 0)
1096  {
1097  save = JSet;
1098  for (i=hMu;i<hMu+hMu2;i++)
1099  {
1100  res->m[i].data = (void *)save->set;
1101  res->m[i].rtyp = INTVEC_CMD;
1102  JSet = save;
1103  save = save->nx;
1105  }
1106  omFreeBin((ADDRESS)save, indlist_bin);
1107  }
1108  }
1109  else
1110  {
1111  res->Init(0);
1113  }
1114  hKill(radmem, rVar(currRing) - 1);
1115  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1116  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1117  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1119  return res;
1120 }
int hMu2
Definition: hdegree.cc:22
sleftv * m
Definition: lists.h:45
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:19
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:18
#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:583
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:115
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 * data
Definition: subexpr.h:88
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:146
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
indset ISet
Definition: hdegree.cc:279
Definition: intvec.h:14
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:31
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:17
int i
Definition: cfEzgcd.cc:123
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
monf radmem
Definition: hutil.cc:24
int rtyp
Definition: subexpr.h:91
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 4477 of file ipshell.cc.

4478 {
4479  sleftv tmp;
4480  memset(&tmp,0,sizeof(tmp));
4481  tmp.rtyp=INT_CMD;
4482  /* tmp.data = (void *)0; -- done by memset */
4483 
4484  return semicProc3(res,u,v,&tmp);
4485 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4437
int rtyp
Definition: subexpr.h:91

◆ semicProc3()

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

Definition at line 4437 of file ipshell.cc.

4438 {
4439  semicState state;
4440  BOOLEAN qh=(((int)(long)w->Data())==1);
4441 
4442  // -----------------
4443  // check arguments
4444  // -----------------
4445 
4446  lists l1 = (lists)u->Data( );
4447  lists l2 = (lists)v->Data( );
4448 
4449  if( (state=list_is_spectrum( l1 ))!=semicOK )
4450  {
4451  WerrorS( "first argument is not a spectrum" );
4452  list_error( state );
4453  }
4454  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4455  {
4456  WerrorS( "second argument is not a spectrum" );
4457  list_error( state );
4458  }
4459  else
4460  {
4461  spectrum s1= spectrumFromList( l1 );
4462  spectrum s2= spectrumFromList( l2 );
4463 
4464  res->rtyp = INT_CMD;
4465  if (qh)
4466  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4467  else
4468  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4469  }
4470 
4471  // -----------------
4472  // check status
4473  // -----------------
4474 
4475  return (state!=semicOK);
4476 }
Definition: tok.h:95
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
void * data
Definition: subexpr.h:88
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3360
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
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 4354 of file ipshell.cc.

4355 {
4356  semicState state;
4357 
4358  // -----------------
4359  // check arguments
4360  // -----------------
4361 
4362  lists l1 = (lists)first->Data( );
4363  lists l2 = (lists)second->Data( );
4364 
4365  if( (state=list_is_spectrum( l1 )) != semicOK )
4366  {
4367  WerrorS( "first argument is not a spectrum:" );
4368  list_error( state );
4369  }
4370  else if( (state=list_is_spectrum( l2 )) != semicOK )
4371  {
4372  WerrorS( "second argument is not a spectrum:" );
4373  list_error( state );
4374  }
4375  else
4376  {
4377  spectrum s1= spectrumFromList ( l1 );
4378  spectrum s2= spectrumFromList ( l2 );
4379  spectrum sum( s1+s2 );
4380 
4381  result->rtyp = LIST_CMD;
4382  result->data = (char*)(getList(sum));
4383  }
4384 
4385  return (state!=semicOK);
4386 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3322
void * data
Definition: subexpr.h:88
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
semicState
Definition: ipshell.cc:3360
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117

◆ spectrumCompute()

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

Definition at line 3736 of file ipshell.cc.

3737 {
3738  int i;
3739 
3740  #ifdef SPECTRUM_DEBUG
3741  #ifdef SPECTRUM_PRINT
3742  #ifdef SPECTRUM_IOSTREAM
3743  cout << "spectrumCompute\n";
3744  if( fast==0 ) cout << " no optimization" << endl;
3745  if( fast==1 ) cout << " weight optimization" << endl;
3746  if( fast==2 ) cout << " symmetry optimization" << endl;
3747  #else
3748  fputs( "spectrumCompute\n",stdout );
3749  if( fast==0 ) fputs( " no optimization\n", stdout );
3750  if( fast==1 ) fputs( " weight optimization\n", stdout );
3751  if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3752  #endif
3753  #endif
3754  #endif
3755 
3756  // ----------------------
3757  // check if h is zero
3758  // ----------------------
3759 
3760  if( h==(poly)NULL )
3761  {
3762  return spectrumZero;
3763  }
3764 
3765  // ----------------------------------
3766  // check if h has a constant term
3767  // ----------------------------------
3768 
3769  if( hasConstTerm( h, currRing ) )
3770  {
3771  return spectrumBadPoly;
3772  }
3773 
3774  // --------------------------------
3775  // check if h has a linear term
3776  // --------------------------------
3777 
3778  if( hasLinearTerm( h, currRing ) )
3779  {
3780  *L = (lists)omAllocBin( slists_bin);
3781  (*L)->Init( 1 );
3782  (*L)->m[0].rtyp = INT_CMD; // milnor number
3783  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3784 
3785  return spectrumNoSingularity;
3786  }
3787 
3788  // ----------------------------------
3789  // compute the jacobi ideal of (h)
3790  // ----------------------------------
3791 
3792  ideal J = NULL;
3793  J = idInit( rVar(currRing),1 );
3794 
3795  #ifdef SPECTRUM_DEBUG
3796  #ifdef SPECTRUM_PRINT
3797  #ifdef SPECTRUM_IOSTREAM
3798  cout << "\n computing the Jacobi ideal...\n";
3799  #else
3800  fputs( "\n computing the Jacobi ideal...\n",stdout );
3801  #endif
3802  #endif
3803  #endif
3804 
3805  for( i=0; i<rVar(currRing); i++ )
3806  {
3807  J->m[i] = pDiff( h,i+1); //j );
3808 
3809  #ifdef SPECTRUM_DEBUG
3810  #ifdef SPECTRUM_PRINT
3811  #ifdef SPECTRUM_IOSTREAM
3812  cout << " ";
3813  #else
3814  fputs(" ", stdout );
3815  #endif
3816  pWrite( J->m[i] );
3817  #endif
3818  #endif
3819  }
3820 
3821  // --------------------------------------------
3822  // compute a standard basis stdJ of jac(h)
3823  // --------------------------------------------
3824 
3825  #ifdef SPECTRUM_DEBUG
3826  #ifdef SPECTRUM_PRINT
3827  #ifdef SPECTRUM_IOSTREAM
3828  cout << endl;
3829  cout << " computing a standard basis..." << endl;
3830  #else
3831  fputs( "\n", stdout );
3832  fputs( " computing a standard basis...\n", stdout );
3833  #endif
3834  #endif
3835  #endif
3836 
3837  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3838  idSkipZeroes( stdJ );
3839 
3840  #ifdef SPECTRUM_DEBUG
3841  #ifdef SPECTRUM_PRINT
3842  for( i=0; i<IDELEMS(stdJ); i++ )
3843  {
3844  #ifdef SPECTRUM_IOSTREAM
3845  cout << " ";
3846  #else
3847  fputs( " ",stdout );
3848  #endif
3849 
3850  pWrite( stdJ->m[i] );
3851  }
3852  #endif
3853  #endif
3854 
3855  idDelete( &J );
3856 
3857  // ------------------------------------------
3858  // check if the h has a singularity
3859  // ------------------------------------------
3860 
3861  if( hasOne( stdJ, currRing ) )
3862  {
3863  // -------------------------------
3864  // h is smooth in the origin
3865  // return only the Milnor number
3866  // -------------------------------
3867 
3868  *L = (lists)omAllocBin( slists_bin);
3869  (*L)->Init( 1 );
3870  (*L)->m[0].rtyp = INT_CMD; // milnor number
3871  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3872 
3873  return spectrumNoSingularity;
3874  }
3875 
3876  // ------------------------------------------
3877  // check if the singularity h is isolated
3878  // ------------------------------------------
3879 
3880  for( i=rVar(currRing); i>0; i-- )
3881  {
3882  if( hasAxis( stdJ,i, currRing )==FALSE )
3883  {
3884  return spectrumNotIsolated;
3885  }
3886  }
3887 
3888  // ------------------------------------------
3889  // compute the highest corner hc of stdJ
3890  // ------------------------------------------
3891 
3892  #ifdef SPECTRUM_DEBUG
3893  #ifdef SPECTRUM_PRINT
3894  #ifdef SPECTRUM_IOSTREAM
3895  cout << "\n computing the highest corner...\n";
3896  #else
3897  fputs( "\n computing the highest corner...\n", stdout );
3898  #endif
3899  #endif
3900  #endif
3901 
3902  poly hc = (poly)NULL;
3903 
3904  scComputeHC( stdJ,currRing->qideal, 0,hc );
3905 
3906  if( hc!=(poly)NULL )
3907  {
3908  pGetCoeff(hc) = nInit(1);
3909 
3910  for( i=rVar(currRing); i>0; i-- )
3911  {
3912  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3913  }
3914  pSetm( hc );
3915  }
3916  else
3917  {
3918  return spectrumNoHC;
3919  }
3920 
3921  #ifdef SPECTRUM_DEBUG
3922  #ifdef SPECTRUM_PRINT
3923  #ifdef SPECTRUM_IOSTREAM
3924  cout << " ";
3925  #else
3926  fputs( " ", stdout );
3927  #endif
3928  pWrite( hc );
3929  #endif
3930  #endif
3931 
3932  // ----------------------------------------
3933  // compute the Newton polygon nph of h
3934  // ----------------------------------------
3935 
3936  #ifdef SPECTRUM_DEBUG
3937  #ifdef SPECTRUM_PRINT
3938  #ifdef SPECTRUM_IOSTREAM
3939  cout << "\n computing the newton polygon...\n";
3940  #else
3941  fputs( "\n computing the newton polygon...\n", stdout );
3942  #endif
3943  #endif
3944  #endif
3945 
3946  newtonPolygon nph( h, currRing );
3947 
3948  #ifdef SPECTRUM_DEBUG
3949  #ifdef SPECTRUM_PRINT
3950  cout << nph;
3951  #endif
3952  #endif
3953 
3954  // -----------------------------------------------
3955  // compute the weight corner wc of (stdj,nph)
3956  // -----------------------------------------------
3957 
3958  #ifdef SPECTRUM_DEBUG
3959  #ifdef SPECTRUM_PRINT
3960  #ifdef SPECTRUM_IOSTREAM
3961  cout << "\n computing the weight corner...\n";
3962  #else
3963  fputs( "\n computing the weight corner...\n", stdout );
3964  #endif
3965  #endif
3966  #endif
3967 
3968  poly wc = ( fast==0 ? pCopy( hc ) :
3969  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3970  /* fast==2 */computeWC( nph,
3971  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3972 
3973  #ifdef SPECTRUM_DEBUG
3974  #ifdef SPECTRUM_PRINT
3975  #ifdef SPECTRUM_IOSTREAM
3976  cout << " ";
3977  #else
3978  fputs( " ", stdout );
3979  #endif
3980  pWrite( wc );
3981  #endif
3982  #endif
3983 
3984  // -------------
3985  // compute NF
3986  // -------------
3987 
3988  #ifdef SPECTRUM_DEBUG
3989  #ifdef SPECTRUM_PRINT
3990  #ifdef SPECTRUM_IOSTREAM
3991  cout << "\n computing NF...\n" << endl;
3992  #else
3993  fputs( "\n computing NF...\n", stdout );
3994  #endif
3995  #endif
3996  #endif
3997 
3998  spectrumPolyList NF( &nph );
3999 
4000  computeNF( stdJ,hc,wc,&NF, currRing );
4001 
4002  #ifdef SPECTRUM_DEBUG
4003  #ifdef SPECTRUM_PRINT
4004  cout << NF;
4005  #ifdef SPECTRUM_IOSTREAM
4006  cout << endl;
4007  #else
4008  fputs( "\n", stdout );
4009  #endif
4010  #endif
4011  #endif
4012 
4013  // ----------------------------
4014  // compute the spectrum of h
4015  // ----------------------------
4016 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4017 
4018  return spectrumStateFromList(NF, L, fast );
4019 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define pSetm(p)
Definition: polys.h:253
Definition: tok.h:95
#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:583
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:2231
void pWrite(poly p)
Definition: polys.h:290
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:51
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#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:3495
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:123
#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:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
omBin slists_bin
Definition: lists.cc:23
#define pDiff(a, b)
Definition: polys.h:278
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
static Poly * h
Definition: janet.cc:978
#define pCopy(p)
return a copy of the poly
Definition: polys.h:168
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 4110 of file ipshell.cc.

4111 {
4112  spectrumState state = spectrumOK;
4113 
4114  // -------------------
4115  // check consistency
4116  // -------------------
4117 
4118  // check for a local polynomial ring
4119 
4120  if( currRing->OrdSgn != -1 )
4121  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4122  // or should we use:
4123  //if( !ringIsLocal( ) )
4124  {
4125  WerrorS( "only works for local orderings" );
4126  state = spectrumWrongRing;
4127  }
4128  else if( currRing->qideal != NULL )
4129  {
4130  WerrorS( "does not work in quotient rings" );
4131  state = spectrumWrongRing;
4132  }
4133  else
4134  {
4135  lists L = (lists)NULL;
4136  int flag = 2; // symmetric optimization
4137 
4138  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4139 
4140  if( state==spectrumOK )
4141  {
4142  result->rtyp = LIST_CMD;
4143  result->data = (char*)L;
4144  }
4145  else
4146  {
4147  spectrumPrintError(state);
4148  }
4149  }
4150 
4151  return (state!=spectrumOK);
4152 }
spectrumState
Definition: ipshell.cc:3476
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4028
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3736
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3310 of file ipshell.cc.

3311 {
3312  spectrum result;
3313  copy_deep( result, l );
3314  return result;
3315 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3286
return result
Definition: facAbsBiFact.cc:76

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4028 of file ipshell.cc.

4029 {
4030  switch( state )
4031  {
4032  case spectrumZero:
4033  WerrorS( "polynomial is zero" );
4034  break;
4035  case spectrumBadPoly:
4036  WerrorS( "polynomial has constant term" );
4037  break;
4038  case spectrumNoSingularity:
4039  WerrorS( "not a singularity" );
4040  break;
4041  case spectrumNotIsolated:
4042  WerrorS( "the singularity is not isolated" );
4043  break;
4044  case spectrumNoHC:
4045  WerrorS( "highest corner cannot be computed" );
4046  break;
4047  case spectrumDegenerate:
4048  WerrorS( "principal part is degenerate" );
4049  break;
4050  case spectrumOK:
4051  break;
4052 
4053  default:
4054  WerrorS( "unknown error occurred" );
4055  break;
4056  }
4057 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4059 of file ipshell.cc.

4060 {
4061  spectrumState state = spectrumOK;
4062 
4063  // -------------------
4064  // check consistency
4065  // -------------------
4066 
4067  // check for a local ring
4068 
4069  if( !ringIsLocal(currRing ) )
4070  {
4071  WerrorS( "only works for local orderings" );
4072  state = spectrumWrongRing;
4073  }
4074 
4075  // no quotient rings are allowed
4076 
4077  else if( currRing->qideal != NULL )
4078  {
4079  WerrorS( "does not work in quotient rings" );
4080  state = spectrumWrongRing;
4081  }
4082  else
4083  {
4084  lists L = (lists)NULL;
4085  int flag = 1; // weight corner optimization is safe
4086 
4087  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4088 
4089  if( state==spectrumOK )
4090  {
4091  result->rtyp = LIST_CMD;
4092  result->data = (char*)L;
4093  }
4094  else
4095  {
4096  spectrumPrintError(state);
4097  }
4098  }
4099 
4100  return (state!=spectrumOK);
4101 }
spectrumState
Definition: ipshell.cc:3476
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4028
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3736
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10

◆ spectrumStateFromList()

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

Definition at line 3495 of file ipshell.cc.

3496 {
3497  spectrumPolyNode **node = &speclist.root;
3499 
3500  poly f,tmp;
3501  int found,cmp;
3502 
3503  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3504  ( fast==2 ? 2 : 1 ) );
3505 
3506  Rational weight_prev( 0,1 );
3507 
3508  int mu = 0; // the milnor number
3509  int pg = 0; // the geometrical genus
3510  int n = 0; // number of different spectral numbers
3511  int z = 0; // number of spectral number equal to smax
3512 
3513  while( (*node)!=(spectrumPolyNode*)NULL &&
3514  ( fast==0 || (*node)->weight<=smax ) )
3515  {
3516  // ---------------------------------------
3517  // determine the first normal form which
3518  // contains the monomial node->mon
3519  // ---------------------------------------
3520 
3521  found = FALSE;
3522  search = *node;
3523 
3524  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3525  {
3526  if( search->nf!=(poly)NULL )
3527  {
3528  f = search->nf;
3529 
3530  do
3531  {
3532  // --------------------------------
3533  // look for (*node)->mon in f
3534  // --------------------------------
3535 
3536  cmp = pCmp( (*node)->mon,f );
3537 
3538  if( cmp<0 )
3539  {
3540  f = pNext( f );
3541  }
3542  else if( cmp==0 )
3543  {
3544  // -----------------------------
3545  // we have found a normal form
3546  // -----------------------------
3547 
3548  found = TRUE;
3549 
3550  // normalize coefficient
3551 
3552  number inv = nInvers( pGetCoeff( f ) );
3553  pMult_nn( search->nf,inv );
3554  nDelete( &inv );
3555 
3556  // exchange normal forms
3557 
3558  tmp = (*node)->nf;
3559  (*node)->nf = search->nf;
3560  search->nf = tmp;
3561  }
3562  }
3563  while( cmp<0 && f!=(poly)NULL );
3564  }
3565  search = search->next;
3566  }
3567 
3568  if( found==FALSE )
3569  {
3570  // ------------------------------------------------
3571  // the weight of node->mon is a spectrum number
3572  // ------------------------------------------------
3573 
3574  mu++;
3575 
3576  if( (*node)->weight<=(Rational)1 ) pg++;
3577  if( (*node)->weight==smax ) z++;
3578  if( (*node)->weight>weight_prev ) n++;
3579 
3580  weight_prev = (*node)->weight;
3581  node = &((*node)->next);
3582  }
3583  else
3584  {
3585  // -----------------------------------------------
3586  // determine all other normal form which contain
3587  // the monomial node->mon
3588  // replace for node->mon its normal form
3589  // -----------------------------------------------
3590 
3591  while( search!=(spectrumPolyNode*)NULL )
3592  {
3593  if( search->nf!=(poly)NULL )
3594  {
3595  f = search->nf;
3596 
3597  do
3598  {
3599  // --------------------------------
3600  // look for (*node)->mon in f
3601  // --------------------------------
3602 
3603  cmp = pCmp( (*node)->mon,f );
3604 
3605  if( cmp<0 )
3606  {
3607  f = pNext( f );
3608  }
3609  else if( cmp==0 )
3610  {
3611  search->nf = pSub( search->nf,
3612  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3613  pNorm( search->nf );
3614  }
3615  }
3616  while( cmp<0 && f!=(poly)NULL );
3617  }
3618  search = search->next;
3619  }
3620  speclist.delete_node( node );
3621  }
3622 
3623  }
3624 
3625  // --------------------------------------------------------
3626  // fast computation exploits the symmetry of the spectrum
3627  // --------------------------------------------------------
3628 
3629  if( fast==2 )
3630  {
3631  mu = 2*mu - z;
3632  n = ( z > 0 ? 2*n - 1 : 2*n );
3633  }
3634 
3635  // --------------------------------------------------------
3636  // compute the spectrum numbers with their multiplicities
3637  // --------------------------------------------------------
3638 
3639  intvec *nom = new intvec( n );
3640  intvec *den = new intvec( n );
3641  intvec *mult = new intvec( n );
3642 
3643  int count = 0;
3644  int multiplicity = 1;
3645 
3646  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3647  ( fast==0 || search->weight<=smax );
3648  search=search->next )
3649  {
3650  if( search->next==(spectrumPolyNode*)NULL ||
3651  search->weight<search->next->weight )
3652  {
3653  (*nom) [count] = search->weight.get_num_si( );
3654  (*den) [count] = search->weight.get_den_si( );
3655  (*mult)[count] = multiplicity;
3656 
3657  multiplicity=1;
3658  count++;
3659  }
3660  else
3661  {
3662  multiplicity++;
3663  }
3664  }
3665 
3666  // --------------------------------------------------------
3667  // fast computation exploits the symmetry of the spectrum
3668  // --------------------------------------------------------
3669 
3670  if( fast==2 )
3671  {
3672  int n1,n2;
3673  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3674  {
3675  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3676  (*den) [n2] = (*den)[n1];
3677  (*mult)[n2] = (*mult)[n1];
3678  }
3679  }
3680 
3681  // -----------------------------------
3682  // test if the spectrum is symmetric
3683  // -----------------------------------
3684 
3685  if( fast==0 || fast==1 )
3686  {
3687  int symmetric=TRUE;
3688 
3689  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3690  {
3691  if( (*mult)[n1]!=(*mult)[n2] ||
3692  (*den) [n1]!= (*den)[n2] ||
3693  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3694  {
3695  symmetric = FALSE;
3696  }
3697  }
3698 
3699  if( symmetric==FALSE )
3700  {
3701  // ---------------------------------------------
3702  // the spectrum is not symmetric => degenerate
3703  // principal part
3704  // ---------------------------------------------
3705 
3706  *L = (lists)omAllocBin( slists_bin);
3707  (*L)->Init( 1 );
3708  (*L)->m[0].rtyp = INT_CMD; // milnor number
3709  (*L)->m[0].data = (void*)(long)mu;
3710 
3711  return spectrumDegenerate;
3712  }
3713  }
3714 
3715  *L = (lists)omAllocBin( slists_bin);
3716 
3717  (*L)->Init( 6 );
3718 
3719  (*L)->m[0].rtyp = INT_CMD; // milnor number
3720  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3721  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3722  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3723  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3724  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3725 
3726  (*L)->m[0].data = (void*)(long)mu;
3727  (*L)->m[1].data = (void*)(long)pg;
3728  (*L)->m[2].data = (void*)(long)n;
3729  (*L)->m[3].data = (void*)nom;
3730  (*L)->m[4].data = (void*)den;
3731  (*L)->m[5].data = (void*)mult;
3732 
3733  return spectrumOK;
3734 }
int status int void size_t count
Definition: si_signals.h:59
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
spectrumPolyNode * next
Definition: splist.h:39
void mu(int **points, int sizePoints)
Definition: tok.h:95
Rational weight
Definition: splist.h:41
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static int * multiplicity
int get_den_si()
Definition: GMPrat.cc:159
#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
int get_num_si()
Definition: GMPrat.cc:145
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
bool found
Definition: facFactorize.cc:56
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
spectrumPolyNode * root
Definition: splist.h:60
Definition: intvec.h:14
#define pSub(a, b)
Definition: polys.h:269
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
#define pMult_nn(p, n)
Definition: polys.h:183
FILE * f
Definition: checklibs.c:9
#define nDelete(n)
Definition: numbers.h:16
#define nInvers(a)
Definition: numbers.h:33
#define ppMult_nn(p, n)
Definition: polys.h:182
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:649
#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:345
#define pNext(p)
Definition: monomials.h:43
omBin slists_bin
Definition: lists.cc:23
polyrec * poly
Definition: hilb.h:10
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256

◆ spmulProc()

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

Definition at line 4396 of file ipshell.cc.

4397 {
4398  semicState state;
4399 
4400  // -----------------
4401  // check arguments
4402  // -----------------
4403 
4404  lists l = (lists)first->Data( );
4405  int k = (int)(long)second->Data( );
4406 
4407  if( (state=list_is_spectrum( l ))!=semicOK )
4408  {
4409  WerrorS( "first argument is not a spectrum" );
4410  list_error( state );
4411  }
4412  else if( k < 0 )
4413  {
4414  WerrorS( "second argument should be positive" );
4415  state = semicMulNegative;
4416  }
4417  else
4418  {
4419  spectrum s= spectrumFromList( l );
4420  spectrum product( k*s );
4421 
4422  result->rtyp = LIST_CMD;
4423  result->data = (char*)getList(product);
4424  }
4425 
4426  return (state!=semicOK);
4427 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3322
void * data
Definition: subexpr.h:88
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
semicState
Definition: ipshell.cc:3360
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
int l
Definition: cfEzgcd.cc:94

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3097 of file ipshell.cc.

3098 {
3099  sleftv tmp;
3100  memset(&tmp,0,sizeof(tmp));
3101  tmp.rtyp=INT_CMD;
3102  tmp.data=(void *)1;
3103  return syBetti2(res,u,&tmp);
3104 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
void * data
Definition: subexpr.h:88
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3074
int rtyp
Definition: subexpr.h:91

◆ syBetti2()

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

Definition at line 3074 of file ipshell.cc.

3075 {
3076  syStrategy syzstr=(syStrategy)u->Data();
3077 
3078  BOOLEAN minim=(int)(long)w->Data();
3079  int row_shift=0;
3080  int add_row_shift=0;
3081  intvec *weights=NULL;
3082  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3083  if (ww!=NULL)
3084  {
3085  weights=ivCopy(ww);
3086  add_row_shift = ww->min_in();
3087  (*weights) -= add_row_shift;
3088  }
3089 
3090  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3091  //row_shift += add_row_shift;
3092  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3093  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3094 
3095  return FALSE;
3096 }
Definition: tok.h:95
#define FALSE
Definition: auxiliary.h:94
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:88
Definition: intvec.h:14
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:158
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1763
void * Data()
Definition: subexpr.cc:1137
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 3182 of file ipshell.cc.

3183 {
3184  int typ0;
3186 
3187  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3188  if (fr != NULL)
3189  {
3190 
3191  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3192  for (int i=result->length-1;i>=0;i--)
3193  {
3194  if (fr[i]!=NULL)
3195  result->fullres[i] = idCopy(fr[i]);
3196  }
3197  result->list_length=result->length;
3198  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3199  }
3200  else
3201  {
3202  omFreeSize(result, sizeof(ssyStrategy));
3203  result = NULL;
3204  }
3205  return result;
3206 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:115
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
short list_length
Definition: syz.h:62
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 3109 of file ipshell.cc.

3110 {
3111  resolvente fullres = syzstr->fullres;
3112  resolvente minres = syzstr->minres;
3113 
3114  const int length = syzstr->length;
3115 
3116  if ((fullres==NULL) && (minres==NULL))
3117  {
3118  if (syzstr->hilb_coeffs==NULL)
3119  { // La Scala
3120  fullres = syReorder(syzstr->res, length, syzstr);
3121  }
3122  else
3123  { // HRES
3124  minres = syReorder(syzstr->orderedRes, length, syzstr);
3125  syKillEmptyEntres(minres, length);
3126  }
3127  }
3128 
3129  resolvente tr;
3130  int typ0=IDEAL_CMD;
3131 
3132  if (minres!=NULL)
3133  tr = minres;
3134  else
3135  tr = fullres;
3136 
3137  resolvente trueres=NULL; intvec ** w=NULL;
3138 
3139  if (length>0)
3140  {
3141  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3142  for (int i=(length)-1;i>=0;i--)
3143  {
3144  if (tr[i]!=NULL)
3145  {
3146  trueres[i] = idCopy(tr[i]);
3147  }
3148  }
3149  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3150  typ0 = MODUL_CMD;
3151  if (syzstr->weights!=NULL)
3152  {
3153  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3154  for (int i=length-1;i>=0;i--)
3155  {
3156  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3157  }
3158  }
3159  }
3160 
3161  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3162  w, add_row_shift);
3163 
3164  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3165 
3166  if (toDel)
3167  syKillComputation(syzstr);
3168  else
3169  {
3170  if( fullres != NULL && syzstr->fullres == NULL )
3171  syzstr->fullres = fullres;
3172 
3173  if( minres != NULL && syzstr->minres == NULL )
3174  syzstr->minres = minres;
3175  }
3176  return li;
3177 }
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:1649
Definition: lists.h:22
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:14
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:123
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:215
const CanonicalForm & w
Definition: facAbsFact.cc:55
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2208
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1503
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3211 of file ipshell.cc.

3212 {
3213  int typ0;
3215 
3216  resolvente fr = liFindRes(li,&(result->length),&typ0);
3217  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3218  for (int i=result->length-1;i>=0;i--)
3219  {
3220  if (fr[i]!=NULL)
3221  result->minres[i] = idCopy(fr[i]);
3222  }
3223  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3224  return result;
3225 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:115
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:60
resolvente minres
Definition: syz.h:58
#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 506 of file ipshell.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 246 of file ipshell.cc.

247 {
248  BOOLEAN oldShortOut = FALSE;
249 
250  if (currRing != NULL)
251  {
252  oldShortOut = currRing->ShortOut;
253  currRing->ShortOut = 1;
254  }
255  int t=v->Typ();
256  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
257  switch (t)
258  {
259  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
260  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
261  ((intvec*)(v->Data()))->cols()); break;
262  case MATRIX_CMD:Print(" %u x %u\n" ,
263  MATROWS((matrix)(v->Data())),
264  MATCOLS((matrix)(v->Data())));break;
265  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
266  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
267 
268  case PROC_CMD:
269  case RING_CMD:
270  case IDEAL_CMD: PrintLn(); break;
271 
272  //case INT_CMD:
273  //case STRING_CMD:
274  //case INTVEC_CMD:
275  //case POLY_CMD:
276  //case VECTOR_CMD:
277  //case PACKAGE_CMD:
278 
279  default:
280  break;
281  }
282  v->Print();
283  if (currRing != NULL)
284  currRing->ShortOut = oldShortOut;
285 }
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:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:120
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:72
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
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 982 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 5512 of file ipshell.cc.